X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Frun-program.lisp;h=95ebb73f37673b764525be7abe0211cfd966ddec;hb=2d4a0df3457bcd50916b33d374da592d8776db0a;hp=9153a8f2cbe1193cfa17803991884a84edc7b4bd;hpb=d68f3f83e6c5b9bed9789279cbae346f240488cc;p=sbcl.git

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index 9153a8f..95ebb73 100644
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -362,8 +362,7 @@
       (values vec-sap (sap+ vec-sap #-alpha 4 #+alpha 8) total-bytes))))
 
 (defmacro with-c-strvec ((var str-list) &body body)
-  (let ((sap (gensym "SAP-"))
-	(size (gensym "SIZE-")))
+  (with-unique-names (sap size)
     `(multiple-value-bind
       (,sap ,var ,size)
       (string-list-to-c-strvec ,str-list)
@@ -382,12 +381,27 @@
   (stderr sb-alien:int))
 
 ;;; Is UNIX-FILENAME the name of a file that we can execute?
-;;; XXX does this actually work for symlinks?
 (defun unix-filename-is-executable-p (unix-filename)
   (declare (type simple-string unix-filename))
   (values (and (eq (sb-unix:unix-file-kind unix-filename) :file)
 	       (sb-unix:unix-access unix-filename sb-unix:x_ok))))
 
+(defun find-executable-in-search-path (pathname
+				       &optional
+				       (search-path (posix-getenv "PATH")))
+  "Find the first executable file matching PATHNAME in any of the colon-separated list of pathnames SEARCH-PATH"
+  (loop for end =  (position #\: search-path :start (if end (1+ end) 0))
+	and start = 0 then (and end (1+ end))
+	while start
+	;; <Krystof> the truename of a file naming a directory is the
+	;; directory, at least until pfdietz comes along and says why
+	;; that's noncompliant
+	for fullpath = (merge-pathnames
+			pathname (truename
+				  (subseq search-path start end)))
+	when (unix-filename-is-executable-p (namestring fullpath))
+	return fullpath))
+
 ;;; FIXME: There shouldn't be two semiredundant versions of the
 ;;; documentation. Since this is a public extension function, the
 ;;; documentation should be in the doc string. So all information from
@@ -439,6 +453,7 @@
 				     (posix-environ))
 				 environment-p)
 		    (wait t)
+		    search
 		    pty
 		    input
 		    if-input-does-not-exist
@@ -474,6 +489,10 @@
      :ENV
         an alternative lossy representation of the new Unix environment,
         for compatibility with CMU CL
+     :SEARCH
+        Look for PROGRAM in each of the directories along the $PATH
+        environment variable.  Otherwise an absolute pathname is required.
+        (See also FIND-EXECUTABLE-IN-SEARCH-PATH)
      :WAIT
         If non-NIL (default), wait until the created process finishes.  If
         NIL, continue running Lisp until the program finishes.
@@ -532,17 +551,11 @@
 	;; designator, but internally we'd like SIMPLE-STRINGs.
 	(simple-args (mapcar (lambda (x) (coerce x 'simple-string)) args)))
     (unwind-protect
-	 (let (;; FIXME: The old code here used to do
-	       ;;   (MERGE-PATHNAMES PROGRAM "path:"),
-	       ;; which is the right idea (searching through the Unix
-	       ;; PATH). Unfortunately, there is no logical pathname
-	       ;; "path:" defined in sbcl-0.6.10. It would probably be 
-	       ;; reasonable to restore Unix PATH searching in SBCL, e.g.
-	       ;; with a function FIND-EXECUTABLE-FILE-IN-POSIX-PATH.
-	       ;; CMU CL did it with a "PATH:" search list, but CMU CL
-	       ;; search lists are a non-ANSI extension that SBCL
-	       ;; doesn't support. -- WHN)
-	       (pfile (unix-namestring program t))
+	 (let ((pfile
+		(if search 
+		    (let ((p (find-executable-in-search-path program)))
+		      (and p (unix-namestring p t)))
+		    (unix-namestring program t)))
 	       (cookie (list 0)))
 	   (unless pfile
 	     (error "no such program: ~S" program))