From f7aa8c19f5170dbf09538686fb569f9b60acbd6c Mon Sep 17 00:00:00 2001 From: Matthew Trzcinski Date: Wed, 22 Mar 2023 14:55:11 -0400 Subject: [PATCH] ob-shell.el: Add async evaluation * ob-shell.el (org-babel-sh-evaluate): Add condition for async within session. Allow :async header argument to be either t or blank. * test-ob-shell.el: (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): Check that UUID is used as placeholder until results return. (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 | 54 +++++++++++++++++++++++++++++++++++ 2 files changed, 95 insertions(+), 13 deletions(-) diff --git a/lisp/ob-shell.el b/lisp/ob-shell.el index 9e7b45a89..340c79abe 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 comint-prompt-regexp "" 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 8366f9dbe..879555af0 100644 --- a/testing/lisp/test-ob-shell.el +++ b/testing/lisp/test-ob-shell.el @@ -27,6 +27,7 @@ ;;; Requirements: (require 'ob-core) +(require 'org-macs) (unless (featurep 'ob-shell) (signal 'missing-test-dependency "Support for Shell code blocks")) @@ -75,6 +76,59 @@ 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)) + (dolist (arg-val '("t" "")) + (org-test-with-temp-text + (concat "#+begin_src sh :session " session-name " :async " arg-val " +echo 1 +#+end_src") + (if (should + (string-match + org-uuid-regexp + (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 + org-uuid-regexp + (org-trim (org-babel-execute-src-block)))) + (kill-buffer session-name))))) + +(ert-deftest test-ob-shell/session-async-evaluation () + "Test the async evaluation process." + (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)) + uuid-placeholder) + (org-test-with-temp-text + (concat "#+begin_src sh :session " session-name " :async t +echo 1 +echo 2 +#+end_src") + (setq uuid-placeholder (org-trim (org-babel-execute-src-block))) + (catch 'too-long + (while (string-match uuid-placeholder (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")))))) + (search-forward "#+results") + (beginning-of-line 2) + (if (should (string= ": 1\n: 2\n" (buffer-substring-no-properties (point) (point-max)))) + (kill-buffer 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