Re: [ANN] lisp/ob-tangle-sync.el

[Mehmet Tekman <mtekman89@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 2441 bytes --]

Hello again,

Ihor Radchenko <yantar92@posteo.net> writes:

>>> I recommend trying various edge cases with your patch.
>>> In particular:
>>>
>>> 1. Testing exclusive group inheritance when we inherit a header arg
>>>    value that matches :any:
>>>
>>>    #+PROPERTIES: header-args :tangle "foo.txt"
>>>    #+begin_src ... :tangle no
>>>
>>>    #+PROPERTIES: header-args :tangle no
>>>    #+begin_src ... :tangle "foo.txt"
>>>
>>>    #+PROPERTIES: header-args :tangle no
>>>    * Heading
>>>
>>>    :PROPERTIES:
>>>    :header-args: :tangle "foo.txt"
>>>    :END:
>>>    #+begin_src ... :tangle yes
>> ...
>>> I feel that the following code is not reliable when we inherit exact and
>>> :any exclusive group members in alternations.
>>
>> Ah, hmm - can you give me an example here? I thought the idea was that
>> an :any string would only be invokable once for a given header
>> parameter.
>
> See the above 3 examples: (1) "foo.txt" shadowed by "no"; (2) "no"
> shadowed by "foo.txt"; (3) "no" shadowed by "foo.txt" then shadowed by
> "yes".
>
> You can also consider "foo.txt" shadowed by "bar.txt" and other
> variations.

I've created a small patch that contains a single ert test function that
checks an example org file I made (based on the above as well as my own
toy file) to try to validate the `org-babel-merge-params' rewrite.

I've attached it below in case you want to test it...

...but there were a few cases where I wasn't entirely sure what the
result of the merge was supposed to be:

For example, a document with:

> #+TITLE: Header tests
> #+PROPERTY: header-args :tangle /tmp/default_tangle.txt
> 
> * Inherit tangle header from document
> 
> #+begin_src conf
>   (:tangle . /tmp/default_tangle.txt)
> #+end_src

I would expect the output of:

    (assoc :tangle (nth 2 (org-babel-get-src-block-info)))

within that block to evaluate to the contents written in that
block. Instead it evaluates to `(:tangle . no)' when run in a vanilla
Emacs. Is this expected?


Another example:

> * Header args overwritten by local header
> :PROPERTIES:
> :header-args: :tangle "foo.txt"
> :END:
> #+begin_src :tangle yes
>    (:tangle . foo.txt)
> #+end_src
>
> ** Inherited header
> 
> #+begin_src :tangle "file with spaces.txt"
>   (:tangle . "file with spaces.txt")
> #+end_src

The first block correctly gives "foo.txt" under vanilla Emacs, but the
second block also gives "foo.txt". Is this expected behaviour?


Best,
Mehmet


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: test org file and associated ert test function --]
[-- Type: text/x-patch, Size: 7406 bytes --]

From 2f040db1197f835262d32e7ced857f2a47dd8ca8 Mon Sep 17 00:00:00 2001
From: MT <mtekman89@gmail.com>
Date: Wed, 17 May 2023 13:16:08 +0200
Subject: [PATCH 4/4] * testing/examples/header_test.org: New example test file

  Contains several source blocks with document, heading, block header
  arguments

* testing/lisp/test-ob.el (test-ob/merge-params): New test function
for `org-babel-merge-params' validation.

  This function takes a list of all the ID properties for each of the
  blocks in `header_test.org', along with a symbol or list of header
  properties to test against.  The expected value is written within
  the block contents.
---
 testing/examples/header_test.org | 127 +++++++++++++++++++++++++++++++
 testing/lisp/test-ob.el          |  44 +++++++++++
 2 files changed, 171 insertions(+)
 create mode 100644 testing/examples/header_test.org

