0.9.16.14:

        Add support for Unix98-style ptys. (thanks to Sidney Markowitz)

diff --git a/NEWS b/NEWS
index 1fed6a0..1d13184 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -16,6 +16,8 @@ changes in sbcl-0.9.17 (0.9.99?) relative to sbcl-0.9.16:
     Slobodov)
   * bug fix: better detection of circularities in the file-compiler.
     (reported by Marco Monteiro)
+  * bug fix: The :PTY argument for RUN-PROGRAM will now work on 
+    systems with Unix98 pty semantics.
 
 changes in sbcl-0.9.16 relative to sbcl-0.9.15:
   * feature: implemented the READER-METHOD-CLASS and

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index cb6c489..805a92a 100644 (file)
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -392,25 +392,52 @@ status slot."
 ;;; the master side of the pty, the file descriptor for the slave side
 ;;; of the pty, and the name of the tty device for the slave side.
 #-win32
-(defun find-a-pty ()
-  (dolist (char '(#\p #\q))
-    (dotimes (digit 16)
-      (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 (coerce (format nil "/dev/tty~C~X" char digit) 'base-string))
-                 (slave-fd (sb-unix:unix-open slave-name
-                                              sb-unix:o_rdwr
-                                              #o666)))
-            (when slave-fd
-              (return-from find-a-pty
-                (values master-fd
-                        slave-fd
-                        slave-name)))
-            (sb-unix:unix-close master-fd))))))
-  (error "could not find a pty"))
+(progn
+  (define-alien-routine ptsname c-string (fd int))
+  (define-alien-routine grantpt boolean (fd int))
+  (define-alien-routine unlockpt boolean (fd int))
+
+  (defun find-a-pty ()
+    ;; First try to use the Unix98 pty api.
+    (let* ((master-name (coerce (format nil "/dev/ptmx") 'base-string))
+           (master-fd (sb-unix:unix-open master-name
+                                         sb-unix:o_rdwr
+                                         #o666)))
+      (when master-fd
+        (grantpt master-fd)
+        (unlockpt master-fd)
+        (let* ((slave-name (ptsname master-fd))
+               (slave-fd (sb-unix:unix-open slave-name
+                                            sb-unix:o_rdwr
+                                            #o666)))
+          (when slave-fd
+            (return-from find-a-pty
+              (values master-fd
+                      slave-fd
+                      slave-name)))
+          (sb-unix:unix-close master-fd))
+        (error "could not find a pty")))
+    ;; No dice, try using the old-school method.
+    (dolist (char '(#\p #\q))
+      (dotimes (digit 16)
+        (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 (coerce (format nil "/dev/tty~C~X" char digit)
+                                       'base-string))
+                   (slave-fd (sb-unix:unix-open slave-name
+                                                sb-unix:o_rdwr
+                                                #o666)))
+              (when slave-fd
+                (return-from find-a-pty
+                  (values master-fd
+                          slave-fd
+                          slave-name)))
+              (sb-unix:unix-close master-fd))))))
+    (error "could not find a pty")))
 
 #-win32
 (defun open-pty (pty cookie)

diff --git a/version.lisp-expr b/version.lisp-expr
index 059e465..a7377a2 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.9.16.13"
+"0.9.16.14"