From 2f040db1197f835262d32e7ced857f2a47dd8ca8 Mon Sep 17 00:00:00 2001 From: MT 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 (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