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

[Aaron Ecay <aaronecay@gmail.com>]

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

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,

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-babel-small-fix.patch --]
[-- Type: text/x-diff, Size: 1948 bytes --]

From a7d89a81d0197dde7249a510ad51c999fffd4e24 Mon Sep 17 00:00:00 2001
From: Aaron Ecay <aaronecay@gmail.com>
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


[-- Attachment #3: Type: text/plain, Size: 16 bytes --]


-- 
Aaron Ecay