From 0395c15ff8394bfaaed03050c1a7a131f197a732 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Tue, 22 May 2012 22:06:06 +0400 Subject: [PATCH] run-program: Don't decode and re-encode environ. Leave environ unchanged when no :environment argument is provided. Closes lp#985904. --- NEWS | 4 ++- src/code/run-program.lisp | 71 +++++++++++++++++++++++++-------------------- src/runtime/run-program.c | 4 ++- 3 files changed, 45 insertions(+), 34 deletions(-) diff --git a/NEWS b/NEWS index 283e979..c4c6ce0 100644 --- 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 --- 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 --- 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); -- 1.7.10.4