diff --git a/.dir-locals.el b/.dir-locals.el index 638bf5b..10deffe 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -10,4 +10,5 @@ (eval . (put 'call-with-backquoted-input-port 'scheme-indent-function 1)) (eval . (put 'make-script 'scheme-indent-function 1)) (eval . (put 'sh:subshell 'scheme-indent-function 1)) + (eval . (put 'sh:substitute-command 'scheme-indent-function 1)) (eval . (put 'sh:with-redirects 'scheme-indent-function 2))))) diff --git a/geesh/shell.scm b/geesh/shell.scm index ea7978b..685aef3 100644 --- a/geesh/shell.scm +++ b/geesh/shell.scm @@ -2,10 +2,12 @@ #:use-module (geesh built-ins) #:use-module (geesh environment) #:use-module (ice-9 match) + #:use-module (ice-9 textual-ports) #:use-module (srfi srfi-26) #:export (sh:exec-let sh:exec sh:subshell + sh:substitute-command sh:with-redirects)) ;;; Commentary: @@ -152,12 +154,35 @@ filename used for the here-document contents." (for-each restore-saved-fdes! (reverse saved-fds)))))) -;;; Subshells. +;;; Subshells and command substitution. -(define (sh:subshell env thunk) - "Run @var{thunk} in a subshell environment." +(define* (%subshell thunk) + "Run @var{thunk} in a new process and return the ID of the new +process." (match (primitive-fork) (0 (thunk) (primitive-exit)) - (pid (match-let (((pid . status) (waitpid pid))) - (set-var! env "?" (number->string (status:exit-val status))))))) + (pid pid))) + +(define (sh:subshell env thunk) + "Run @var{thunk} in a subshell environment." + (match-let* ((pid (%subshell thunk)) + ((pid . status) (waitpid pid))) + (set-var! env "?" (number->string (status:exit-val status))))) + +(define (sh:substitute-command env thunk) + "Run @var{thunk} in a subshell environment and return its output as +a string." + (match-let* (((sink . source) (pipe)) + (thunk* (lambda () + (close-port sink) + (let ((redirs `((< 0 "/dev/null") + (>& 1 ,(fileno source)) + (> 2 "/dev/null")))) + (sh:with-redirects env redirs thunk)))) + (pid (%subshell thunk*))) + (close-port source) + (match-let ((result (string-trim-right (get-string-all sink) #\newline)) + ((pid . status) (waitpid pid))) + (set-var! env "?" (number->string (status:exit-val status))) + result))) diff --git a/tests/shell.scm b/tests/shell.scm index 141d13b..c714ead 100644 --- a/tests/shell.scm +++ b/tests/shell.scm @@ -325,4 +325,90 @@ ;; TODO: Test other means of manipulating the environment and exit ;; statuses. + +;;; Command substitutions. + +(test-equal "Substitutes output from built-in" + "foo" + (let ((env (make-environment '()))) + (sh:substitute-command env + (lambda () + (display "foo"))))) + +(test-equal "Substitutions ignore standard error for built-ins" + "foo" + (let ((env (make-environment '()))) + (sh:substitute-command env + (lambda () + (display "foo") + (display "bar" (current-error-port)))))) + +(test-equal "Substitutions have null standard input for built-ins" + "" + (let ((env (make-environment '()))) + (sh:substitute-command env + (lambda () + (display (get-string-all (current-input-port))))))) + +(test-equal "Substitutes output from external utilities" + "foo" + (call-with-temporary-directory + (lambda (directory) + (let ((utility (string-append directory "/utility")) + (env (make-environment '()))) + (make-script utility + (display "foo")) + (sh:substitute-command env + (lambda () + (sh:exec env utility))))))) + +(test-equal "Substitutions ignore standard error for external utilities" + "foo" + (call-with-temporary-directory + (lambda (directory) + (let ((utility (string-append directory "/utility")) + (env (make-environment '()))) + (make-script utility + (display "foo") + (display "bar" (current-error-port))) + (sh:substitute-command env + (lambda () + (sh:exec env utility))))))) + +(test-equal "Substitutions have null standard input for external utilities" + "" + (call-with-temporary-directory + (lambda (directory) + (let ((utility (string-append directory "/utility")) + (env (make-environment '()))) + (make-script utility + (use-modules (ice-9 textual-ports)) + (display (get-string-all (current-input-port)))) + (sh:substitute-command env + (lambda () + (sh:exec env utility))))))) + +(test-equal "Trailing newlines are trimmed from substitutions" + "foo" + (let ((env (make-environment '()))) + (sh:substitute-command env + (lambda () + (display "foo") + (newline))))) + +(test-equal "Non-trailing newlines are preserved in substitutions" + "\nfoo\nbar" + (let ((env (make-environment '()))) + (sh:substitute-command env + (lambda () + (newline) + (display "foo") + (newline) + (display "bar"))))) + +(test-equal "Empty substitutions produce empty strings" + "" + (let ((env (make-environment '()))) + (sh:substitute-command env noop))) + (test-end)