diff --git a/testing/examples/header_test.org b/testing/examples/header_test.org
new file mode 100644
index 000000000..9a33661be
--- /dev/null
+++ b/testing/examples/header_test.org
@@ -0,0 +1,127 @@
+#+TITLE: Header tests
+#+PROPERTY: header-args :tangle /tmp/default_tangle.txt
+
+The text contents in each block are tested against the output of
+=(assoc <prop> (nth 2 (org-babel-get-src-block-info)))=
+
+Multiple header properties can be tested by separating each property
+output with a **newline followed by exactly two spaces**.
+
+* Inherit tangle header from document
+:PROPERTIES:
+:ID:       a41c3238-f457-4769-b10b-8d50e9d386a1
+:END:
+
+#+begin_src conf
+  (:tangle . /tmp/default_tangle.txt)
+#+end_src
+
+* Inherit tangle header but use local sync action
+:PROPERTIES:
+:ID:       debf7bf8-e5eb-412d-9127-57950a27c390
+:END:
+
+#+begin_src conf :tangle skip
+  (:tangle . /tmp/default_tangle.txt skip)
+#+end_src
+
+* Use local tangle file and sync action
+:PROPERTIES:
+:ID:       1ca658c1-0dfd-42a5-bbe3-305582deeb00
+:END:
++ Ignore document header completely.
+#+begin_src conf :tangle randomfile sync
+  (:tangle . randomfile sync)
+#+end_src
+
+* Use local tangle file and sync action 2
+:PROPERTIES:
+:header-args: :tangle "newfile.txt" import
+:END:
+** Subheading
+:PROPERTIES:
+:ID:       602503b8-6657-49c6-9cac-7edac396f725
+:END:
++ Ignore document header and parent header completely.
+#+begin_src conf :tangle randomfile sync
+  (:tangle . randomfile sync)
+#+end_src
+
+
+* Test tangle and results param together
+:PROPERTIES:
+:ID:       4fb9938c-aec0-479f-bbc6-6b7a4228d9c2
+:END:
+#+begin_src conf  :tangle randomfile
+  (:tangle . randomfile)
+  (:results . replace)
+#+end_src
+
+* Inherit the tangle file name, take the last sync action
+:PROPERTIES:
+:ID:       7a98b56d-e59f-426d-bd58-f93bb22cf57b
+:END:
++ Ignores import
+#+begin_src conf  :tangle import export
+  (:tangle . /tmp/default_tangle.txt export)
+#+end_src
+
+* Take the last local tangle file name and the last sync action
+:PROPERTIES:
+:ID:       cd85e03a-1a4c-45d5-ac33-90d96999b665
+:END:
++ Ignores fname1 and sync
+#+begin_src conf  :tangle fname1 fname2 sync export
+  (:tangle . fname2 export)
+#+end_src
+
+* Merge document results param and local results param
+:PROPERTIES:
+:ID:       f4e4e422-029b-4ef7-b594-cd70cff2d943
+:END:
+
+#+begin_src sh :results file wrap
+  (:results . wrap file replace)
+  (:exports . code)
+#+end_src
+
+* All tangle headers should be ignored (ITS FAILING HERE)
+:PROPERTIES:
+:ID:       9715d355-009c-4188-8b97-bcbebaeee86f
+:END:
+
+#+begin_src conf :tangle no
+  (:tangle . no)
+#+end_src
+
+* Tangle filename ignores document and heading args, inherits heading exports
+:PROPERTIES:
+:ID:       1a3b5565-27b5-450e-a2c5-7f95a8142f3b
+:header-args: :tangle no :exports verbatim
+:END:
+
+#+begin_src conf :tangle "foo.txt" :comments link
+  (:tangle . foo.txt)
+  (:exports . verbatim code)
+  (:comments . link)
+#+end_src
+
+* Heading tangle parameter is not overwritten by local "yes"
+:PROPERTIES:
+:ID:       fe54b2be-d9f1-40b4-83df-49501e69d083
+:header-args: :tangle "foo.txt"
+:END:
+#+begin_src :tangle yes
+   (:tangle . foo.txt)
+#+end_src
+
+** Local tangle filename with spaces overwrites parent foo.txt
+:PROPERTIES:
+:ID:       ab8af294-c586-4ec8-9f45-3c3baaeb184d
+:END:
++ The expected hierarchy is =/tmp/default_tangle.txt= is supplanted by
+  =foo.txt= which is supplanted by =file with spaces.txt=
+
+#+begin_src :tangle "file with spaces.txt"
+   (:tangle . "file with spaces.txt")
+#+end_src
diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el
index c8dbd44f4..e05dd083a 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -314,6 +314,50 @@ this is simple"
     (org-babel-next-src-block)
     (should (= 14 (org-babel-execute-src-block)))))
 
+(ert-deftest test-ob/merge-params ()
+  "Test the output of merging multiple header parameters.  The
+expected output is given in the contents of the source code block
+at each header.  The desired test header parameters are given
+either as a symbol or a list in the `idtest-alist' variable.
+Multiple header parameters must be separated by a newline and
+exactly two spaces in the block contents."
+  (let ((idtest-alist '(("a41c3238-f457-4769-b10b-8d50e9d386a1" . :tangle)
+                        ("debf7bf8-e5eb-412d-9127-57950a27c390" . :tangle)
+                        ("1ca658c1-0dfd-42a5-bbe3-305582deeb00" . :tangle)
+                        ("602503b8-6657-49c6-9cac-7edac396f725" . :tangle)
+                        ("4fb9938c-aec0-479f-bbc6-6b7a4228d9c2" . (:tangle :results))
+                        ("7a98b56d-e59f-426d-bd58-f93bb22cf57b" . :tangle)
+                        ("cd85e03a-1a4c-45d5-ac33-90d96999b665" . :tangle)
+                        ("f4e4e422-029b-4ef7-b594-cd70cff2d943" . (:results :exports))
+                        ("9715d355-009c-4188-8b97-bcbebaeee86f" . :tangle)
+                        ("1a3b5565-27b5-450e-a2c5-7f95a8142f3b" . (:tangle :exports :comments))
+                        ("fe54b2be-d9f1-40b4-83df-49501e69d083" . :tangle)
+                        ("ab8af294-c586-4ec8-9f45-3c3baaeb184d" . :tangle)))
+        buffer
+        failed-ids)
+    (unwind-protect
+        (org-test-in-example-file (expand-file-name "header_test.org" org-test-example-dir)
+          (setq buffer (current-buffer))
+          (dolist (testpair idtest-alist)
+            (let ((id (car testpair))
+                  (prop (cdr testpair)))
+              (org-test-at-id id)
+              (org-babel-next-src-block)
+              (unless (string=
+                       (if (string= "symbol" (type-of prop))
+                           (format "%s" (assoc prop
+                                               (nth 2 (org-babel-get-src-block-info))))
+                         (mapconcat (lambda (x) (format "%s"
+                                                   (assoc x
+                                                          (nth 2 (org-babel-get-src-block-info)))))
+                                    prop "\n  ")) ;; newline with exactly two spaces.
+                       (string-trim (org-element-property :value (org-element-at-point))))
+                (push id failed-ids))))
+          (kill-buffer buffer)
+          (if failed-ids
+              (user-error "%d Failed Blocks: %s" (length failed-ids) failed-ids))
+          (should (= 0 (length failed-ids) ))))))
+
 (ert-deftest test-ob/inline-src-blocks ()
   (should
    (= 1
-- 
2.40.1