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/pipes-and-booleans.org \
|
||||||
tests/redirects.org \
|
tests/redirects.org \
|
||||||
tests/signals.org \
|
tests/signals.org \
|
||||||
|
tests/temporary-assignments.org \
|
||||||
tests/variable-and.org \
|
tests/variable-and.org \
|
||||||
tests/variable-or.org \
|
tests/variable-or.org \
|
||||||
tests/variable-patterns.org \
|
tests/variable-patterns.org \
|
||||||
|
|
|
@ -33,6 +33,7 @@
|
||||||
read-only?
|
read-only?
|
||||||
set-read-only!
|
set-read-only!
|
||||||
with-variables
|
with-variables
|
||||||
|
save-variables-excursion
|
||||||
get-environ
|
get-environ
|
||||||
with-environ
|
with-environ
|
||||||
getfun
|
getfun
|
||||||
|
@ -202,6 +203,26 @@ extent of @var{thunk}."
|
||||||
(set! inside-variables *variables*)
|
(set! inside-variables *variables*)
|
||||||
(set! outside-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 '()))
|
(define* (get-environ #:optional (bindings '()))
|
||||||
"Return a value that represents the set of current variables is
|
"Return a value that represents the set of current variables is
|
||||||
suitable for passing to @code{environ}. If @var{bindings} is set,
|
suitable for passing to @code{environ}. If @var{bindings} is set,
|
||||||
|
|
|
@ -137,11 +137,17 @@ environment variable bindings @var{bindings}."
|
||||||
(set-status! exit-val))))
|
(set-status! exit-val))))
|
||||||
(and=> (getfun name)
|
(and=> (getfun name)
|
||||||
(lambda (proc)
|
(lambda (proc)
|
||||||
(with-arguments (cons (car (program-arguments)) args)
|
(save-variables-excursion (map car bindings)
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(call-with-return
|
(for-each (match-lambda
|
||||||
(lambda ()
|
((name . value)
|
||||||
(apply proc args)))))))
|
(setvar! name value)))
|
||||||
|
bindings)
|
||||||
|
(with-arguments (cons (car (program-arguments)) args)
|
||||||
|
(lambda ()
|
||||||
|
(call-with-return
|
||||||
|
(lambda ()
|
||||||
|
(apply proc args)))))))))
|
||||||
(and=> (search-built-ins name)
|
(and=> (search-built-ins name)
|
||||||
(lambda (proc)
|
(lambda (proc)
|
||||||
;; TODO: Use 'bindings' here.
|
;; 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