X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Frun-program.lisp;h=0119d6ca79db464e0dbf01bd850a20674f5bf482;hb=bfe145acc01eb7a43790173db4f08610ae9cb07a;hp=946f95e98cebaa5304b081b4e2ae5d39ee496ecc;hpb=670010e3f3dcd62efaf23f61abdc73950edb88c6;p=sbcl.git diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index 946f95e..0119d6c 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -63,7 +63,7 @@ (defun unix-environment-cmucl-from-sbcl (sbcl) (mapcan (lambda (string) - (declare (type simple-string string)) + (declare (type simple-base-string string)) (let ((=-pos (position #\= string :test #'equal))) (if =-pos (list @@ -86,8 +86,8 @@ (mapcar (lambda (cons) (destructuring-bind (key . val) cons - (declare (type keyword key) (type simple-string val)) - (concatenate 'simple-string (symbol-name key) "=" val))) + (declare (type keyword key) (type simple-base-string val)) + (concatenate 'simple-base-string (symbol-name key) "=" val))) cmucl)) ;;;; Import wait3(2) from Unix. @@ -124,10 +124,10 @@ (values pid (if (position signal #.(vector - (sb-unix:unix-signal-number :sigstop) - (sb-unix:unix-signal-number :sigtstp) - (sb-unix:unix-signal-number :sigttin) - (sb-unix:unix-signal-number :sigttou))) + sb-unix:sigstop + sb-unix:sigtstp + sb-unix:sigttin + sb-unix:sigttou)) :stopped :signaled) signal @@ -212,7 +212,7 @@ (sb-unix:unix-ioctl (sb-sys:fd-stream-fd (process-pty proc)) sb-unix:TIOCSIGSEND (sb-sys:int-sap - (sb-unix:unix-signal-number signal)))) + signal))) ((:process-group #-hpux :pty-process-group) (sb-unix:unix-killpg pid signal)) (t @@ -220,8 +220,7 @@ (cond ((not okay) (values nil errno)) ((and (eql pid (process-pid proc)) - (= (sb-unix:unix-signal-number signal) - (sb-unix:unix-signal-number :sigcont))) + (= signal sb-unix:sigcont)) (setf (process-%status proc) :running) (setf (process-exit-code proc) nil) (when (process-status-hook proc) @@ -381,12 +380,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 + ;; the truename of a file naming a directory is the + ;; directory, at least until pfdietz comes along and says why + ;; that's noncompliant -- CSR, c. 2003-08-10 + for truename = (probe-file (subseq search-path start end)) + for fullpath = (when truename (merge-pathnames pathname truename)) + when (and fullpath + (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 +452,7 @@ (posix-environ)) environment-p) (wait t) + search pty input if-input-does-not-exist @@ -467,12 +482,16 @@ The &KEY arguments have the following meanings: :ENVIRONMENT - a list of SIMPLE-STRINGs describing the new Unix environment (as - in \"man environ\"). The default is to copy the environment of + a list of SIMPLE-BASE-STRINGs describing the new Unix environment + (as in \"man environ\"). The default is to copy the environment of the current process. :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. @@ -517,7 +536,7 @@ (when (and env-p environment-p) (error "can't specify :ENV and :ENVIRONMENT simultaneously")) ;; Make sure that the interrupt handler is installed. - (sb-sys:enable-interrupt :sigchld #'sigchld-handler) + (sb-sys:enable-interrupt sb-unix:sigchld #'sigchld-handler) ;; Prepend the program to the argument list. (push (namestring program) args) (let (;; Clear various specials used by GET-DESCRIPTOR-FOR to @@ -531,17 +550,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))