[O] [RFC] [PATCH] bug with babel call lines and cache

[Aaron Ecay]

Hello all,

In playing around with some of the cache-related issues, I’ve discovered
that C-c C-c on the following #+call line will give the following
backtrace:

,----
| #+name: foo
| #+begin_src emacs-lisp :var bar="baz"
|   bar
| #+end_src
|
| #+call: foo[:cache yes]("qux")
|
| #+RESULTS:
| : qux
`----

,----
| Debugger entered--Lisp error: (wrong-type-argument listp "bar=\"qux\"")
|   car("bar=\"qux\"")
|   (list (car var) (list (quote quote) (cdr var)))
|   (print (list (car var) (list (quote quote) (cdr var))))
|   (format "%S" (print (list (car var) (list (quote quote) (cdr var)))))
|   (closure ((result-params "replace") (vars "bar=\"qux\"") (params (:cache . 
"yes") (:comments . "yes") (:exports . "code") (:hlines . "no") (:noweb . "no") 
(:padline . "") (:result-params "replace") (:result-type . value) (:results . 
"silent") (:session . "none") (:shebang . "") (:tangle . "no") (:var . 
"bar=\"qux\"")) (body . "bar") t) (var) (format "%S" (print (list (car var) 
(list (quote quote) (cdr var))))))("bar=\"qux\"")
|   mapconcat((closure ((result-params "replace") (vars "bar=\"qux\"") (params 
(:cache . "yes") (:comments . "yes") (:exports . "code") (:hlines . "no") 
(:noweb . "no") (:padline . "") (:result-params "replace") (:result-type . 
value) (:results . "silent") (:session . "none") (:shebang . "") (:tangle . 
"no") (:var . "bar=\"qux\"")) (body . "bar") t) (var) (format "%S" (print (list 
(car var) (list (quote quote) (cdr var)))))) ("bar=\"qux\"") "\n      ")
|   (concat "(let (" (mapconcat (function (lambda (var) (format "%S" (print 
(list (car var) (list ... ...)))))) vars "\n      ") ")\n" body "\n)")
|   (if (> (length vars) 0) (concat "(let (" (mapconcat (function (lambda (var) 
(format "%S" (print (list ... ...))))) vars "\n      ") ")\n" body "\n)") 
(concat body "\n"))
|   (let* ((vars (org-babel--get-vars params)) (result-params (cdr (assoc 
:result-params params))) (print-level nil) (print-length nil) (body (if (> 
(length vars) 0) (concat "(let (" (mapconcat (function (lambda ... ...)) vars 
"\n      ") ")\n" body "\n)") (concat body "\n")))) (if (or (member "code" 
result-params) (member "pp" result-params)) (concat "(pp " body ")") body))
|   org-babel-expand-body:emacs-lisp("bar" ((:cache . "yes") (:comments . 
"yes") (:exports . "code") (:hlines . "no") (:noweb . "no") (:padline . "") 
(:result-params "replace") (:result-type . value) (:results . "silent") 
(:session . "none") (:shebang . "") (:tangle . "no") (:var . "bar=\"qux\"")))
|   funcall(org-babel-expand-body:emacs-lisp "bar" ((:cache . "yes") (:comments 
. "yes") (:exports . "code") (:hlines . "no") (:noweb . "no") (:padline . "") 
(:result-params "replace") (:result-type . value) (:results . "silent") 
(:session . "none") (:shebang . "") (:tangle . "no") (:var . "bar=\"qux\"")))
|   (if (fboundp expand-cmd) (funcall expand-cmd body params) 
(org-babel-expand-body:generic body params (and (fboundp assignments-cmd) 
(funcall assignments-cmd params))))
|   (let* ((rm (function (lambda (lst) (let ((--dolist-tail-- ...) p) (while 
--dolist-tail-- (setq p ...) (setq lst ...) (setq --dolist-tail-- ...))) lst))) 
(norm (function (lambda (arg) (let ((v ...)) (if (and v ...) (progn ...)))))) 
(lang (nth 0 info)) (params (nth 2 info)) (body (if (org-babel-noweb-p params 
:eval) (org-babel-expand-noweb-references info) (nth 1 info))) (expand-cmd 
(intern (concat "org-babel-expand-body:" lang))) (assignments-cmd (intern 
(concat "org-babel-variable-assignments:" lang))) (expanded (if (fboundp 
expand-cmd) (funcall expand-cmd body params) (org-babel-expand-body:generic 
body params (and (fboundp assignments-cmd) (funcall assignments-cmd 
params)))))) (let* ((it (format "%s-%s" (mapconcat (function identity) (delq 
nil (mapcar ... ...)) ":") expanded)) (hash (sha1 it))) (if (with-no-warnings 
(called-interactively-p (quote interactive))) (progn (message hash))) hash))
|   (let ((print-level nil) (info (or info (org-babel-get-src-block-info)))) 
(let* ((c (nthcdr 2 info))) (setcar c (sort (copy-sequence (nth 2 info)) 
(function (lambda (a b) (string< (car a) (car b))))))) (let* ((rm (function 
(lambda (lst) (let (... p) (while --dolist-tail-- ... ... ...)) lst))) (norm 
(function (lambda (arg) (let (...) (if ... ...))))) (lang (nth 0 info)) (params 
(nth 2 info)) (body (if (org-babel-noweb-p params :eval) 
(org-babel-expand-noweb-references info) (nth 1 info))) (expand-cmd (intern 
(concat "org-babel-expand-body:" lang))) (assignments-cmd (intern (concat 
"org-babel-variable-assignments:" lang))) (expanded (if (fboundp expand-cmd) 
(funcall expand-cmd body params) (org-babel-expand-body:generic body params 
(and (fboundp assignments-cmd) (funcall assignments-cmd params)))))) (let* ((it 
(format "%s-%s" (mapconcat (function identity) (delq nil ...) ":") expanded)) 
(hash (sha1 it))) (if (with-no-warnings (called-interactively-p (quote 
interactive))) (progn (message hash))) hash)))
|   org-babel-sha1-hash(("emacs-lisp" "bar" ((:cache . "yes") (:comments . 
"yes") (:exports . "code") (:hlines . "no") (:noweb . "no") (:padline . "") 
(:result-params "replace") (:result-type . value) (:results . "silent") 
(:session . "none") (:shebang . "") (:tangle . "no") (:var . "bar=\"qux\"")) "" 
"foo" 0 13))
|   (progn (org-babel-sha1-hash info))
|   (if cachep (progn (org-babel-sha1-hash info)))
|   (let* ((params (if params (org-babel-process-params merged-params) (nth 2 
info))) (cachep (and (not arg) (cdr (assoc :cache params)) (string= "yes" (cdr 
(assoc :cache params))))) (new-hash (if cachep (progn (org-babel-sha1-hash 
info)))) (old-hash (if cachep (progn (org-babel-current-result-hash)))) 
(cache-current-p (and (not arg) new-hash (equal new-hash old-hash)))) (cond 
(cache-current-p (save-excursion (goto-char 
(org-babel-where-is-src-block-result nil info)) (forward-line) 
(skip-chars-forward "    ") (let ((result (org-babel-read-result))) (message 
(replace-regexp-in-string "%" "%%" (format "%S" result))) result))) 
((org-babel-confirm-evaluate (let ((i info)) (let* ((c ...)) (setcar c 
merged-params)) i)) (let* ((lang (nth 0 info)) (result-params (cdr (assoc 
:result-params params))) (body (let* (...) (setcar c ...))) (dir (cdr (assoc 
:dir params))) (default-directory (or (and dir ...) default-directory)) 
(org-babel-call-process-region-original (or (and ... 
org-babel-call-process-region-original) (symbol-function ...))) (indent (nth 5 
info)) result cmd) (unwind-protect (let ((call-process-region ...)) (let (...) 
(setq cmd ...)) (message "executing %s code block%s..." (capitalize lang) (if 
... ... "")) (if (member "none" result-params) (progn ... ... ...) (setq result 
...) (if ... ...) (if ... ...) (org-babel-insert-result result result-params 
info new-hash indent lang)) (run-hooks (quote org-babel-after-execute-hook)) 
result) (setq call-process-region (quote 
org-babel-call-process-region-original)))))))
|   (progn (let* ((params (if params (org-babel-process-params merged-params) 
(nth 2 info))) (cachep (and (not arg) (cdr (assoc :cache params)) (string= 
"yes" (cdr (assoc :cache params))))) (new-hash (if cachep (progn 
(org-babel-sha1-hash info)))) (old-hash (if cachep (progn 
(org-babel-current-result-hash)))) (cache-current-p (and (not arg) new-hash 
(equal new-hash old-hash)))) (cond (cache-current-p (save-excursion (goto-char 
(org-babel-where-is-src-block-result nil info)) (forward-line) 
(skip-chars-forward "     ") (let ((result ...)) (message 
(replace-regexp-in-string "%" "%%" ...)) result))) ((org-babel-confirm-evaluate 
(let ((i info)) (let* (...) (setcar c merged-params)) i)) (let* ((lang (nth 0 
info)) (result-params (cdr ...)) (body (let* ... ...)) (dir (cdr ...)) 
(default-directory (or ... default-directory)) 
(org-babel-call-process-region-original (or ... ...)) (indent (nth 5 info)) 
result cmd) (unwind-protect (let (...) (let ... ...) (message "executing %s 
code block%s..." ... ...) (if ... ... ... ... ... ...) (run-hooks ...) result) 
(setq call-process-region (quote org-babel-call-process-region-original))))))))
|   (if (org-babel-check-evaluate (let ((i info)) (let* ((c (nthcdr 2 i))) 
(setcar c merged-params)) i)) (progn (let* ((params (if params 
(org-babel-process-params merged-params) (nth 2 info))) (cachep (and (not arg) 
(cdr (assoc :cache params)) (string= "yes" (cdr ...)))) (new-hash (if cachep 
(progn (org-babel-sha1-hash info)))) (old-hash (if cachep (progn 
(org-babel-current-result-hash)))) (cache-current-p (and (not arg) new-hash 
(equal new-hash old-hash)))) (cond (cache-current-p (save-excursion (goto-char 
(org-babel-where-is-src-block-result nil info)) (forward-line) 
(skip-chars-forward "  ") (let (...) (message ...) result))) 
((org-babel-confirm-evaluate (let (...) (let* ... ...) i)) (let* ((lang ...) 
(result-params ...) (body ...) (dir ...) (default-directory ...) 
(org-babel-call-process-region-original ...) (indent ...) result cmd) 
(unwind-protect (let ... ... ... ... ... result) (setq call-process-region 
...))))))))
|   (let* ((org-babel-current-src-block-location (or 
org-babel-current-src-block-location (nth 6 info) 
(org-babel-where-is-src-block-head) (and 
(org-babel-get-inline-src-block-matches) (match-beginning 0)))) (info (if info 
(copy-tree info) (org-babel-get-src-block-info))) (merged-params 
(org-babel-merge-params (nth 2 info) params))) (if (org-babel-check-evaluate 
(let ((i info)) (let* ((c (nthcdr 2 i))) (setcar c merged-params)) i)) (progn 
(let* ((params (if params (org-babel-process-params merged-params) (nth 2 
info))) (cachep (and (not arg) (cdr ...) (string= "yes" ...))) (new-hash (if 
cachep (progn ...))) (old-hash (if cachep (progn ...))) (cache-current-p (and 
(not arg) new-hash (equal new-hash old-hash)))) (cond (cache-current-p 
(save-excursion (goto-char ...) (forward-line) (skip-chars-forward "     ") 
(let ... ... result))) ((org-babel-confirm-evaluate (let ... ... i)) (let* (... 
... ... ... ... ... ... result cmd) (unwind-protect ... ...))))))))
|   org-babel-execute-src-block(nil nil ((:cache . "yes") (:var . "\"qux\"") 
(:results . "silent")))
|   org-babel-ref-resolve("foo[:cache yes](\"qux\")")
|   org-babel-ref-parse("results=foo[:cache yes](\"qux\")")
|   (if (consp el) el (org-babel-ref-parse el))
|   (lambda (el) (if (consp el) el (org-babel-ref-parse 
el)))("results=foo[:cache yes](\"qux\")")
|   mapcar((lambda (el) (if (consp el) el (org-babel-ref-parse el))) 
("results=foo[:cache yes](\"qux\")"))
|   (let* ((processed-vars (mapcar (function (lambda (el) (if (consp el) el 
(org-babel-ref-parse el)))) (org-babel--get-vars params))) (vars-and-names (if 
(and (assoc :colname-names params) (assoc :rowname-names params)) (list 
processed-vars) (org-babel-disassemble-tables processed-vars (cdr (assoc 
:hlines params)) (cdr (assoc :colnames params)) (cdr (assoc :rownames 
params))))) (raw-result (or (cdr (assoc :results params)) "")) (result-params 
(append (split-string (if (stringp raw-result) raw-result (eval raw-result))) 
(cdr (assoc :result-params params))))) (append (mapcar (function (lambda (var) 
(cons :var var))) (car vars-and-names)) (list (cons :colname-names (or (cdr 
(assoc :colname-names params)) (car (cdr vars-and-names)))) (cons 
:rowname-names (or (cdr (assoc :rowname-names params)) (car (cdr (cdr 
vars-and-names))))) (cons :result-params result-params) (cons :result-type 
(cond ((member "output" result-params) (quote output)) ((member "value" 
result-params) (quote value)) (t (quote value))))) (org-remove-if (function 
(lambda (x) (memq (car x) (quote (:colname-names :rowname-names :result-params 
:result-type :var))))) params)))
|   org-babel-process-params(((:comments . "yes") (:shebang . "") (:cache . 
"no") (:padline . "") (:noweb . "no") (:tangle . "no") (:exports . "code") 
(:results . "replace") (:var . "results=foo[:cache yes](\"qux\")") (:hlines . 
"no") (:session . "none")))
|   org-babel-lob-execute(("foo[:cache yes](\"qux\")" nil 0 nil))
|   org-babel-lob-execute-maybe()
|   (or (org-babel-execute-src-block-maybe) (org-babel-lob-execute-maybe))
|   org-babel-execute-maybe()
|   (if org-babel-no-eval-on-ctrl-c-ctrl-c nil (org-babel-execute-maybe))
|   org-babel-execute-safely-maybe()
|   run-hook-with-args-until-success(org-babel-execute-safely-maybe)
|   org-ctrl-c-ctrl-c(nil)
|   funcall-interactively(org-ctrl-c-ctrl-c nil)
|   call-interactively(org-ctrl-c-ctrl-c nil nil)
|   command-execute(org-ctrl-c-ctrl-c)
`----

The problem is that unprocessed params (in the sense of
org-babel-process-params) are passed to org-babel-sha1-hash under some
circumstances.

The attached patch fixes this issue by simplifying some code in
org-babel-execute-src-block.  I’m slightly uncomfortable about it
because I remember touching the various nested ‘let’s which toggle
between different states of ‘params’ in that function once upon a
time, and they seemed important.  Now I can’t remember why, though.
So I’d be happier if someone else familiar with babel’s code looked
the patch over.

If no one pipes up in a few days, I will push the patch and see if
anything breaks.

Thanks,

>From a7d89a81d0197dde7249a510ad51c999fffd4e24 Mon Sep 17 00:00:00 2001
From: Aaron Ecay <address@hidden>
Date: Thu, 29 Oct 2015 19:34:10 +0000
Subject: [PATCH] babel: small fix.

* lisp/ob-core.el (org-babel-execute-src-block): Simplify code slightly.

The old code would error on evaluating the call line in:

,----
| #+name: foo
| #+begin_src emacs-lisp :var bar="baz"
|   bar
| #+end_src
|
| #+call: foo[:cache yes]("qux")
|
| #+RESULTS:
| : qux
`----
---
 lisp/ob-core.el | 14 ++++++--------
 1 file changed, 6 insertions(+), 8 deletions(-)

diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index b403128..ff4c0de 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -641,13 +641,12 @@ block."
                   (copy-tree info)
                 (org-babel-get-src-block-info)))
         (merged-params (org-babel-merge-params (nth 2 info) params)))
-    (when (org-babel-check-evaluate
-          (let ((i info)) (setf (nth 2 i) merged-params) i))
-      (let* ((params (if params
-                        (org-babel-process-params merged-params)
-                      (nth 2 info)))
+    (setf (nth 2 info) merged-params)
+    (when (org-babel-check-evaluate info)
+      (cl-callf org-babel-process-params (nth 2 info))
+      (let* ((params (nth 2 info))
             (cachep (and (not arg) (cdr (assoc :cache params))
-                          (string= "yes" (cdr (assoc :cache params)))))
+                         (string= "yes" (cdr (assoc :cache params)))))
             (new-hash (when cachep (org-babel-sha1-hash info)))
             (old-hash (when cachep (org-babel-current-result-hash)))
             (cache-current-p (and (not arg) new-hash
@@ -661,8 +660,7 @@ block."
            (let ((result (org-babel-read-result)))
              (message (replace-regexp-in-string
                        "%" "%%" (format "%S" result))) result)))
-        ((org-babel-confirm-evaluate
-          (let ((i info)) (setf (nth 2 i) merged-params) i))
+        ((org-babel-confirm-evaluate info)
          (let* ((lang (nth 0 info))
                 (result-params (cdr (assoc :result-params params)))
                 (body (setf (nth 1 info)
-- 
2.6.2

-- 
Aaron Ecay