andrius
/
gash
mirror of https://git.savannah.gnu.org/git/gash.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Workaround Mes' non-parameter standard ports. 

* gash/environment.scm (current-0-port): New procedure.
(current-1-port): New procedure.
(current-2-port): New procedure.
(fd->current-port): Use them instead of the standard parameters.
* gash/shell.scm (sh:with-redirects): Do not use 'parameterize' with
the non-parameter ports.
(plumb): Likewise.
This commit is contained in:
Timothy Sample 2022-12-22 11:53:59 -06:00
parent 4b1aa935de
commit 9b53a6b25b
2 changed files with 34 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
gash/environment.scm
View File

@ -56,6 +56,9 @@
sh:exit sh:exit
*fd-count* *fd-count*
fd->current-port fd->current-port
current-0-port
current-1-port
current-2-port
get-last-job get-last-job
set-last-job! set-last-job!
reap-child-processes!)) reap-child-processes!))
@ -419,6 +422,21 @@ status. If not called from within @code{call-with-return}, return
(define *fd-count* 10) (define *fd-count* 10)
(define current-0-port
(case-lambda
(() (current-input-port))
((value) (set-current-input-port value))))
(define current-1-port
(case-lambda
(() (current-output-port))
((value) (set-current-output-port value))))
(define current-2-port
(case-lambda
(() (current-error-port))
((value) (set-current-error-port value))))
(define current-3-port (make-parameter #f)) (define current-3-port (make-parameter #f))
(define current-4-port (make-parameter #f)) (define current-4-port (make-parameter #f))
(define current-5-port (make-parameter #f)) (define current-5-port (make-parameter #f))
@ -428,9 +446,9 @@ status. If not called from within @code{call-with-return}, return
(define current-9-port (make-parameter #f)) (define current-9-port (make-parameter #f))
(define fd->current-port (define fd->current-port
(let ((cps (vector current-input-port (let ((cps (vector current-0-port
current-output-port current-1-port
current-error-port current-2-port
current-3-port current-3-port
current-4-port current-4-port
current-5-port current-5-port

18
gash/shell.scm
View File

@ -241,8 +241,15 @@ if it is our responsibility to close the port."
(#f (set-status! 1) (#f (set-status! 1)
(errexit)) (errexit))
((parameter port close?) ((parameter port close?)
(parameterize ((parameter port)) (cond
(thunk)) ((eq? parameter current-0-port)
(with-input-from-port port thunk))
((eq? parameter current-1-port)
(with-output-to-port port thunk))
((eq? parameter current-2-port)
(with-error-to-port port thunk))
(else
(parameterize ((parameter port)) (thunk))))
(cond (cond
(close? (close-port port)) (close? (close-port port))
((output-port? port) (force-output port))))))) ((output-port? port) (force-output port)))))))
@ -311,9 +318,10 @@ be closed in the new process."
(when close (close-port close)) (when close (close-port close))
(let ((in (or in (current-input-port))) (let ((in (or in (current-input-port)))
(out (or out (current-output-port)))) (out (or out (current-output-port))))
(parameterize ((current-input-port in) (with-input-from-port in
(current-output-port out)) (lambda ()
(thunk))))) (with-output-to-port out
thunk))))))
(pid (%subshell thunk*))) (pid (%subshell thunk*)))
(when in (close-port in)) (when in (close-port in))
(when out (close-port out)) (when out (close-port out))