From 16ba8ca01620a00072ca2ac70b1a6d5b52260b6a Mon Sep 17 00:00:00 2001 From: Timothy Sample Date: Tue, 27 Aug 2019 09:16:23 -0400 Subject: [PATCH] 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. --- Makefile.am | 1 + gash/environment.scm | 21 ++++ gash/shell.scm | 14 ++- tests/temporary-assignments.org | 216 ++++++++++++++++++++++++++++++++ 4 files changed, 248 insertions(+), 4 deletions(-) create mode 100644 tests/temporary-assignments.org diff --git a/Makefile.am b/Makefile.am index 6f9f8c5..62f73b9 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 \ diff --git a/gash/environment.scm b/gash/environment.scm index c545511..77ddf4b 100644 --- a/gash/environment.scm +++ b/gash/environment.scm @@ -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, diff --git a/gash/shell.scm b/gash/shell.scm index 2d35286..ec74d93 100644 --- a/gash/shell.scm +++ b/gash/shell.scm @@ -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. diff --git a/tests/temporary-assignments.org b/tests/temporary-assignments.org new file mode 100644 index 0000000..3b684e8 --- /dev/null +++ b/tests/temporary-assignments.org @@ -0,0 +1,216 @@ +;;; Gash -- Guile As SHell +;;; Copyright © 2019 Timothy Sample +;;; +;;; 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 . + + +;; 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