From e7f1a59167de88fb9a5b96a0e1ac3199f105f600 Mon Sep 17 00:00:00 2001 From: Jack Kamm Date: Mon, 7 Sep 2020 00:41:52 -0700 Subject: [PATCH] ob-R: Fix session output with substrings matching prompts * lisp/ob-R.el (ess-send-string): Declare external function. (org-babel-R-evaluate-session): New implementation for session output results, that replaces calls to org-babel-comint-with-output with custom code. * testing/lisp/test-ob-R.el (test-ob-R/prompt-output): New test for output results containing angle brackets. (test-ob-R/output-nonprinted): New test for output results that aren't explicitly printed. Fixes issue reported in https://orgmode.org/list/875zgjh8wn.fsf@gmail.com/, https://orgmode.org/list/87r1rqled0.fsf@havana/ --- lisp/ob-R.el | 38 ++++++++++++++++++++------------------ testing/lisp/test-ob-R.el | 13 +++++++++++++ 2 files changed, 33 insertions(+), 18 deletions(-) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 5e9d35f58..dffbbe112 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -38,6 +38,8 @@ (declare-function ess-make-buffer-current "ext:ess-inf" ()) (declare-function ess-eval-buffer "ext:ess-inf" (vis)) (declare-function ess-wait-for-process "ext:ess-inf" (&optional proc sec-prompt wait force-redisplay)) +(declare-function ess-send-string "ext:ess-inf" + (process string &optional visibly message _type)) (defconst org-babel-header-args:R '((width . :any) @@ -437,24 +439,24 @@ (defun org-babel-R-evaluate-session (org-babel-import-elisp-from-file tmp-file '(16))) column-names-p))) (output - (mapconcat - 'org-babel-chomp - (butlast - (delq nil - (mapcar - (lambda (line) (when (> (length line) 0) line)) - (mapcar - (lambda (line) ;; cleanup extra prompts left in output - (if (string-match - "^\\([>+.]\\([ ][>.+]\\)*[ ]\\)" - (car (split-string line "\n"))) - (substring line (match-end 1)) - line)) - (org-babel-comint-with-output (session org-babel-R-eoe-output) - (insert (mapconcat 'org-babel-chomp - (list body org-babel-R-eoe-indicator) - "\n")) - (inferior-ess-send-input)))))) "\n")))) + (with-current-buffer session + (let* ((tmp-file (org-babel-temp-file "R-")) + (process (get-buffer-process (current-buffer))) + (string-buffer "") + (comint-output-filter-functions + (cons (lambda (text) (setq string-buffer + (concat string-buffer text))) + comint-output-filter-functions))) + (with-temp-file tmp-file + (insert body)) + (ess-send-string + process (format "tryCatch(source('%s', print.eval=TRUE), finally=print(%s))" + (org-babel-process-file-name tmp-file 'noquote) + org-babel-R-eoe-indicator)) + (while (not (string-match (regexp-quote org-babel-R-eoe-output) + string-buffer)) + (accept-process-output process)) + (substring string-buffer 0 (match-beginning 0))))))) (defun org-babel-R-process-value-result (result column-names-p) "R-specific processing of return value. diff --git a/testing/lisp/test-ob-R.el b/testing/lisp/test-ob-R.el index 7ce340ba4..ff7ea19d5 100644 --- a/testing/lisp/test-ob-R.el +++ b/testing/lisp/test-ob-R.el @@ -97,6 +97,19 @@ (ert-deftest test-ob-R/results-file () (org-babel-goto-named-result "TESTSRC") (forward-line 1) (should (string= "[[file:junk/test.org]]" (buffer-substring-no-properties (point-at-bol) (point-at-eol))))))) + +(ert-deftest test-ob-R/prompt-output () + (let (ess-ask-for-ess-directory ess-history-file) + (org-test-with-temp-text + "#+begin_src R :results output :session\nprint(\" \")\nprint(\"one three\")\nprint(\"end\")\n#+end_src\n" + (should (string= "[1] \" \"\n[1] \"one three\"\n[1] \"end\"\n" (org-babel-execute-src-block)))))) + +(ert-deftest test-ob-R/output-nonprinted () + (let (ess-ask-for-ess-directory ess-history-file) + (org-test-with-temp-text + "#+begin_src R :results output :session\n4.0 * 3.5\nlog(10)\nlog10(10)\n(3 + 1) * 5\n3^-1\n1/0\n#+end_src\n" + (should (string= "[1] 14\n[1] 2.302585\n[1] 1\n[1] 20\n[1] 0.3333333\n[1] Inf\n" (org-babel-execute-src-block)))))) + (provide 'test-ob-R) ;;; test-ob-R.el ends here -- 2.28.0