Use temporary assignments when calling functions.
* gash/environment.scm (save-variables-excursion): New procedure. * gash/shell.scm (sh:exec-let): Use it to set up temporary assignments during the extent of a function. * tests/temporary-assignments.org: New file. * Makefile.am (TESTS): Add it.
This commit is contained in:
parent
b41ae32106
commit
16ba8ca016
|
@ -144,6 +144,7 @@ FULL_TESTS = \
|
|||
tests/pipes-and-booleans.org \
|
||||
tests/redirects.org \
|
||||
tests/signals.org \
|
||||
tests/temporary-assignments.org \
|
||||
tests/variable-and.org \
|
||||
tests/variable-or.org \
|
||||
tests/variable-patterns.org \
|
||||
|
|
|
@ -33,6 +33,7 @@
|
|||
read-only?
|
||||
set-read-only!
|
||||
with-variables
|
||||
save-variables-excursion
|
||||
get-environ
|
||||
with-environ
|
||||
getfun
|
||||
|
@ -202,6 +203,26 @@ extent of @var{thunk}."
|
|||
(set! inside-variables *variables*)
|
||||
(set! outside-variables *variables*)))))
|
||||
|
||||
(define (save-variables-excursion names thunk)
|
||||
"Save the variables listed in @var{names}, and call @var{thunk}. When
|
||||
@var{thunk}'s dynamic extent is left, restore the variables to their
|
||||
saved state."
|
||||
(let ((saved-variables #f))
|
||||
(dynamic-wind
|
||||
(lambda ()
|
||||
(set! saved-variables
|
||||
(map (lambda (name)
|
||||
(match (hash-ref *variables* name)
|
||||
((? vector? vec) (cons name (vector-copy vec)))
|
||||
(x (cons name x))))
|
||||
names)))
|
||||
thunk
|
||||
(lambda ()
|
||||
(for-each (match-lambda
|
||||
((name . #f) (hash-remove! *variables* name))
|
||||
((name . value) (hash-set! *variables* name value)))
|
||||
saved-variables)))))
|
||||
|
||||
(define* (get-environ #:optional (bindings '()))
|
||||
"Return a value that represents the set of current variables is
|
||||
suitable for passing to @code{environ}. If @var{bindings} is set,
|
||||
|
|
|
@ -137,11 +137,17 @@ environment variable bindings @var{bindings}."
|
|||
(set-status! exit-val))))
|
||||
(and=> (getfun name)
|
||||
(lambda (proc)
|
||||
(with-arguments (cons (car (program-arguments)) args)
|
||||
(save-variables-excursion (map car bindings)
|
||||
(lambda ()
|
||||
(call-with-return
|
||||
(lambda ()
|
||||
(apply proc args)))))))
|
||||
(for-each (match-lambda
|
||||
((name . value)
|
||||
(setvar! name value)))
|
||||
bindings)
|
||||
(with-arguments (cons (car (program-arguments)) args)
|
||||
(lambda ()
|
||||
(call-with-return
|
||||
(lambda ()
|
||||
(apply proc args)))))))))
|
||||
(and=> (search-built-ins name)
|
||||
(lambda (proc)
|
||||
;; TODO: Use 'bindings' here.
|
||||
|
|
|
@ -0,0 +1,216 @@
|
|||
;;; Gash -- Guile As SHell
|
||||
;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
|
||||
;;;
|
||||
;;; This file is part of Gash.
|
||||
;;;
|
||||
;;; Gash is free software: you can redistribute it and/or modify
|
||||
;;; it under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation, either version 3 of the License, or
|
||||
;;; (at your option) any later version.
|
||||
;;;
|
||||
;;; Gash is distributed in the hope that it will be useful,
|
||||
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
|
||||
;; Special built-ins
|
||||
|
||||
* Assignments escape special built-ins
|
||||
:script:
|
||||
#+begin_src sh
|
||||
eval 'X=foo'
|
||||
echo $X
|
||||
#+end_src
|
||||
:stdout:
|
||||
#+begin_example
|
||||
foo
|
||||
#+end_example
|
||||
|
||||
* Temporary assignments escape special built-ins
|
||||
:script:
|
||||
#+begin_src sh
|
||||
X=bar eval 'X=foo'
|
||||
echo $X
|
||||
#+end_src
|
||||
:stdout:
|
||||
#+begin_example
|
||||
foo
|
||||
#+end_example
|
||||
|
||||
* Updates of temporary assignments escape special built-ins
|
||||
:script:
|
||||
#+begin_src sh
|
||||
X=foo
|
||||
X=bar eval 'X=baz'
|
||||
echo $X
|
||||
#+end_src
|
||||
:stdout:
|
||||
#+begin_example
|
||||
baz
|
||||
#+end_example
|
||||
|
||||
* Temporary assignments are not exported in special built-ins
|
||||
:script:
|
||||
#+begin_src sh
|
||||
X=foo eval 'guile -c '\''(format #t "~a~%" (getenv "X"))'\'
|
||||
#+end_src
|
||||
:stdout:
|
||||
#+begin_example
|
||||
#f
|
||||
#+end_example
|
||||
|
||||
* Temporary exports do not escape special built-ins
|
||||
:script:
|
||||
#+begin_src sh
|
||||
X=bar
|
||||
X=foo :
|
||||
guile -c '(format #t "~a~%" (getenv "X"))'
|
||||
#+end_src
|
||||
:stdout:
|
||||
#+begin_example
|
||||
#f
|
||||
#+end_example
|
||||
|
||||
* Exports escape special built-ins
|
||||
:script:
|
||||
#+begin_src sh
|
||||
X=foo
|
||||
eval 'export X'
|
||||
guile -c '(format #t "~a~%" (getenv "X"))'
|
||||
#+end_src
|
||||
:stdout:
|
||||
#+begin_example
|
||||
foo
|
||||
#+end_example
|
||||
|
||||
* Exports of temporary assignments escape special built-ins
|
||||
:script:
|
||||
#+begin_src sh
|
||||
X=foo eval 'export X'
|
||||
guile -c '(format #t "~a~%" (getenv "X"))'
|
||||
#+end_src
|
||||
:stdout:
|
||||
#+begin_example
|
||||
foo
|
||||
#+end_example
|
||||
|
||||
|
||||
;; Functions
|
||||
|
||||
* Assignments escape functions
|
||||
:script:
|
||||
#+begin_src sh
|
||||
f() {
|
||||
X=foo
|
||||
}
|
||||
f
|
||||
echo $X
|
||||
#+end_src
|
||||
:stdout:
|
||||
#+begin_example
|
||||
foo
|
||||
#+end_example
|
||||
|
||||
* Temporary assignments do not escape functions
|
||||
:script:
|
||||
#+begin_src sh
|
||||
f() {
|
||||
X=foo
|
||||
}
|
||||
X=bar f
|
||||
echo $X
|
||||
#+end_src
|
||||
:stdout:
|
||||
#+begin_example
|
||||
|
||||
#+end_example
|
||||
|
||||
* Updates of temporary assignments do not escape functions
|
||||
:script:
|
||||
#+begin_src sh
|
||||
f() {
|
||||
X=baz
|
||||
}
|
||||
X=foo
|
||||
X=bar f
|
||||
echo $X
|
||||
#+end_src
|
||||
:stdout:
|
||||
#+begin_example
|
||||
foo
|
||||
#+end_example
|
||||
|
||||
* Temporary assignments are not exported in functions
|
||||
:script:
|
||||
#+begin_src sh
|
||||
f() {
|
||||
guile -c '(format #t "~a~%" (getenv "X"))'
|
||||
}
|
||||
X=foo f
|
||||
#+end_src
|
||||
:stdout:
|
||||
#+begin_example
|
||||
#f
|
||||
#+end_example
|
||||
|
||||
* Temporary exports do not escape functions
|
||||
:script:
|
||||
#+begin_src sh
|
||||
f() {
|
||||
:
|
||||
}
|
||||
X=bar
|
||||
X=foo f
|
||||
guile -c '(format #t "~a~%" (getenv "X"))'
|
||||
#+end_src
|
||||
:stdout:
|
||||
#+begin_example
|
||||
#f
|
||||
#+end_example
|
||||
|
||||
* Exports escape functions
|
||||
:script:
|
||||
#+begin_src sh
|
||||
f() {
|
||||
export X
|
||||
}
|
||||
X=foo
|
||||
f
|
||||
guile -c '(format #t "~a~%" (getenv "X"))'
|
||||
#+end_src
|
||||
:stdout:
|
||||
#+begin_example
|
||||
foo
|
||||
#+end_example
|
||||
|
||||
* Exports of temporary assignments do not escape functions
|
||||
:script:
|
||||
#+begin_src sh
|
||||
f() {
|
||||
export X
|
||||
}
|
||||
X=foo f
|
||||
guile -c '(format #t "~a~%" (getenv "X"))'
|
||||
#+end_src
|
||||
:stdout:
|
||||
#+begin_example
|
||||
#f
|
||||
#+end_example
|
||||
|
||||
* Read-only temporary assignments do not escape functions
|
||||
:script:
|
||||
#+begin_src sh
|
||||
f() {
|
||||
readonly X
|
||||
}
|
||||
X=foo f
|
||||
echo $X
|
||||
#+end_src
|
||||
:stdout:
|
||||
#+begin_example
|
||||
|
||||
#+end_example
|
Loading…
Reference in New Issue