diff --git a/devops-test.el b/devops-test.el index 0ff2832..eb1b56b 100644 --- a/devops-test.el +++ b/devops-test.el @@ -240,6 +240,35 @@ The directory is removed afterwards." (let ((org-confirm-babel-evaluate nil)) (should-error (devops--resolve-target-for-tag "t1") :type 'user-error)))) +(defvar devops-test--seen nil + "Values of `devops-resolving-target' seen by test blocks, latest first.") + +(ert-deftest devops-resolving-target-test () + "`devops-resolving-target' is the innermost (TAG . REF) while resolving." + (devops-test--with-org + (concat "#+TARGET: t1 <>\n#+TARGET: t2 <>\n" + "#+TARGET: t3 <>\n\n" + "* A\t\t:t2:\n\n" + "#+name: a\n#+begin_src emacs-lisp\n" + "(push devops-resolving-target devops-test--seen)\n" + "temporary-file-directory\n#+end_src\n\n" + "* B\n\n" + "#+name: b\n#+begin_src emacs-lisp\n" + "(push devops-resolving-target devops-test--seen)\n" + "temporary-file-directory\n#+end_src\n\n" + "#+name: c\n#+begin_src emacs-lisp\n" + "(error \"Boom\")\n#+end_src\n") + (let ((org-confirm-babel-evaluate nil) + (devops-test--seen nil)) + (should-not devops-resolving-target) + ;; Resolving t1 runs a, under t2, which first resolves t2 by b. + (should (equal (devops--resolve-target-for-tag "t1") + temporary-file-directory)) + (should (equal devops-test--seen '(("t1" . "a()") ("t2" . "b()")))) + (should-not devops-resolving-target) + (should-error (devops--resolve-target-for-tag "t3")) + (should-not devops-resolving-target)))) + (ert-deftest devops-heading-targets-resolves-only-its-tags-test () "Only the references of tags on the heading are resolved." (devops-test--with-org diff --git a/devops.el b/devops.el index bbb3016..6ebc5db 100644 --- a/devops.el +++ b/devops.el @@ -68,6 +68,10 @@ ;; ;; - `devops-enable-session-async' run blocks in async session pool ;; +;; For packages that build on it: +;; +;; - `devops-resolving-target' (TAG . REF) while a dynamic target resolves +;; ;; Please report issues at ;; https://github.com/kpassapk/devops.el/issues @@ -167,6 +171,13 @@ written in noweb's brackets, `<>' or `<>'." (defvar devops--resolving-tags nil "Tags whose target references are being resolved, innermost first.") +(defvar devops-resolving-target nil + "The dynamic target being resolved, as (TAG . REF), or nil. +Bound while `devops--target-from-ref' runs REF, the reference in TAG's +#+TARGET keyword, so code called from it, such as a confirmation +prompt, can tell the block runs to locate a target. When resolutions +nest, it holds the innermost.") + (defun devops--target-value-string (value) "Return VALUE, a resolved reference, as a trimmed string, or nil. A shell block with `:results value' hands its one line back as a @@ -188,6 +199,7 @@ value." (user-error "Target %s: %s is a src block; write <<%s()>> to run it" tag ref ref)) (let* ((devops--resolving-tags (cons tag devops--resolving-tags)) + (devops-resolving-target (cons tag ref)) (value (devops--target-value-string (save-excursion (org-babel-ref-resolve ref))))) (when (or (null value)