Skip to content
Snippets Groups Projects
Commit 48a58c5e authored by Robert Goldman's avatar Robert Goldman
Browse files

Merge branch '146-setf-uiop-getenv-var-nil-should-unset-environment-variable-var' into 'master'

Resolve "(SETF (UIOP:GETENV VAR) NIL) should unset environment variable VAR"

Closes #146

See merge request asdf/asdf!223
parents 44f0a950 10b4a299
No related branches found
No related tags found
No related merge requests found
......@@ -525,7 +525,7 @@
(loop :for q :in '(speed space safety debug) :do
#+mkcl (DBG :os i q s (assoc q s))
(assert-equal i (second (assoc q s))))))
;;; The order does not seem to be significant, should better test that all values are the same
;;; The order does not seem to be significant, should better test that all values are the same
(assert-equal (get-optimization-settings) settings))
(DBG :standard-case-symbol-name)
......@@ -751,3 +751,25 @@
(uiop:implementation-identifier))
(let ((*features* (cons :sb-thread *features*)))
(uiop:implementation-identifier)))))
(DBG "Check setting environment variable to NIL.")
(assert
(catch 'clasp-error
(handler-bind (#+clasp
(error #'(lambda (e)
(throw 'clasp-error t))))
(flet ((some-action (value)
(declare (ignore value)))
(ensure-environment-is-clean ()
(unless (eq nil (uiop:getenv "VAR_FOR_ASDF_TEST"))
(error "The variable VAR_FOR_ASDF_TEST should not be bound."))))
(let ((saved-value
(uiop:getenv "VAR_FOR_ASDF_TEST")))
(ensure-environment-is-clean)
(setf (uiop:getenv "VAR_FOR_ASDF_TEST") "alternative value")
(unwind-protect (some-action (uiop:getenv "VAR_FOR_ASDF_TEST"))
(setf (uiop:getenv "VAR_FOR_ASDF_TEST") saved-value))
(ensure-environment-is-clean)))
#-clasp t
;; signal an error if this test passes, unexpectedly, on clasp
#+clasp nil)))
......@@ -121,18 +121,56 @@ use getenvp to return NIL in such a case."
(defsetf getenv (x) (val)
"Set an environment variable."
(declare (ignorable x val))
#+allegro `(setf (sys:getenv ,x) ,val)
#+clasp `(ext:setenv ,x ,val)
#+clisp `(system::setenv ,x ,val)
#+clozure `(ccl:setenv ,x ,val)
#+cmucl `(unix:unix-setenv ,x ,val 1)
#+(or ecl clasp) `(ext:setenv ,x ,val)
#+lispworks `(setf (lispworks:environment-variable ,x) ,val)
#+mkcl `(mkcl:setenv ,x ,val)
#+sbcl `(progn (require :sb-posix) (symbol-call :sb-posix :setenv ,x ,val 1))
#-(or allegro clasp clisp clozure cmucl ecl lispworks mkcl sbcl)
'(not-implemented-error '(setf getenv)))
(declare (ignorable x val)) ; for the not-implemented cases.
(if (constantp val)
(if val
#+allegro `(setf (sys:getenv ,x) ,val)
#+clasp `(ext:setenv ,x ,val)
#+clisp `(system::setenv ,x ,val)
#+clozure `(ccl:setenv ,x ,val)
#+cmucl `(unix:unix-setenv ,x ,val 1)
#+ecl `(ext:setenv ,x ,val)
#+lispworks `(setf (lispworks:environment-variable ,x) ,val)
#+mkcl `(mkcl:setenv ,x ,val)
#+sbcl `(progn (require :sb-posix) (symbol-call :sb-posix :setenv ,x ,val 1))
#-(or allegro clasp clisp clozure cmucl ecl lispworks mkcl sbcl)
'(not-implemented-error '(setf getenv))
;; VAL is NIL, unset the variable
#+allegro `(symbol-call :excl.osi :unsetenv ,x)
;; #+clasp `(ext:setenv ,x ,val) ; UNSETENV is not supported.
#+clisp `(system::setenv ,x ,val) ; need fix -- no idea if this works.
#+clozure `(ccl:unsetenv ,x)
#+cmucl `(unix:unix-unsetenv ,x)
#+ecl `(ext:setenv ,x ,val) ; Looked at source, don't see UNSETENV
#+lispworks `(setf (lispworks:environment-variable ,x) ,val) ; according to their docs, this should unset the variable
#+mkcl `(mkcl:setenv ,x ,val) ; like other ECL-family implementations, don't see UNSETENV
#+sbcl `(progn (require :sb-posix) (symbol-call :sb-posix :unsetenv ,x))
#-(or allegro clisp clozure cmucl ecl lispworks mkcl sbcl)
'(not-implemented-error 'unsetenv))
`(if ,val
#+allegro (setf (sys:getenv ,x) ,val)
#+clasp (ext:setenv ,x ,val)
#+clisp (system::setenv ,x ,val)
#+clozure (ccl:setenv ,x ,val)
#+cmucl (unix:unix-setenv ,x ,val 1)
#+ecl (ext:setenv ,x ,val)
#+lispworks (setf (lispworks:environment-variable ,x) ,val)
#+mkcl (mkcl:setenv ,x ,val)
#+sbcl (progn (require :sb-posix) (symbol-call :sb-posix :setenv ,x ,val 1))
#-(or allegro clasp clisp clozure cmucl ecl lispworks mkcl sbcl)
'(not-implemented-error '(setf getenv))
;; VAL is NIL, unset the variable
#+allegro (symbol-call :excl.osi :unsetenv ,x)
;; #+clasp (ext:setenv ,x ,val) ; UNSETENV not supported
#+clisp (system::setenv ,x ,val) ; need fix -- no idea if this works.
#+clozure (ccl:unsetenv ,x)
#+cmucl (unix:unix-unsetenv ,x)
#+ecl (ext:setenv ,x ,val) ; Looked at source, don't see UNSETENV
#+lispworks (setf (lispworks:environment-variable ,x) ,val) ; according to their docs, this should unset the variable
#+mkcl (mkcl:setenv ,x ,val) ; like other ECL-family implementations, don't see UNSETENV
#+sbcl (progn (require :sb-posix) (symbol-call :sb-posix :unsetenv ,x))
#-(or allegro clisp clozure cmucl ecl lispworks mkcl sbcl)
'(not-implemented-error 'unsetenv))))
(defun getenvp (x)
"Predicate that is true if the named variable is present in the libc environment,
......@@ -404,5 +442,3 @@ the number having BYTES octets (defaulting to 4)."
(end-of-file (c)
(declare (ignore c))
nil)))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment