From a5b4faec9b58b8e56512c03e4f1a1fe295900d3f Mon Sep 17 00:00:00 2001
From: Evgenii Klimov <eugene.dev@lipklim.org>
Date: Fri, 21 Jul 2023 22:40:06 +0100
Subject: [PATCH v4 1/2] testing/lisp/test-ob-tangle.el: Test block collection
 into groups for tangling

* testing/lisp/test-ob-tangle.el (ob-tangle/collect-blocks): Test
block collection into groups for tangling.
---
 testing/lisp/test-ob-tangle.el | 111 +++++++++++++++++++++++++++++++++
 1 file changed, 111 insertions(+)

diff --git a/testing/lisp/test-ob-tangle.el b/testing/lisp/test-ob-tangle.el
index 07e75f4d3..55e1f7aa3 100644
--- a/testing/lisp/test-ob-tangle.el
+++ b/testing/lisp/test-ob-tangle.el
@@ -569,6 +569,117 @@ another block
         (set-buffer-modified-p nil))
       (kill-buffer buffer))))
 
+(ert-deftest ob-tangle/collect-blocks ()
+  "Test block collection into groups for tangling."
+  (org-test-with-temp-text-in-file
+      "* H1 with :tangle in properties
+:PROPERTIES:
+:header-args: :tangle relative.el
+:END:
+
+#+begin_src emacs-lisp
+\"H1: inherited :tangle relative.el in properties\"
+#+end_src
+
+#+begin_src emacs-lisp :tangle yes
+\"H1: :tangle yes\"
+#+end_src
+
+#+begin_src emacs-lisp :tangle no
+\"H1: should be ignored\"
+#+end_src
+
+<point>
+
+#+begin_src emacs-lisp :tangle relative.el
+\"H1: :tangle relative.el\"
+#+end_src
+
+#+begin_src emacs-lisp :tangle ./relative.el
+\"H1: :tangle ./relative.el\"
+#+end_src
+
+#+begin_src emacs-lisp :tangle /tmp/absolute.el
+\"H1: :tangle /tmp/absolute.el\"
+#+end_src
+
+#+begin_src emacs-lisp :tangle ~/../../tmp/absolute.el
+\"H1: :tangle ~/../../tmp/absolute.el\"
+#+end_src
+
+* H2 without :tangle in properties
+
+#+begin_src emacs-lisp
+\"H2: without :tangle\"
+#+end_src
+
+#+begin_src emacs-lisp :tangle yes
+\"H2: :tangle yes\"
+#+end_src
+
+#+begin_src emacs-lisp :tangle no
+\"H2: should be ignored\"
+#+end_src
+
+#+begin_src emacs-lisp :tangle relative.el
+\"H2: :tangle relative.el\"
+#+end_src
+
+#+begin_src emacs-lisp :tangle ./relative.el
+\"H2: :tangle ./relative.el\"
+#+end_src
+
+#+begin_src emacs-lisp :tangle /tmp/absolute.el
+\"H2: :tangle /tmp/absolute.el\"
+#+end_src
+
+#+begin_src emacs-lisp :tangle ~/../../tmp/absolute.el
+\"H2: :tangle ~/../../tmp/absolute.el\"
+#+end_src
+"
+    (letrec ((org-file (buffer-file-name))
+             (test-dir (file-name-directory org-file))
+             (el-file-abs (concat (file-name-sans-extension org-file) ".el"))
+             (el-file-rel (file-name-nondirectory el-file-abs))
+             (sort-fn (lambda (lst) (seq-sort-by #'car #'string-lessp lst)))
+             (expected-targets-fn
+              (lambda (nblocks-el-file)
+                "Convert to absolute file names and sort expected targets"
+                (funcall sort-fn
+                         (map-apply (lambda (file nblocks)
+                                      (cons (expand-file-name file test-dir) nblocks))
+                                    `(("/tmp/absolute.el" . 4)
+                                      ("relative.el" . 5)
+                                      ;; single file that differs between tests
+                                      (,el-file-abs . ,nblocks-el-file))))))
+             (collected-targets-fn
+              (lambda (collected-blocks)
+                (funcall sort-fn (map-apply (lambda (file blocks)
+                                              (cons file (length blocks)))
+                                            collected-blocks)))))
+      ;; to the first header
+      (insert (format "#+begin_src emacs-lisp :tangle %s
+\"H1: absolute org-file.lang-ext :tangle %s\"
+#+end_src" el-file-abs el-file-abs))
+      (goto-char (point-max))
+      ;; to the second header
+      (insert (format "
+#+begin_src emacs-lisp :tangle %s
+\"H2: relative org-file.lang-ext :tangle %s\"
+#+end_src" el-file-rel el-file-rel))
+      (should (equal (funcall expected-targets-fn 4)
+                     (funcall collected-targets-fn (org-babel-tangle-collect-blocks))))
+      ;; simulate TARGET-FILE to test as `org-babel-tangle' and
+      ;; `org-babel-load-file' would call
+      ;; `org-babel-tangle-collect-blocks'.
+      (let ((org-babel-default-header-args
+             (org-babel-merge-params
+              org-babel-default-header-args
+              (list (cons :tangle el-file-abs)))))
+        (should (equal (funcall expected-targets-fn 5)
+                       (funcall collected-targets-fn
+                                (org-babel-tangle-collect-blocks))))))))
+
 (provide 'test-ob-tangle)
 
 ;;; test-ob-tangle.el ends here
-- 
2.34.1