From: Evgenii Klimov <eugene.dev@lipklim.org>
To: Ihor Radchenko <yantar92@posteo.net>
Cc: emacs-orgmode@gnu.org
Subject: [PATCH v5] ob-tangle.el: Blocks overwrite each other when grouping before tangling
Date: Wed, 26 Jul 2023 16:07:39 +0100 [thread overview]
Message-ID: <875y66906s.fsf@lipklim.org> (raw)
In-Reply-To: <87mszjm94g.fsf@localhost>
[-- Attachment #1: Type: text/plain, Size: 1320 bytes --]
Ihor Radchenko <yantar92@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.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: v5-0001-testing-lisp-test-ob-tangle.el-Test-block-collect.patch --]
[-- Type: text/x-diff, Size: 5158 bytes --]
From f1bf00592b1ee2bb27148fe93316cc6c1a192179 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 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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: v5-0002-ob-tangle.el-Avoid-relative-file-names-when-group.patch --]
[-- Type: text/x-diff, Size: 4006 bytes --]
From 4b1fe9ac4496ebf8473a8f077762be9abea62078 Mon Sep 17 00:00:00 2001
From: Evgenii Klimov <eugene.dev@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
next prev parent reply other threads:[~2023-07-26 15:31 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-07-12 20:59 [BUG] ob-tangle.el: Blocks overwrite each other when grouping before tangling Evgenii Klimov
2023-07-12 22:51 ` [PATCH] " Evgenii Klimov
2023-07-13 10:52 ` [PATCH v2] " Evgenii Klimov
2023-07-14 8:45 ` Ihor Radchenko
2023-07-24 12:28 ` [PATCH v3] " Evgenii Klimov
2023-07-25 7:02 ` Ihor Radchenko
2023-07-25 16:12 ` [PATCH v4] " Evgenii Klimov
2023-07-26 7:20 ` Ihor Radchenko
2023-07-26 15:07 ` Evgenii Klimov [this message]
2023-07-28 7:29 ` [PATCH v5] " Ihor Radchenko
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=875y66906s.fsf@lipklim.org \
--to=eugene.dev@lipklim.org \
--cc=emacs-orgmode@gnu.org \
--cc=yantar92@posteo.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).