Add command substitution semantics
* geesh/shell.scm (%subshell): New function factored out from 'subshell'. (subshell): Use it. (substitute-command): New public function. * tests/shell.scm: Test it. * .dir-locals.el: Indent it nicely.
This commit is contained in:
parent
3148f66a21
commit
6b6ca11bce
|
@ -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)))))
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue