0.8.17.30:

[sbcl.git] / src / code / run-program.lisp

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index 5ad4e12..f2dfe10 100644 (file)
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -289,12 +289,12 @@
 (defun find-a-pty ()
   (dolist (char '(#\p #\q))
     (dotimes (digit 16)
-      (let* ((master-name (format nil "/dev/pty~C~X" char digit))
+      (let* ((master-name (coerce (format nil "/dev/pty~C~X" char digit) 'base-string))
             (master-fd (sb-unix:unix-open master-name
                                           sb-unix:o_rdwr
                                           #o666)))
        (when master-fd
-         (let* ((slave-name (format nil "/dev/tty~C~X" char digit))
+         (let* ((slave-name (coerce (format nil "/dev/tty~C~X" char digit) 'base-string))
                 (slave-fd (sb-unix:unix-open slave-name
                                              sb-unix:o_rdwr
                                              #o666)))
@@ -347,7 +347,9 @@
        (declare (simple-string s))
        (let ((n (length s)))
          ;; Blast the string into place.
-         (sb-kernel:copy-to-system-area (the simple-string s)
+         (sb-kernel:copy-to-system-area (the simple-base-string
+                                           ;; FIXME
+                                           (coerce s 'simple-base-string))
                                         (* sb-vm:vector-data-offset
                                            sb-vm:n-word-bits)
                                         string-sap 0
@@ -382,6 +384,7 @@
 ;;; Is UNIX-FILENAME the name of a file that we can execute?
 (defun unix-filename-is-executable-p (unix-filename)
   (declare (type simple-string unix-filename))
+  (setf unix-filename (coerce unix-filename 'base-string))
   (values (and (eq (sb-unix:unix-file-kind unix-filename) :file)
               (sb-unix:unix-access unix-filename sb-unix:x_ok))))
 
@@ -394,11 +397,11 @@
        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))
+       ;; 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
@@ -614,7 +617,7 @@
 ;;; stream.
 (defun copy-descriptor-to-stream (descriptor stream cookie)
   (incf (car cookie))
-  (let ((string (make-string 256))
+  (let ((string (make-string 256 :element-type 'base-char))
        handler)
     (setf handler
          (sb-sys:add-fd-handler
@@ -683,7 +686,7 @@
         ;; Use /dev/null.
         (multiple-value-bind
               (fd errno)
-            (sb-unix:unix-open "/dev/null"
+            (sb-unix:unix-open #.(coerce "/dev/null" 'base-string)
                                (case direction
                                  (:input sb-unix:o_rdonly)
                                  (:output sb-unix:o_wronly)
@@ -735,7 +738,7 @@
            (dotimes (count
                       256
                      (error "could not open a temporary file in /tmp"))
-             (let* ((name (format nil "/tmp/.run-program-~D" count))
+             (let* ((name (coerce (format nil "/tmp/.run-program-~D" count) 'base-string))
                     (fd (sb-unix:unix-open name
                                            (logior sb-unix:o_rdwr
                                                    sb-unix:o_creat
@@ -750,7 +753,16 @@
                            (read-line object nil nil)
                          (unless line
                            (return))
-                         (sb-unix:unix-write fd line 0 (length line))
+                         (sb-unix:unix-write
+                           fd
+                           ;; FIXME: this really should be
+                           ;; (STRING-TO-OCTETS :EXTERNAL-FORMAT ...).
+                           ;; RUN-PROGRAM should take an
+                           ;; external-format argument, which should
+                           ;; be passed down to here.  Something
+                           ;; similar should happen on :OUTPUT, too.
+                           (map '(vector (unsigned-byte 8)) #'char-code line)
+                           0 (length line))
                          (if no-cr
                              (return)
                              (sb-unix:unix-write fd newline 0 1)))))