Ihor Radchenko <yanta...@posteo.net> writes: >> +(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: >> .... >> + ;; 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)) > > This combination of pre-filled text and insertions is a bit > disorienting. I understand why you need to insert some things only after > we know the temporary Org file name, but I'd instead placed all the > contents together via insert.
Rewrote. >> +#+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)))) > > When reading this code, I have no idea what it is trying to test. > Probably something to do with function names not being descriptive. > At least, a comment would help. > > And the magic numbers "4" and "5" have no obvious meaning. Hope new version is cleaner.
>From f1bf00592b1ee2bb27148fe93316cc6c1a192179 Mon Sep 17 00:00:00 2001 From: Evgenii Klimov <eugene....@lipklim.org> Date: Fri, 21 Jul 2023 22:40:06 +0100 Subject: [PATCH v5 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 | 116 +++++++++++++++++++++++++++++++++ 1 file changed, 116 insertions(+) diff --git a/testing/lisp/test-ob-tangle.el b/testing/lisp/test-ob-tangle.el index 07e75f4d3..ad0e1c29c 100644 --- a/testing/lisp/test-ob-tangle.el +++ b/testing/lisp/test-ob-tangle.el @@ -569,6 +569,122 @@ 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 "" ; filled below, it depends on temp file name + (let* ((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))) + (insert (format "* 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 + +#+begin_src emacs-lisp :tangle %s +\"H1: absolute org-file.lang-ext :tangle %s\" +#+end_src + +#+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 %s +\"H2: relative org-file.lang-ext :tangle %s\" +#+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" el-file-abs el-file-abs el-file-rel el-file-rel)) + (letrec ((sort-fn (lambda (lst) (seq-sort-by #'car #'string-lessp lst))) + (normalize-expected-targets-alist + (lambda (blocks-per-target-alist) + "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)) + blocks-per-target-alist)))) + (count-blocks-in-target-files + (lambda (collected-blocks) + "Get sorted alist of target file names with number of blocks in each" + (funcall sort-fn (map-apply (lambda (file blocks) + (cons file (length blocks))) + collected-blocks))))) + (should (equal (funcall normalize-expected-targets-alist + `(("/tmp/absolute.el" . 4) + ("relative.el" . 5) + ;; file name differs between tests + (,el-file-abs . 4))) + (funcall count-blocks-in-target-files + (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 normalize-expected-targets-alist + `(("/tmp/absolute.el" . 4) + ("relative.el" . 5) + ;; Default :tangle header now also + ;; points to the file name derived from the name of + ;; the Org file, so 5 blocks should go there. + (,el-file-abs . 5))) + (funcall count-blocks-in-target-files + (org-babel-tangle-collect-blocks))))))))) + (provide 'test-ob-tangle) ;;; test-ob-tangle.el ends here -- 2.34.1
>From 4b1fe9ac4496ebf8473a8f077762be9abea62078 Mon Sep 17 00:00:00 2001 From: Evgenii Klimov <eugene....@lipklim.org> Date: Wed, 12 Jul 2023 19:24:48 +0100 Subject: [PATCH v5 2/2] ob-tangle.el: Avoid relative file names when grouping blocks to tangle * lisp/ob-tangle.el (org-babel-tangle-single-block, org-babel-tangle-collect-blocks): Make target file name attribute, used internally to group blocks with identical language, to be absolute. (org-babel-effective-tangled-filename): Avoid using relative file names that could cause one block to overwrite the others in `org-babel-tangle-collect-blocks' if they have the same target file but in different formats. --- lisp/ob-tangle.el | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index b6ae4b55a..670a3dfa7 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -427,17 +427,19 @@ that the appropriate major-mode is set. SPEC has the form: org-babel-tangle-comment-format-end link-data))))) (defun org-babel-effective-tangled-filename (buffer-fn src-lang src-tfile) - "Return effective tangled filename of a source-code block. -BUFFER-FN is the name of the buffer, SRC-LANG the language of the -block and SRC-TFILE is the value of the :tangle header argument, -as computed by `org-babel-tangle-single-block'." - (let ((base-name (cond - ((string= "yes" src-tfile) - ;; Use the buffer name - (file-name-sans-extension buffer-fn)) - ((string= "no" src-tfile) nil) - ((> (length src-tfile) 0) src-tfile))) - (ext (or (cdr (assoc src-lang org-babel-tangle-lang-exts)) src-lang))) + "Return effective tangled absolute filename of a source-code block. +BUFFER-FN is the absolute file name of the buffer, SRC-LANG the +language of the block and SRC-TFILE is the value of the :tangle +header argument, as computed by `org-babel-tangle-single-block'." + (let* ((fnd (file-name-directory buffer-fn)) + (base-name (cond + ((string= "yes" src-tfile) + ;; Use the buffer name + (file-name-sans-extension buffer-fn)) + ((string= "no" src-tfile) nil) + ((> (length src-tfile) 0) + (expand-file-name src-tfile fnd)))) + (ext (or (cdr (assoc src-lang org-babel-tangle-lang-exts)) src-lang))) (when base-name ;; decide if we want to add ext to base-name (if (and ext (string= "yes" src-tfile)) @@ -454,7 +456,9 @@ source code blocks by languages matching a regular expression. Optional argument TANGLE-FILE can be used to limit the collected code blocks by target file." - (let ((counter 0) last-heading-pos blocks) + (let ((counter 0) + (buffer-fn (buffer-file-name (buffer-base-buffer))) + last-heading-pos blocks) (org-babel-map-src-blocks (buffer-file-name) (let ((current-heading-pos (or (org-element-begin @@ -478,7 +482,7 @@ code blocks by target file." (let* ((block (org-babel-tangle-single-block counter)) (src-tfile (cdr (assq :tangle (nth 4 block)))) (file-name (org-babel-effective-tangled-filename - (nth 1 block) src-lang src-tfile)) + buffer-fn src-lang src-tfile)) (by-fn (assoc file-name blocks))) (if by-fn (setcdr by-fn (cons (cons src-lang block) (cdr by-fn))) (push (cons file-name (list (cons src-lang block))) blocks))))))) @@ -595,7 +599,7 @@ non-nil, return the full association list to be used by comment))) (if only-this-block (let* ((file-name (org-babel-effective-tangled-filename - (nth 1 result) src-lang src-tfile))) + file src-lang src-tfile))) (list (cons file-name (list (cons src-lang result))))) result))) -- 2.34.1