From mboxrd@z Thu Jan 1 00:00:00 1970 From: Aaron Ecay Subject: [RFC] [PATCH] bug with babel call lines and cache Date: Fri, 30 Oct 2015 11:34:30 +0000 Message-ID: <87twp8wpx5.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:43338) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Zs7xC-0002md-N3 for emacs-orgmode@gnu.org; Fri, 30 Oct 2015 07:34:44 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Zs7x7-0000rr-Lx for emacs-orgmode@gnu.org; Fri, 30 Oct 2015 07:34:42 -0400 Received: from mail-wm0-x234.google.com ([2a00:1450:400c:c09::234]:34730) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Zs7x7-0000rc-Cm for emacs-orgmode@gnu.org; Fri, 30 Oct 2015 07:34:37 -0400 Received: by wmff134 with SMTP id f134so9559948wmf.1 for ; Fri, 30 Oct 2015 04:34:36 -0700 (PDT) Received: from localhost ([145.118.91.95]) by smtp.gmail.com with ESMTPSA id e79sm2449909wmd.16.2015.10.30.04.34.35 for (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Fri, 30 Oct 2015 04:34:35 -0700 (PDT) List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: Org-mode --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello all, In playing around with some of the cache-related issues, I=E2=80=99ve disco= vered that C-c C-c on the following #+call line will give the following backtrace: ,---- | #+name: foo | #+begin_src emacs-lisp :var bar=3D"baz" | bar | #+end_src | | #+call: foo[:cache yes]("qux") | | #+RESULTS: | : qux `---- ,---- | Debugger entered--Lisp error: (wrong-type-argument listp "bar=3D\"qux\"") | car("bar=3D\"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=3D\"qux\"") (params (:ca= che . "yes") (:comments . "yes") (:exports . "code") (:hlines . "no") (:now= eb . "no") (:padline . "") (:result-params "replace") (:result-type . value= ) (:results . "silent") (:session . "none") (:shebang . "") (:tangle . "no"= ) (:var . "bar=3D\"qux\"")) (body . "bar") t) (var) (format "%S" (print (li= st (car var) (list (quote quote) (cdr var))))))("bar=3D\"qux\"") | mapconcat((closure ((result-params "replace") (vars "bar=3D\"qux\"") (p= arams (:cache . "yes") (:comments . "yes") (:exports . "code") (:hlines . "= no") (:noweb . "no") (:padline . "") (:result-params "replace") (:result-ty= pe . value) (:results . "silent") (:session . "none") (:shebang . "") (:tan= gle . "no") (:var . "bar=3D\"qux\"")) (body . "bar") t) (var) (format "%S" = (print (list (car var) (list (quote quote) (cdr var)))))) ("bar=3D\"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 ... ...)) var= s "\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") (:s= ession . "none") (:shebang . "") (:tangle . "no") (:var . "bar=3D\"qux\""))) | funcall(org-babel-expand-body:emacs-lisp "bar" ((:cache . "yes") (:comm= ents . "yes") (:exports . "code") (:hlines . "no") (:noweb . "no") (:padlin= e . "") (:result-params "replace") (:result-type . value) (:results . "sile= nt") (:session . "none") (:shebang . "") (:tangle . "no") (:var . "bar=3D\"= qux\""))) | (if (fboundp expand-cmd) (funcall expand-cmd body params) (org-babel-ex= pand-body:generic body params (and (fboundp assignments-cmd) (funcall assig= nments-cmd params)))) | (let* ((rm (function (lambda (lst) (let ((--dolist-tail-- ...) p) (whil= e --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-no= web-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-bo= dy: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))) (no= rm (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 (f= boundp assignments-cmd) (funcall assignments-cmd params)))))) (let* ((it (f= ormat "%s-%s" (mapconcat (function identity) (delq nil ...) ":") expanded))= (hash (sha1 it))) (if (with-no-warnings (called-interactively-p (quote int= eractive))) (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=3D\"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=3D "y= es" (cdr (assoc :cache params))))) (new-hash (if cachep (progn (org-babel-s= ha1-hash info)))) (old-hash (if cachep (progn (org-babel-current-result-has= h)))) (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 ((res= ult (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* (...) (setc= ar 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..." (capita= lize 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-bab= el-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-param= s) (nth 2 info))) (cachep (and (not arg) (cdr (assoc :cache params)) (strin= g=3D "yes" (cdr (assoc :cache params))))) (new-hash (if cachep (progn (org-= babel-sha1-hash info)))) (old-hash (if cachep (progn (org-babel-current-res= ult-hash)))) (cache-current-p (and (not arg) new-hash (equal new-hash old-h= ash)))) (cond (cache-current-p (save-excursion (goto-char (org-babel-where-= is-src-block-result nil info)) (forward-line) (skip-chars-forward " ") (le= t ((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 (l= et* ... ...)) (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-orig= inal)))))))) | (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-p= rocess-params merged-params) (nth 2 info))) (cachep (and (not arg) (cdr (as= soc :cache params)) (string=3D "yes" (cdr ...)))) (new-hash (if cachep (pro= gn (org-babel-sha1-hash info)))) (old-hash (if cachep (progn (org-babel-cur= rent-result-hash)))) (cache-current-p (and (not arg) new-hash (equal new-ha= sh old-hash)))) (cond (cache-current-p (save-excursion (goto-char (org-babe= l-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 ...) (d= ir ...) (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-b= abel-get-inline-src-block-matches) (match-beginning 0)))) (info (if info (c= opy-tree info) (org-babel-get-src-block-info))) (merged-params (org-babel-m= erge-params (nth 2 info) params))) (if (org-babel-check-evaluate (let ((i i= nfo)) (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=3D "yes" ...))) (new-hash (if cach= ep (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=3Dfoo[:cache yes](\"qux\")") | (if (consp el) el (org-babel-ref-parse el)) | (lambda (el) (if (consp el) el (org-babel-ref-parse el)))("results=3Dfo= o[:cache yes](\"qux\")") | mapcar((lambda (el) (if (consp el) el (org-babel-ref-parse el))) ("resu= lts=3Dfoo[: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)) (lis= t processed-vars) (org-babel-disassemble-tables processed-vars (cdr (assoc = :hlines params)) (cdr (assoc :colnames params)) (cdr (assoc :rownames param= s))))) (raw-result (or (cdr (assoc :results params)) "")) (result-params (a= ppend (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 :ro= wname-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-para= ms) (quote value)) (t (quote value))))) (org-remove-if (function (lambda (x= ) (memq (car x) (quote (:colname-names :rowname-names :result-params :resul= t-type :var))))) params))) | org-babel-process-params(((:comments . "yes") (:shebang . "") (:cache .= "no") (:padline . "") (:noweb . "no") (:tangle . "no") (:exports . "code")= (:results . "replace") (:var . "results=3Dfoo[:cache yes](\"qux\")") (:hli= nes . "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=E2=80=99m slightly uncomfortable about it because I remember touching the various nested =E2=80=98let=E2=80=99s which= toggle between different states of =E2=80=98params=E2=80=99 in that function once = upon a time, and they seemed important. Now I can=E2=80=99t remember why, though. So I=E2=80=99d be happier if someone else familiar with babel=E2=80=99s cod= e looked the patch over. If no one pipes up in a few days, I will push the patch and see if anything breaks. Thanks, --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-babel-small-fix.patch >From a7d89a81d0197dde7249a510ad51c999fffd4e24 Mon Sep 17 00:00:00 2001 From: Aaron Ecay 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 --=-=-= Content-Type: text/plain -- Aaron Ecay --=-=-=--