* [BUG] ob-tangle.el: Blocks overwrite each other when grouping before tangling
@ 2023-07-12 20:59 Evgenii Klimov
2023-07-12 22:51 ` [PATCH] " Evgenii Klimov
0 siblings, 1 reply; 10+ messages in thread
From: Evgenii Klimov @ 2023-07-12 20:59 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 2512 bytes --]
Hi, I noticed that during grouping of blocks to tangle some of them can
overwrite each other if they have the same target file, but in different
format (relative vs absolute).
Consider this example (part of example.org file in the attachment):
* 1st explicit :tangle yes
#+begin_src emacs-lisp :tangle yes
"1st explicit :tangle yes"
#+end_src
* 1st implicit default
#+begin_src emacs-lisp
"1st implicit :tangle no"
#+end_src
If we call `org-babel-tangle-file' with target-file arg equal to
"/path/to/example.el" (e.g. `org-babel-load-file' does that), then
target file name for the first block will be "example.el" and
"/path/to/example.el" for the second block. It appears to be crucial in
`org-babel-tangle-collect-blocks' [1]:
;; `org-babel-map-src-blocks' runs this part on each source block
(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))
(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)))
Current implementation of `org-babel-effective-tangled-filename' returns
relative file name if :tangle is "yes" or relative FILENAME. But if
:tangle happened to be absolute (as `org-babel-load-file' does), then
blocks with the same file name but one name is relative while the other is
absolute, will be treated as different and won't be group (see last tree
lines of code above).
As a result when blocks are returned to `org-babel-tangle' [2] one group
will overwrite the previous one, since their absolute file names are
equal.
I noticed two scenarious where such things happen (e.g. if running
`org-babel-tangle-file'):
- if target-file arg is equal to one of :tangle FILENAMEs and some
blocks don't have :tangle argument, while other have :tangle
FILENAME. As a result one of these groups will be lost.
- if target-file arg is equal to tangled original Org file and some
blocks don't have :tangle argument, while other have :tangle
"yes". As a result one of these groups will also be lost.
I attach example Org file and scratch code to reproduce both scenarious.
[1] [[file:lisp/ob-tangle.el::(file-name (org-babel-effective-tangled-filename][target file-name]]
[2] [[file:lisp/ob-tangle.el::org-babel-tangle-collect-blocks lang-re tangle-file))][blocks return]]
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: example Org file --]
[-- Type: text/x-org, Size: 710 bytes --]
* 1st explicit :tangle yes
#+begin_src emacs-lisp :tangle yes
"1st explicit :tangle yes"
#+end_src
* 1st explicit :tangle filename.el
#+begin_src emacs-lisp :tangle filename.el
"1st explicit :tangle filename.el"
#+end_src
* 1st implicit default
#+begin_src emacs-lisp
"1st implicit :tangle no"
#+end_src
* 2nd explicit :tangle yes
#+begin_src emacs-lisp :tangle yes
"2nd explicit :tangle yes"
#+end_src
* explicit :tangle no
#+begin_src emacs-lisp :tangle no
"explicit :tangle no"
#+end_src
* 2nd explicit :tangle filename.el
#+begin_src emacs-lisp :tangle filename.el
"2nd explicit :tangle filename.el"
#+end_src
* 2nd implicit default
#+begin_src emacs-lisp
"2nd implicit :tangle no"
#+end_src
[-- Attachment #3: scratch code to reproduce the bug --]
[-- Type: application/emacs-lisp, Size: 706 bytes --]
^ permalink raw reply [flat|nested] 10+ messages in thread
* [PATCH] ob-tangle.el: Blocks overwrite each other when grouping before tangling
2023-07-12 20:59 [BUG] ob-tangle.el: Blocks overwrite each other when grouping before tangling Evgenii Klimov
@ 2023-07-12 22:51 ` Evgenii Klimov
2023-07-13 10:52 ` [PATCH v2] " Evgenii Klimov
0 siblings, 1 reply; 10+ messages in thread
From: Evgenii Klimov @ 2023-07-12 22:51 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 32 bytes --]
And here's the patch to fix it.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-ob-tangle.el-Avoid-relative-file-names-when-grouping.patch --]
[-- Type: text/x-diff, Size: 2457 bytes --]
From 2695d48f265a4100a9fc25c4dd278ab2b4b89ba5 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] ob-tangle.el: Avoid relative file names when grouping blocks
to tangle
* lisp/ob-tangle.el (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 | 22 ++++++++++++++--------
1 file changed, 14 insertions(+), 8 deletions(-)
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 25129616f..4aab453e3 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -427,17 +427,23 @@ 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.
+ "Return effective tangled absolute 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)))
+ (let* ((fnd (file-name-directory (buffer-file-name
+ (get-buffer buffer-fn))))
+ (base-name (cond
+ ((string= "yes" src-tfile)
+ ;; Use the buffer name
+ (file-name-concat fnd
+ (file-name-sans-extension buffer-fn)))
+ ((string= "no" src-tfile) nil)
+ ((> (length src-tfile) 0)
+ (if (file-name-directory src-tfile)
+ src-tfile
+ (file-name-concat fnd src-tfile)))))
+ (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))
--
2.34.1
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [PATCH v2] ob-tangle.el: Blocks overwrite each other when grouping before tangling
2023-07-12 22:51 ` [PATCH] " Evgenii Klimov
@ 2023-07-13 10:52 ` Evgenii Klimov
2023-07-14 8:45 ` Ihor Radchenko
0 siblings, 1 reply; 10+ messages in thread
From: Evgenii Klimov @ 2023-07-13 10:52 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 216 bytes --]
In this version I just updated the docstrings for the relevant
functions, because prior to that it wasn't clear: does this "default
export file for *all* source blocks" influence blocks with :tangle
"yes"/FILENAME?
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: v2-0001-ob-tangle.el-Avoid-relative-file-names-when-group.patch --]
[-- Type: text/x-diff, Size: 3894 bytes --]
From 1a4f76960cf11fb192f2bee2cdc8778c7b897f1a 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 v2] ob-tangle.el: Avoid relative file names when grouping
blocks to tangle
* lisp/ob-tangle.el (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.
(org-babel-tangle-file, org-babel-tangle): Clarify the meaning of the
TARGET-FILE argument.
---
lisp/ob-tangle.el | 34 +++++++++++++++++++++-------------
1 file changed, 21 insertions(+), 13 deletions(-)
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 25129616f..1274d0db7 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -194,11 +194,12 @@ evaluating BODY."
;;;###autoload
(defun org-babel-tangle-file (file &optional target-file lang-re)
- "Extract the bodies of source code blocks in FILE.
+ "Extract the bodies of source code blocks from FILE.
Source code blocks are extracted with `org-babel-tangle'.
Optional argument TARGET-FILE can be used to specify a default
-export file for all source blocks.
+export file for all source blocks without :tangle header
+argument.
Optional argument LANG-RE can be used to limit the exported
source code blocks by languages matching a regular expression.
@@ -230,9 +231,10 @@ With one universal prefix argument, only tangle the block at point.
When two universal prefix arguments, only tangle blocks for the
tangle file of the block at point.
Optional argument TARGET-FILE can be used to specify a default
-export file for all source blocks. Optional argument LANG-RE can
-be used to limit the exported source code blocks by languages
-matching a regular expression."
+export file for all source blocks without :tangle header
+argument. Optional argument LANG-RE can be used to limit the
+exported source code blocks by languages matching a regular
+expression."
(interactive "P")
(run-hooks 'org-babel-pre-tangle-hook)
;; Possibly Restrict the buffer to the current code block
@@ -427,17 +429,23 @@ 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.
+ "Return effective tangled absolute 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)))
+ (let* ((fnd (file-name-directory (buffer-file-name
+ (get-buffer buffer-fn))))
+ (base-name (cond
+ ((string= "yes" src-tfile)
+ ;; Use the buffer name
+ (file-name-concat fnd
+ (file-name-sans-extension buffer-fn)))
+ ((string= "no" src-tfile) nil)
+ ((> (length src-tfile) 0)
+ (if (file-name-directory src-tfile)
+ src-tfile
+ (file-name-concat fnd src-tfile)))))
+ (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))
--
2.34.1
^ permalink raw reply related [flat|nested] 10+ messages in thread
* Re: [PATCH v2] ob-tangle.el: Blocks overwrite each other when grouping before tangling
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
0 siblings, 1 reply; 10+ messages in thread
From: Ihor Radchenko @ 2023-07-14 8:45 UTC (permalink / raw)
To: Evgenii Klimov; +Cc: emacs-orgmode
Evgenii Klimov <eugene.dev@lipklim.org> writes:
> In this version I just updated the docstrings for the relevant
> functions, because prior to that it wasn't clear: does this "default
> export file for *all* source blocks" influence blocks with :tangle
> "yes"/FILENAME?
Thanks for the patch, but we need to be careful changing things in
ob-tangle. Not everything is well-documented there.
> Optional argument TARGET-FILE can be used to specify a default
> -export file for all source blocks.
> +export file for all source blocks without :tangle header
> +argument.
This is confusing.
Is :tangle yes "without"?
What about inheritance?
What about default header args?
What if we have :tangle "/path/to/foo" and TARGET-FILE = "/path/to/foo"?
What if they are :tangle "./foo" and TARGET-FILE = "/full/path/to/foo"?
> (defun org-babel-effective-tangled-filename (buffer-fn src-lang src-tfile)
> - "Return effective tangled filename of a source-code block.
> + "Return effective tangled absolute filename of a source-code block.
This will likely cause breakage.
There are two callers of `org-babel-effective-tangled-filename:
1. `org-babel-tangle-collect-blocks'
2. `org-babel-tangle-single-block'
`org-babel-tangle-single-block' passes (nth 1 result) as BUFFER-FN.
Its value is
(if org-babel-tangle-use-relative-file-links
(file-relative-name file)
file)
So,
> + (let* ((fnd (file-name-directory (buffer-file-name
> + (get-buffer buffer-fn))))
will fail when FILE contains file path.
And it does: (file (buffer-file-name (buffer-base-buffer)))
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 10+ messages in thread
* [PATCH v3] ob-tangle.el: Blocks overwrite each other when grouping before tangling
2023-07-14 8:45 ` Ihor Radchenko
@ 2023-07-24 12:28 ` Evgenii Klimov
2023-07-25 7:02 ` Ihor Radchenko
0 siblings, 1 reply; 10+ messages in thread
From: Evgenii Klimov @ 2023-07-24 12:28 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 3079 bytes --]
Hi
Here are the new tests that demonstrate the bug in block grouping during
block collection, along with the patch to address the issue, taking your
previous remarks into account.
I split it into two patches so you can apply the tests first to see the
bug. And probably tests should be rewritten as they look too complex
and mostly duplicate each other. I'd appreciate your suggestions
on how to enhance them.
Ihor Radchenko <yantar92@posteo.net> writes:
> Evgenii Klimov <eugene.dev@lipklim.org> writes:
>
>> In this version I just updated the docstrings for the relevant
>> functions, because prior to that it wasn't clear: does this "default
>> export file for *all* source blocks" influence blocks with :tangle
>> "yes"/FILENAME?
>
> Thanks for the patch, but we need to be careful changing things in
> ob-tangle. Not everything is well-documented there.
>
>> Optional argument TARGET-FILE can be used to specify a default
>> -export file for all source blocks.
>> +export file for all source blocks without :tangle header
>> +argument.
>
> This is confusing.
> Is :tangle yes "without"?
> What about inheritance?
> What about default header args?
I just find current lack of details confusing as well and want to
express the place of TARGET-FILE in the lineage of :tangle in
~org-babel-get-src-block-info~:
1. org-babel-default-header-args
1. TANGLE-FILE of ~org-babel-tangle~
2. org-babel-default-header-args:<lang>
3. org-babel-params-from-properties
4. org-element-property :parameters datum
5. org-element-property :header datum
It wasn't clear for me: will ":tangle yes" or explicit ":tangle no" be
affected by TARGET-FILE. Maybe if we rephrase as follows it will be
clear for both of us:
Optional argument TARGET-FILE can be used to overwrite a default
export file in `org-babel-default-header-args' for all source
blocks.
> What if we have :tangle "/path/to/foo" and TARGET-FILE = "/path/to/foo"?
> What if they are :tangle "./foo" and TARGET-FILE = "/full/path/to/foo"?
See the new tests in the patch, I tried to take it into account.
>> (defun org-babel-effective-tangled-filename (buffer-fn src-lang src-tfile)
>> - "Return effective tangled filename of a source-code block.
>> + "Return effective tangled absolute filename of a source-code block.
>
> This will likely cause breakage.
> There are two callers of `org-babel-effective-tangled-filename:
> 1. `org-babel-tangle-collect-blocks'
> 2. `org-babel-tangle-single-block'
>
> `org-babel-tangle-single-block' passes (nth 1 result) as BUFFER-FN.
> Its value is
>
> (if org-babel-tangle-use-relative-file-links
> (file-relative-name file)
> file)
>
> So,
>
>> + (let* ((fnd (file-name-directory (buffer-file-name
>> + (get-buffer buffer-fn))))
>
> will fail when FILE contains file path.
> And it does: (file (buffer-file-name (buffer-base-buffer)))
Thanks, fixed: both `org-babel-tangle-single-block' and
`org-babel-tangle-collect-blocks' now pass absolute value to
`org-babel-effective-tangled-filename'.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: v3-0001-testing-lisp-test-ob-tangle.el-Test-block-collect.patch --]
[-- Type: text/x-diff, Size: 6493 bytes --]
From 7235bf0306d12f6644838ad8542ac8822bcde258 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 v3 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.
(ob-tangle/collect-blocks-with-target-file): The same but with
TARGET-FILE.
---
testing/examples/babel.org | 75 ++++++++++++++++++++++++++++++++++
testing/lisp/test-ob-tangle.el | 60 +++++++++++++++++++++++++++
2 files changed, 135 insertions(+)
diff --git a/testing/examples/babel.org b/testing/examples/babel.org
index d46afeb5e..2d7b39d4e 100644
--- a/testing/examples/babel.org
+++ b/testing/examples/babel.org
@@ -490,3 +490,78 @@ The =[[= causes a false positive which ~org-babel-detangle~ should handle proper
:END:
#+begin_src emacs-lisp :tangle yes :comments link
#+end_src
+* tangle collect blocks
+:PROPERTIES:
+:ID: fae6bb5b-555a-4d68-9658-a30ac5d1b2ba
+:END:
+** with :tangle in properties
+:PROPERTIES:
+:ID: b2021d51-253c-4b26-9988-dac9193eb00b
+:header-args: :tangle relative.el
+:END:
+#+begin_src emacs-lisp
+"H1: no :tangle, but :tangle relative.el in properties"
+#+end_src
+
+#+begin_src emacs-lisp :tangle yes
+"H1: :tangle yes (to babel.el)"
+#+end_src
+
+#+begin_src emacs-lisp :tangle no
+"H1: should be ignored"
+#+end_src
+
+#+begin_src emacs-lisp :tangle ./babel.el
+"H1: :tangle ./babel.el"
+#+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
+** without :tangle in properties
+:PROPERTIES:
+:ID: 9f9afb0e-ba6d-4f63-9735-71af48ecd4e6
+:END:
+#+begin_src emacs-lisp
+"H2: no :tangle"
+#+end_src
+
+#+begin_src emacs-lisp :tangle yes
+"H2: :tangle yes (to babel.el)"
+#+end_src
+
+#+begin_src emacs-lisp :tangle no
+"H2: should be ignored"
+#+end_src
+
+#+begin_src emacs-lisp :tangle babel.el
+"H2: :tangle babel.el"
+#+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
diff --git a/testing/lisp/test-ob-tangle.el b/testing/lisp/test-ob-tangle.el
index 07e75f4d3..09eeffed7 100644
--- a/testing/lisp/test-ob-tangle.el
+++ b/testing/lisp/test-ob-tangle.el
@@ -569,6 +569,66 @@ 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-at-id "fae6bb5b-555a-4d68-9658-a30ac5d1b2ba"
+ (org-narrow-to-subtree)
+ (let ((expected-targets (cons '("/tmp/absolute.el" . 4)
+ (map-apply
+ (lambda (file numblocks)
+ (cons (expand-file-name file
+ org-test-example-dir)
+ numblocks))
+ '(("relative.el" . 5) ("babel.el" . 4)))))
+ (collected-blocks (org-babel-tangle-collect-blocks)))
+ (should (= (length expected-targets)
+ (length (map-keys collected-blocks))))
+ (let ((collected-targets (map-apply (lambda (file blocks) ; full blocks itself
+ (cons (expand-file-name file
+ org-test-example-dir)
+ (length blocks)))
+ collected-blocks)))
+ (should (equal (length expected-targets)
+ (length (map-filter
+ (lambda (file numblocks)
+ (= numblocks
+ (cdr (assoc-string file collected-targets))))
+ expected-targets))))))))
+
+(ert-deftest ob-tangle/collect-blocks-with-target-file ()
+ "Test block collection into groups for tangling with TARGET-FILE
+as `org-babel-tangle' would do."
+ (org-test-at-id "fae6bb5b-555a-4d68-9658-a30ac5d1b2ba"
+ (org-narrow-to-subtree)
+ (let* ((expected-targets (cons '("/tmp/absolute.el" . 4)
+ (map-apply
+ (lambda (file numblocks)
+ (cons (expand-file-name file
+ org-test-example-dir)
+ numblocks))
+ '(("relative.el" . 5) ("babel.el" . 5)))))
+ ;; simulate `org-babel-tangle' and `org-babel-load-file'
+ ;; TARGET-FILE
+ (org-babel-default-header-args
+ (org-babel-merge-params
+ org-babel-default-header-args
+ (list (cons :tangle
+ (expand-file-name "babel.el" org-test-example-dir)))))
+ (collected-blocks (org-babel-tangle-collect-blocks)))
+ (should (= (length expected-targets)
+ (length (map-keys collected-blocks))))
+ (let ((collected-targets (map-apply (lambda (file blocks) ; full blocks itself
+ (cons (expand-file-name file
+ org-test-example-dir)
+ (length blocks)))
+ collected-blocks)))
+ (should (equal (length expected-targets)
+ (length (map-filter
+ (lambda (file numblocks)
+ (= numblocks
+ (cdr (assoc-string file collected-targets))))
+ expected-targets))))))))
+
(provide 'test-ob-tangle)
;;; test-ob-tangle.el ends here
--
2.34.1
[-- Attachment #3: /home/eugene/git/org-mode/patches/v3-0002-ob-tangle.el-Avoid-relative-file-names-when-group.patch --]
[-- Type: message/external-body, Size: 103 bytes --]
^ permalink raw reply related [flat|nested] 10+ messages in thread
* Re: [PATCH v3] ob-tangle.el: Blocks overwrite each other when grouping before tangling
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
0 siblings, 1 reply; 10+ messages in thread
From: Ihor Radchenko @ 2023-07-25 7:02 UTC (permalink / raw)
To: Evgenii Klimov; +Cc: emacs-orgmode
Evgenii Klimov <eugene.dev@lipklim.org> writes:
> Here are the new tests that demonstrate the bug in block grouping during
> block collection, along with the patch to address the issue, taking your
> previous remarks into account.
Thanks!
The second patch is malformed. May you please resend?
(You can see the problem if you try to download the second patch in <https://list.orgmode.org/87bkg1h4q3.fsf@lipklim.org/T/#u>)
> I split it into two patches so you can apply the tests first to see the
> bug. And probably tests should be rewritten as they look too complex
> and mostly duplicate each other. I'd appreciate your suggestions
> on how to enhance them.
If you can, please avoid using `org-test-at-id'. This is much less
readable compared to explicit org-test-with-temp-text because one needs
to reach out to another file in order to understand what the test is
about.
>>> Optional argument TARGET-FILE can be used to specify a default
>>> -export file for all source blocks.
>>> +export file for all source blocks without :tangle header
>>> +argument.
>>
>> This is confusing.
>> Is :tangle yes "without"?
>> What about inheritance?
>> What about default header args?
>
> I just find current lack of details confusing as well and want to
> express the place of TARGET-FILE in the lineage of :tangle in
> ~org-babel-get-src-block-info~:
> 1. org-babel-default-header-args
> 1. TANGLE-FILE of ~org-babel-tangle~
> 2. org-babel-default-header-args:<lang>
> 3. org-babel-params-from-properties
> 4. org-element-property :parameters datum
> 5. org-element-property :header datum
>
> It wasn't clear for me: will ":tangle yes" or explicit ":tangle no" be
> affected by TARGET-FILE. Maybe if we rephrase as follows it will be
> clear for both of us:
>
> Optional argument TARGET-FILE can be used to overwrite a default
> export file in `org-babel-default-header-args' for all source
> blocks.
In `org-babel-tangle', TARGET-FILE is set as fallback value for the
blocks that have no :tangle value at all, including inherited; including
:tangle yes.
The manual asserts
‘yes’
Export the code block to source file. The file name for the source
file is derived from the name of the Org file, and the file
extension is derived from the source code language identifier.
Example: ‘:tangle yes’.
So, "yes" should imply :tangle <Org file name.lang-ext>
`org-babel-tangle-collect-blocks' handles this by
(unless (or (string= src-tfile "no")
(and tangle-file (not (equal tangle-file src-tfile)))
(and lang-re (not (string-match-p lang-re src-lang))))
So, :tangle no is always excluded.
When TANGLE-FILE is set and not equal to :tangle value (including
"yes"), block is also excluded.
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 10+ messages in thread
* [PATCH v4] ob-tangle.el: Blocks overwrite each other when grouping before tangling
2023-07-25 7:02 ` Ihor Radchenko
@ 2023-07-25 16:12 ` Evgenii Klimov
2023-07-26 7:20 ` Ihor Radchenko
0 siblings, 1 reply; 10+ messages in thread
From: Evgenii Klimov @ 2023-07-25 16:12 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 2354 bytes --]
Ihor Radchenko <yantar92@posteo.net> writes:
[...]
> Thanks!
> The second patch is malformed. May you please resend?
Sorry, resend with rewritten test.
[...]
> If you can, please avoid using `org-test-at-id'. This is much less
> readable compared to explicit org-test-with-temp-text because one needs
> to reach out to another file in order to understand what the test is
> about.
Now it's less verbose, handles both cases
(with and without TARGET-FILE) and prints detailed ert explanation.
> Evgenii Klimov <eugene.dev@lipklim.org> writes:
[...]
>> It wasn't clear for me: will ":tangle yes" or explicit ":tangle no" be
>> affected by TARGET-FILE. Maybe if we rephrase as follows it will be
>> clear for both of us:
>>
>> Optional argument TARGET-FILE can be used to overwrite a default
>> export file in `org-babel-default-header-args' for all source
>> blocks.
>
> In `org-babel-tangle', TARGET-FILE is set as fallback value for the
> blocks that have no :tangle value at all, including inherited; including
> :tangle yes.
This exactly idea I wanted to add to the docstring.
> The manual asserts
>
> ‘yes’
> Export the code block to source file. The file name for the source
> file is derived from the name of the Org file, and the file
> extension is derived from the source code language identifier.
> Example: ‘:tangle yes’.
>
> So, "yes" should imply :tangle <Org file name.lang-ext>
>
> `org-babel-tangle-collect-blocks' handles this by
>
> (unless (or (string= src-tfile "no")
> (and tangle-file (not (equal tangle-file src-tfile)))
> (and lang-re (not (string-match-p lang-re src-lang))))
>
> So, :tangle no is always excluded.
> When TANGLE-FILE is set and not equal to :tangle value (including
> "yes"), block is also excluded.
Indeed, but later
‘no’
The *default*. Do not extract the code in a source code file.
Example: ‘:tangle no’.
in conjunction with TARGET-FILE's description in ~org-babel-tangle~
docstring:
Optional argument TARGET-FILE can be used to specify a *default*
export file for all source blocks.
made me feel doubt about TARGET-FILE's effect.
Anyway, probably it was my incorrect interpretation, so let's leave it
as it is.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: v4-0001-testing-lisp-test-ob-tangle.el-Test-block-collect.patch --]
[-- Type: text/x-diff, Size: 4599 bytes --]
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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: v4-0002-ob-tangle.el-Avoid-relative-file-names-when-group.patch --]
[-- Type: text/x-diff, Size: 4006 bytes --]
From 4ca26a21612df18d8ff7f71726a858501e317e00 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 v4 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
^ permalink raw reply related [flat|nested] 10+ messages in thread
* Re: [PATCH v4] ob-tangle.el: Blocks overwrite each other when grouping before tangling
2023-07-25 16:12 ` [PATCH v4] " Evgenii Klimov
@ 2023-07-26 7:20 ` Ihor Radchenko
2023-07-26 15:07 ` [PATCH v5] " Evgenii Klimov
0 siblings, 1 reply; 10+ messages in thread
From: Ihor Radchenko @ 2023-07-26 7:20 UTC (permalink / raw)
To: Evgenii Klimov; +Cc: emacs-orgmode
Evgenii Klimov <eugene.dev@lipklim.org> writes:
>> So, :tangle no is always excluded.
>> When TANGLE-FILE is set and not equal to :tangle value (including
>> "yes"), block is also excluded.
>
> Indeed, but later
>
> ‘no’
> The *default*. Do not extract the code in a source code file.
> Example: ‘:tangle no’.
>
> in conjunction with TARGET-FILE's description in ~org-babel-tangle~
> docstring:
>
> Optional argument TARGET-FILE can be used to specify a *default*
> export file for all source blocks.
>
> made me feel doubt about TARGET-FILE's effect.
TARGET-FILE is used instead of the normal default.
> +(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.
> +#+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.
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 10+ messages in thread
* [PATCH v5] ob-tangle.el: Blocks overwrite each other when grouping before tangling
2023-07-26 7:20 ` Ihor Radchenko
@ 2023-07-26 15:07 ` Evgenii Klimov
2023-07-28 7:29 ` Ihor Radchenko
0 siblings, 1 reply; 10+ messages in thread
From: Evgenii Klimov @ 2023-07-26 15:07 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: emacs-orgmode
[-- 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
^ permalink raw reply related [flat|nested] 10+ messages in thread
* Re: [PATCH v5] ob-tangle.el: Blocks overwrite each other when grouping before tangling
2023-07-26 15:07 ` [PATCH v5] " Evgenii Klimov
@ 2023-07-28 7:29 ` Ihor Radchenko
0 siblings, 0 replies; 10+ messages in thread
From: Ihor Radchenko @ 2023-07-28 7:29 UTC (permalink / raw)
To: Evgenii Klimov; +Cc: emacs-orgmode
Evgenii Klimov <eugene.dev@lipklim.org> writes:
> Hope new version is cleaner.
Thanks!
Applied, onto main. With minor amendments.
Fixed.
https://git.savannah.gnu.org/cgit/emacs/org-mode.git/commit/?id=fcac0039a
https://git.savannah.gnu.org/cgit/emacs/org-mode.git/commit/?id=3ee10d57f
Amendments:
https://git.savannah.gnu.org/cgit/emacs/org-mode.git/commit/?id=410cecc0e
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 10+ messages in thread
end of thread, other threads:[~2023-07-28 7:34 UTC | newest]
Thread overview: 10+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
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 ` [PATCH v5] " Evgenii Klimov
2023-07-28 7:29 ` Ihor Radchenko
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).