From 17016044fd293f81a71c5d82d10d338aae07a6c5 Mon Sep 17 00:00:00 2001 From: Matthew Trzcinski Date: Sun, 19 Feb 2023 18:11:51 -0500 Subject: [PATCH] ob-shell: Add async evaluation * ob-shell.el (org-babel-sh-evaluate): Add branch for async within session. Allow :async header argument to be either t or blank. * test-ob-shell.el: Add const regexp for uuids. (test-ob-shell/session-async-valid-header-arg-values): Check that :async header works for both t and blank values. (test-ob-shell/session-async-inserts-uuid-before-results-are-returned): (test-ob-shell/session-async-evaluation): Check that asynchronously evaluated results are eventually placed in the buffer. Link: https://list.orgmode.org/186283d230a.129f5feb61660123.3289004102603503414@excalamus.com/ --- lisp/ob-shell.el | 54 +++++++++++++++++++------ testing/lisp/test-ob-shell.el | 76 +++++++++++++++++++++++++++++++++++ 2 files changed, 117 insertions(+), 13 deletions(-) diff --git a/lisp/ob-shell.el b/lisp/ob-shell.el index 9e7b45a89..3a0283231 100644 --- a/lisp/ob-shell.el +++ b/lisp/ob-shell.el @@ -269,12 +269,22 @@ var of the same value." (set-marker comint-last-output-start (point)) (get-buffer (current-buffer))))))) +(defconst ob-shell-async-indicator "echo 'ob_comint_async_shell_%s_%s'" + "Session output delimiter template. +See `org-babel-comint-async-indicator'.") + +(defun ob-shell-async-chunk-callback (string) + "Filter applied to results before insertion. +See `org-babel-comint-async-chunk-callback'." + (replace-regexp-in-string (concat org-babel-sh-prompt "*") "" string)) + (defun org-babel-sh-evaluate (session body &optional params stdin cmdline) "Pass BODY to the Shell process in BUFFER. If RESULT-TYPE equals `output' then return a list of the outputs of the statements in BODY, if RESULT-TYPE equals `value' then return the value of the last statement in BODY." (let* ((shebang (cdr (assq :shebang params))) + (async (org-babel-comint-use-async params)) (results-params (cdr (assq :result-params params))) (value-is-exit-status (or (and @@ -306,19 +316,37 @@ return the value of the last statement in BODY." (concat (file-local-name script-file) " " cmdline))))) (buffer-string)))) (session ; session evaluation - (mapconcat - #'org-babel-sh-strip-weird-long-prompt - (mapcar - #'org-trim - (butlast ; Remove eoe indicator - (org-babel-comint-with-output - (session org-babel-sh-eoe-output t body) - (insert (org-trim body) "\n" - org-babel-sh-eoe-indicator) - (comint-send-input nil t)) - ;; Remove `org-babel-sh-eoe-indicator' output line. - 1)) - "\n")) + (if async + (progn + (let ((uuid (org-id-uuid))) + (org-babel-comint-async-register + session + (current-buffer) + "ob_comint_async_shell_\\(.+?\\)_\\(.+\\)" + 'ob-shell-async-chunk-callback + nil) + (org-babel-comint-async-delete-dangling-and-eval + session + (insert (format ob-shell-async-indicator "start" uuid)) + (comint-send-input nil t) + (insert (org-trim body)) + (comint-send-input nil t) + (insert (format ob-shell-async-indicator "end" uuid)) + (comint-send-input nil t)) + uuid)) + (mapconcat + #'org-babel-sh-strip-weird-long-prompt + (mapcar + #'org-trim + (butlast ; Remove eoe indicator + (org-babel-comint-with-output + (session org-babel-sh-eoe-output t body) + (insert (org-trim body) "\n" + org-babel-sh-eoe-indicator) + (comint-send-input nil t)) + ;; Remove `org-babel-sh-eoe-indicator' output line. + 1)) + "\n"))) ;; External shell script, with or without a predefined ;; shebang. ((org-string-nw-p shebang) diff --git a/testing/lisp/test-ob-shell.el b/testing/lisp/test-ob-shell.el index fe975771c..103d62048 100644 --- a/testing/lisp/test-ob-shell.el +++ b/testing/lisp/test-ob-shell.el @@ -33,6 +33,9 @@ (org-test-for-executable "sh") +(defconst test-ob-shell/uuid-regex + "[0-9a-fA-F]\\{8\\}\\b-[0-9a-fA-F]\\{4\\}\\b-[0-9a-fA-F]\\{4\\}\\b-[0-9a-fA-F]\\{4\\}\\b-[0-9a-fA-F]\\{12\\}") + ;;; Code: (ert-deftest test-ob-shell/dont-insert-spaces-on-expanded-bodies () @@ -75,6 +78,79 @@ the body of the tangled block does." (if (should (equal '((1) (2)) result)) (kill-buffer session-name)))) +(ert-deftest test-ob-shell/session-async-valid-header-arg-values () + "Test that session runs asynchronously for certain :async values." + (let ((session-name "test-ob-shell/session-async-valid-header-arg-values") + (kill-buffer-query-functions nil)) + (cl-loop + for arg-val in '("t" "") ; valid arg values + do + (org-test-with-temp-text + (concat "#+begin_src sh :session " session-name " :async " arg-val " +echo 1 +#+end_src") + (if (should + (string-match + test-ob-shell/uuid-regex + (org-trim (org-babel-execute-src-block)))) + (kill-buffer session-name)))))) + +(ert-deftest test-ob-shell/session-async-inserts-uuid-before-results-are-returned () + "Test that a uuid placeholder is inserted before results are inserted." + (let ((session-name "test-ob-shell/session-async-inserts-uuid-before-results-are-returned") + (kill-buffer-query-functions nil)) + (org-test-with-temp-text + (concat "#+begin_src sh :session " session-name " :async t +echo 1 +#+end_src") + (if (should + (string-match + test-ob-shell/uuid-regex + (org-trim (org-babel-execute-src-block)))) + (kill-buffer session-name))))) + +(ert-deftest test-ob-shell/session-async-evaluation () + "Test the async evaluation process." + ;; A uuid placeholder is immediately returned by block execution. + ;; Advise callback to check the return value for the expected value + (let* ((session-name "test-ob-shell/session-async-evaluation") + (kill-buffer-query-functions nil) + (start-time (current-time)) + (wait-time (time-add start-time 3)) + result) + (advice-add + 'ob-shell-async-chunk-callback + :filter-return + (lambda (&rest r) + (let ((result (car r))) + (should (string= result "1\n2\n")) ; expect value + result)) + `((name . ,session-name))) + ;; always remove advice, regardless of test outcome + (unwind-protect + (org-test-with-temp-text + (concat "#+begin_src sh :session " session-name " :async t +echo 1 +echo 2 +#+end_src") + (setq result (org-trim (org-babel-execute-src-block))) + (if (should + (and + ;; block should run, returning a uuid immediately + (string-match test-ob-shell/uuid-regex result) + ;; loop until callback replaces the uuid or wait-time + ;; is exceeded + (catch 'too-long + (while (string-match test-ob-shell/uuid-regex (buffer-string)) + (progn + (sleep-for 0.01) + (when (time-less-p wait-time (current-time)) + (throw 'too-long (ert-fail "Took too long to get result from callback"))))) + t))) + ;; clean up session buffer on success + (kill-buffer session-name))) + (advice-remove 'ob-shell-async-chunk-callback session-name)))) + (ert-deftest test-ob-shell/generic-uses-no-arrays () "Test generic serialization of array into a single string." (org-test-with-temp-text -- 2.39.1