From 4114fc931e51558e4afc0416198ec8f3d35b78e6 Mon Sep 17 00:00:00 2001
From: Orivej Desh <orivej@gmx.fr>
Date: Thu, 4 Jun 2015 05:00:32 +0000
Subject: [PATCH] Fix passing environment variables.

---
 src/cmucl.lisp     |  2 +-
 src/openmcl.lisp   |  2 +-
 src/sbcl.lisp      |  4 ++--
 src/utilities.lisp | 21 ++++++++++-----------
 tests/tests.lisp   | 41 +++++++++++++++++++++++++++++------------
 5 files changed, 43 insertions(+), 27 deletions(-)

diff --git a/src/cmucl.lisp b/src/cmucl.lisp
index 5f2e4e4..0778fac 100644
--- a/src/cmucl.lisp
+++ b/src/cmucl.lisp
@@ -10,7 +10,7 @@
                      environment)))
     (setf (getf rest :env)
           (if replace-environment-p
-              (append env '((:PATH . "")))
+              env
               (append env ext:*environment-list*))))
   (remf rest :replace-environment-p)
   (remf rest :environment)
diff --git a/src/openmcl.lisp b/src/openmcl.lisp
index 4fa39f8..0e15855 100644
--- a/src/openmcl.lisp
+++ b/src/openmcl.lisp
@@ -12,7 +12,7 @@
 (defmethod run
     (program args &rest rest &key replace-environment-p &allow-other-keys)
   (when replace-environment-p
-    (setf args (append (list "-i" program "PATH=''") args))
+    (setf args (append (list "-i" program) args))
     (setf program "env"))
   (process-status (apply #'ccl:run-program
                          program (stringify-args args) :wait t
diff --git a/src/sbcl.lisp b/src/sbcl.lisp
index a1b69a7..6610fce 100644
--- a/src/sbcl.lisp
+++ b/src/sbcl.lisp
@@ -11,10 +11,10 @@
     (warn "No environment control in SBCL on Windows.")
     (remf rest :environment))
   #-win32
-  (let ((env (reformat-environment environment)))
+  (let ((env (environment-list environment)))
     (setf (getf rest :environment)
           (if replace-environment-p
-              (append env '("PATH=''"))
+              env
               (append env (sb-ext:posix-environ)))))
   (remf rest :replace-environment-p)
   rest)
diff --git a/src/utilities.lisp b/src/utilities.lisp
index 64f404b..981e896 100644
--- a/src/utilities.lisp
+++ b/src/utilities.lisp
@@ -8,31 +8,30 @@
 (defun stringify-args (args)
   (mapcar (lambda (arg)
             (typecase arg
+              (string                arg)
               (sequence              (coerce arg 'string))
               ((or symbol character) (string arg))
-              (number                (format nil "~a" arg))
+              (number                (princ-to-string arg))
               (pathname              (namestring arg))))
           args))
 
-(defun reformat-environment (environment)
-  "SBCL accepts vars as either (\"FOO=meh\" ...) or ((:foo . \"meh\")
-  ...), but not ((\"FOO\" . \"meh\") ...), so we build up the first
-  kind (since the second kind is potentially lossy)."
-  ;; FIXME: probably need to escape single-quotes and backslashes
-  (mapcar (lambda (var) (format nil "~a='~a'" (car var) (cdr var)))
+(defun environment-list (environment)
+  "Convert ENVIRONMENT alist to a POSIX environment list."
+  (mapcar (lambda (var) (format nil "~a=~a" (car var) (cdr var)))
           environment))
 
 (defun embed-environment (program args environment replace-environment-p)
   (if (or environment replace-environment-p)
       (values "env"
-              (append (when replace-environment-p (list "-i" "PATH=''"))
-                      (reformat-environment environment)
+              (append (when replace-environment-p (list "-i"))
+                      (environment-list environment)
                       (cons program args)))
       (values program args)))
 
 (defun make-shell-string (program args environment replace-environment-p)
-  (format nil "~:[~;env -i PATH=''~] ~{~a ~}~a~{ ~s~}"
+  ;; FIXME Perform shell escaping (assuming shell is BASH?)
+  (format nil "~:[~;env -i~] ~{~a ~}~a~{ ~s~}"
           replace-environment-p
-          (reformat-environment environment)
+          (environment-list environment)
           program
           (stringify-args args)))
diff --git a/tests/tests.lisp b/tests/tests.lisp
index 5755a48..fa876a2 100644
--- a/tests/tests.lisp
+++ b/tests/tests.lisp
@@ -8,15 +8,6 @@
 
 (in-suite tests)
 
-;;; FIXME: should probably signal a condition if program isn't found
-;;; ... but can't guarantee that 71 isn't returned by the program
-;;; itself ...
-(test should-have-access-to-shell-builtins
-  (multiple-value-bind (status code)
-      (external-program:run "cd" '())
-    (is (eq :exited status))
-    (is (= 0 code))))
-
 (test should-discover-programs-in-path
   (multiple-value-bind (status code)
       (external-program:run "which" '("ls"))
@@ -58,7 +49,33 @@
     (is (/= 0 code))))
 
 (test empty-env-should-erase-all
-  (multiple-value-bind (status code)
-      (external-program:run "ls" '(".") :replace-environment-p t)
+  (let* (status
+         code
+         (output
+           (with-output-to-string (out)
+             (multiple-value-setq (status code)
+               #-(or clisp ecl)
+               (external-program:run "/usr/bin/env" nil :output out :environment nil :replace-environment-p t)
+               #+(or clisp ecl)
+               (external-program:run "/usr/bin/env" nil :environment nil :replace-environment-p t)))))
     (is (eq :exited status))
-    (is (/= 0 code))))
+    (is (= 0 code))
+    #-(or clisp ecl)
+    (is-false (search "=" output))))
+
+#-(or clisp ecl)
+(test environment-vars-should-be-set
+  (let* ((environment '(("external program test var" . "test val")))
+         status
+         code
+         (output
+           (with-output-to-string (out)
+             (multiple-value-setq (status code)
+               #-(or clisp ecl)
+               (external-program:run "env" nil :output out :environment environment)
+               #+(or clisp ecl)
+               (external-program:run "env" nil :environment environment)))))
+    (is (eq :exited status))
+    (is (= 0 code))
+    #-(or clisp ecl)
+    (is-true (search "external program test var=test val" output))))