forked from mirrors/org-mode
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/
This commit is contained in:
parent
180c1c37a9
commit
f7aa8c19f5
|
@ -269,12 +269,22 @@ var of the same value."
|
||||||
(set-marker comint-last-output-start (point))
|
(set-marker comint-last-output-start (point))
|
||||||
(get-buffer (current-buffer)))))))
|
(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)
|
(defun org-babel-sh-evaluate (session body &optional params stdin cmdline)
|
||||||
"Pass BODY to the Shell process in BUFFER.
|
"Pass BODY to the Shell process in BUFFER.
|
||||||
If RESULT-TYPE equals `output' then return a list of the outputs
|
If RESULT-TYPE equals `output' then return a list of the outputs
|
||||||
of the statements in BODY, if RESULT-TYPE equals `value' then
|
of the statements in BODY, if RESULT-TYPE equals `value' then
|
||||||
return the value of the last statement in BODY."
|
return the value of the last statement in BODY."
|
||||||
(let* ((shebang (cdr (assq :shebang params)))
|
(let* ((shebang (cdr (assq :shebang params)))
|
||||||
|
(async (org-babel-comint-use-async params))
|
||||||
(results-params (cdr (assq :result-params params)))
|
(results-params (cdr (assq :result-params params)))
|
||||||
(value-is-exit-status
|
(value-is-exit-status
|
||||||
(or (and
|
(or (and
|
||||||
|
@ -306,6 +316,24 @@ return the value of the last statement in BODY."
|
||||||
(concat (file-local-name script-file) " " cmdline)))))
|
(concat (file-local-name script-file) " " cmdline)))))
|
||||||
(buffer-string))))
|
(buffer-string))))
|
||||||
(session ; session evaluation
|
(session ; session evaluation
|
||||||
|
(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
|
(mapconcat
|
||||||
#'org-babel-sh-strip-weird-long-prompt
|
#'org-babel-sh-strip-weird-long-prompt
|
||||||
(mapcar
|
(mapcar
|
||||||
|
@ -318,7 +346,7 @@ return the value of the last statement in BODY."
|
||||||
(comint-send-input nil t))
|
(comint-send-input nil t))
|
||||||
;; Remove `org-babel-sh-eoe-indicator' output line.
|
;; Remove `org-babel-sh-eoe-indicator' output line.
|
||||||
1))
|
1))
|
||||||
"\n"))
|
"\n")))
|
||||||
;; External shell script, with or without a predefined
|
;; External shell script, with or without a predefined
|
||||||
;; shebang.
|
;; shebang.
|
||||||
((org-string-nw-p shebang)
|
((org-string-nw-p shebang)
|
||||||
|
|
|
@ -27,6 +27,7 @@
|
||||||
;;; Requirements:
|
;;; Requirements:
|
||||||
|
|
||||||
(require 'ob-core)
|
(require 'ob-core)
|
||||||
|
(require 'org-macs)
|
||||||
|
|
||||||
(unless (featurep 'ob-shell)
|
(unless (featurep 'ob-shell)
|
||||||
(signal 'missing-test-dependency "Support for Shell code blocks"))
|
(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))
|
(if (should (equal '((1) (2)) result))
|
||||||
(kill-buffer session-name))))
|
(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<point>
|
||||||
|
#+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<point>
|
||||||
|
#+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<point>
|
||||||
|
#+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 ()
|
(ert-deftest test-ob-shell/generic-uses-no-arrays ()
|
||||||
"Test generic serialization of array into a single string."
|
"Test generic serialization of array into a single string."
|
||||||
(org-test-with-temp-text
|
(org-test-with-temp-text
|
||||||
|
|
Loading…
Reference in a new issue