0.8.0.33

	Extend RUN-PROGRAM with a :SEARCH option that makes it look
	along $PATH for the executable

	Export SB-EXT:FIND-EXECUTABLE-IN-SEARCH-PATH, which does the
	actual lookup in the preceding function

	Add a couple of test cases

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index c4386f4..e6ef8c6 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -628,6 +628,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
              ;; return a PROCESS object with operations defined on
              ;; that object.
              "RUN-PROGRAM"
+            "FIND-EXECUTABLE-IN-SEARCH-PATH"
              "PROCESS-ALIVE-P" "PROCESS-CLOSE"
              "PROCESS-CORE-DUMPED" "PROCESS-ERROR" "PROCESS-EXIT-CODE"
              "PROCESS-INPUT" "PROCESS-KILL" "PROCESS-OUTPUT" "PROCESS-P"

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index 946f95e..95ebb73 100644 (file)
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -381,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
@@ -438,6 +453,7 @@
                                     (posix-environ))
                                 environment-p)
                    (wait t)
+                   search
                    pty
                    input
                    if-input-does-not-exist
@@ -473,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.
@@ -531,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))

diff --git a/tests/run-program.test.sh b/tests/run-program.test.sh
index 788c0f5..ad11cac 100644 (file)
--- a/tests/run-program.test.sh
+++ b/tests/run-program.test.sh
@@ -18,7 +18,13 @@
 SOMETHING_IN_THE_ENVIRONMENT='yes there is'
 export SOMETHING_IN_THE_ENVIRONMENT
 
+
 ${SBCL:-sbcl} <<EOF
+  ;; test that $PATH is searched
+  (assert (zerop (sb-ext:process-exit-code 
+                 (sb-ext:run-program "true" () :search t :wait t))))
+  (assert (not (zerop (sb-ext:process-exit-code 
+                      (sb-ext:run-program "false" () :search t :wait t)))))
   (let ((string (with-output-to-string (stream)
                   (sb-ext:run-program "/bin/echo"
                                       '("foo" "bar")

diff --git a/version.lisp-expr b/version.lisp-expr
index 1a2d499..0ef889b 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.0.32"
+"0.8.0.33"