run-program: Don't decode and re-encode environ.

Leave environ unchanged when no :environment argument is provided.
Closes lp#985904.

diff --git a/NEWS b/NEWS
index 283e979..c4c6ce0 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,9 +1,11 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
 changes relative to sbcl-1.0.57:
-  * enchancement: implicit generic function warnings now specify the package
+  * enhancement: implicit generic function warnings now specify the package
     in which the new generic function is being created.
   * enhancement: SB-EXT:ATOMIC-UPDATE makes it easy to perform non-destructive
     updates of CAS-able places (similar to Clojure's swap!).
+  * enhancement: run-program no longer decodes and re-encodes environment when
+    :environment argument is not provided. (lp#985904)
   * bug fix: potential for infinite recursion during compilation of CLOS slot
     typechecks when dependency graph had loops. (lp#1001799)
   * bug fix: error forms reported with some program-errors were not escaped

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index 05c6333..d9e00f2 100644 (file)
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -507,14 +507,18 @@ status slot."
     (setf (sap-ref-sap vec-sap vec-index-offset) (int-sap 0))
     (values vec-sap (sap+ vec-sap bytes-per-word) total-bytes)))
 
-(defmacro with-c-strvec ((var str-list) &body body)
-  (with-unique-names (sap size)
-    `(multiple-value-bind (,sap ,var ,size)
-         (string-list-to-c-strvec ,str-list)
-       (unwind-protect
-            (progn
-              ,@body)
-         (sb-sys:deallocate-system-memory ,sap ,size)))))
+(defmacro with-c-strvec ((var str-list &key null) &body body)
+  (once-only ((null null))
+    (with-unique-names (sap size)
+      `(multiple-value-bind (,sap ,var ,size)
+           (if ,null
+               (values nil (sb-sys:int-sap 0))
+               (string-list-to-c-strvec ,str-list))
+         (unwind-protect
+              (progn
+                ,@body)
+           (unless ,null
+             (sb-sys:deallocate-system-memory ,sap ,size)))))))
 
 (sb-alien:define-alien-routine spawn
     #-win32 sb-alien:int
@@ -576,9 +580,8 @@ status slot."
                     &key
                     #-win32 (env nil env-p)
                     #-win32 (environment
-                             (if env-p
-                                 (unix-environment-sbcl-from-cmucl env)
-                                 (posix-environ))
+                             (when env-p
+                               (unix-environment-sbcl-from-cmucl env))
                              environment-p)
                     (wait t)
                     search
@@ -742,9 +745,13 @@ Users Manual for details about the PROCESS structure."#-win32"
                       (with-args-vec ((vec args) &body body)
                         `(with-c-strvec (,vec ,args)
                            ,@body))
-                      (with-environment-vec ((vec env) &body body)
+                      (with-environment-vec ((vec) &body body)
                         #+win32 `(let (,vec) ,@body)
-                        #-win32 `(with-c-strvec (,vec ,env) ,@body)))
+                        #-win32
+                        `(with-c-strvec
+                             (,vec environment
+                              :null (not (or environment environment-p)))
+                           ,@body)))
              (with-fd-and-stream-for ((stdin input-stream) :input
                                       input cookie
                                       :direction :input
@@ -768,30 +775,30 @@ Users Manual for details about the PROCESS structure."#-win32"
                      (let (child)
                        (with-active-processes-lock ()
                          (with-args-vec (args-vec simple-args)
-                           (with-environment-vec (environment-vec environment)
+                           (with-environment-vec (environment-vec)
                              (setq child (without-gcing
                                            (spawn progname args-vec
                                                   stdin stdout stderr
                                                   (if search 1 0)
                                                   environment-vec pty-name
-                                                  (if wait 1 0))))
-                             (unless (minusp child)
-                               (setf proc
-                                     (apply
-                                      #'make-process
-                                      :pid child
-                                      :input input-stream
-                                      :output output-stream
-                                      :error error-stream
-                                      :status-hook status-hook
-                                      :cookie cookie
-                                      #-win32 (list :pty pty-stream
-                                                    :%status :running)
-                                      #+win32 (if wait
-                                                  (list :%status :exited
-                                                        :exit-code child)
-                                                  (list :%status :running))))
-                               (push proc *active-processes*)))))
+                                                  (if wait 1 0))))))
+                         (unless (minusp child)
+                           (setf proc
+                                 (apply
+                                  #'make-process
+                                  :pid child
+                                  :input input-stream
+                                  :output output-stream
+                                  :error error-stream
+                                  :status-hook status-hook
+                                  :cookie cookie
+                                  #-win32 (list :pty pty-stream
+                                                :%status :running)
+                                  #+win32 (if wait
+                                              (list :%status :exited
+                                                    :exit-code child)
+                                              (list :%status :running))))
+                           (push proc *active-processes*)))
                        ;; Report the error outside the lock.
                        #+win32
                        (when (minusp child)

diff --git a/src/runtime/run-program.c b/src/runtime/run-program.c
index c911074..367dd77 100644 (file)
--- a/src/runtime/run-program.c
+++ b/src/runtime/run-program.c
@@ -193,7 +193,9 @@ int spawn(char *program, char *argv[], int sin, int sout, int serr,
         if (fd != channel[1]) close(fd);
 #endif
 
-    environ = envp;
+    if (envp) {
+      environ = envp;
+    }
     /* Exec the program. */
     if (search)
       execvp(program, argv);