0.9.17.13: SB-POSIX:CFSET*SPEED, SB-POSIX:CFGET*SPEED, and related constants

  * Patch by Max-Gerd Retzlaff. cfsetspeed left out as non-portable,
    cfgetispeed and cfgetospeed added.
  * Tests -- which have not been properly run, and aren't run as part
    of the SB-POSIX suite, since they require serial port access.

diff --git a/NEWS b/NEWS
index a30ad70..a984c1b 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,8 @@
 ;;;; -*- coding: utf-8; -*-
-changes in sbcl-0.9.18 (1.0.beta?) relative to sbcl-0.9.16:
+changes in sbcl-0.9.18 (1.0.beta?) relative to sbcl-0.9.17:
+  * enhancement: SB-POSIX now supports cfsetispeed(3), cfsetospeed(3),
+    cfgetispeed(3), cfgetospeed(3), and related constants. (thanks to
+    Max-Gerd Retzlaff)
   * bug fix: two potential GC deadlocks affecting threaded builds.
   * bug fix: (TYPEP #\A '(NOT (MEMBER #\" #\{ #\:))) now correctly
     returns T (reported by Anton Kazennikov)

diff --git a/contrib/sb-posix/constants.lisp b/contrib/sb-posix/constants.lisp
index fc99cb8..a040eba 100644 (file)
--- a/contrib/sb-posix/constants.lisp
+++ b/contrib/sb-posix/constants.lisp
@@ -420,6 +420,9 @@
  (:integer b9600 "B9600" nil t)
  (:integer b19200 "B19200" nil t)
  (:integer b38400 "B38400" nil t)
+ (:integer b57600 "B57600" nil t)
+ (:integer b115200 "B115200" nil t)
+ (:integer b230400 "B230400" nil t)
 
  (:integer csize "CSIZE" nil t)
  (:integer cs5 "CS5" nil t)

diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp
index 8b8d2b4..6460052 100644 (file)
--- a/contrib/sb-posix/interface.lisp
+++ b/contrib/sb-posix/interface.lisp
@@ -10,6 +10,7 @@
                collect (ldiff slotd (member :array-length slotd)))
         ,@options)
       (declaim (inline ,to-alien ,to-protocol))
+      (declaim (inline ,to-protocol ,to-alien))
       (defun ,to-protocol (alien &optional instance)
         (declare (type (sb-alien:alien (* ,alien-type)) alien)
                  (type (or null ,name) instance))
@@ -366,6 +367,7 @@
  (export 'tcsetattr :sb-posix)
  (declaim (inline tcsetattr))
  (defun tcsetattr (fd actions termios)
+   (declare (type termios termios))
    (with-alien-termios a-termios ()
      (termios-to-alien termios a-termios)
      (let ((fd (file-descriptor fd)))
@@ -380,6 +382,7 @@
  (export 'tcgetattr :sb-posix)
  (declaim (inline tcgetattr))
  (defun tcgetattr (fd &optional termios)
+   (declare (type (or null termios) termios))
    (with-alien-termios a-termios ()
      (let ((r (alien-funcall
                (extern-alien "tcgetattr"
@@ -389,7 +392,53 @@
        (when (minusp r)
          (syscall-error))
        (setf termios (alien-to-termios a-termios termios))))
-   termios))
+   termios)
+ (export 'cfsetispeed :sb-posix)
+ (declaim (inline cfsetispeed))
+ (defun cfsetispeed (speed &optional termios)
+   (declare (type (or null termios) termios))
+   (with-alien-termios a-termios ()
+     (let ((r (alien-funcall
+               (extern-alien "cfsetispeed"
+                             (function int (* alien-termios) speed-t))
+               a-termios
+               speed)))
+       (when (minusp r)
+         (syscall-error))
+       (setf termios (alien-to-termios a-termios termios))))
+   termios)
+ (export 'cfsetospeed :sb-posix)
+ (declaim (inline cfsetospeed))
+ (defun cfsetospeed (speed &optional termios)
+   (declare (type (or null termios) termios))
+   (with-alien-termios a-termios ()
+     (let ((r (alien-funcall
+               (extern-alien "cfsetospeed"
+                             (function int (* alien-termios) speed-t))
+               a-termios
+               speed)))
+       (when (minusp r)
+         (syscall-error))
+       (setf termios (alien-to-termios a-termios termios))))
+   termios)
+ (export 'cfgetispeed :sb-posix)
+ (declaim (inline cfgetispeed))
+ (defun cfgetispeed (termios)
+   (declare (type termios termios))
+   (with-alien-termios a-termios ()
+     (termios-to-alien termios a-termios)
+     (alien-funcall (extern-alien "cfgetispeed"
+                                  (function speed-t (* alien-termios)))
+                    a-termios)))
+ (export 'cfgetospeed :sb-posix)
+ (declaim (inline cfgetospeed))
+ (defun cfgetospeed (termios)
+   (declare (type termios termios))
+   (with-alien-termios a-termios ()
+     (termios-to-alien termios a-termios)
+     (alien-funcall (extern-alien "cfgetospeed"
+                                 (function speed-t (* alien-termios)))
+                    a-termios))))
 
 ;;; environment
 

diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp
index 4eead06..4e6e6c9 100644 (file)
--- a/contrib/sb-posix/posix-tests.lisp
+++ b/contrib/sb-posix/posix-tests.lisp
@@ -431,3 +431,33 @@
   ;; make sure that we found something
   (not (sb-posix:getpwnam "root"))
   nil)
+
+#+nil
+;; Requires root or special group + plus a sensible thing on the port
+(deftest cfget/setispeed.1
+    (with-open-file (s "/dev/ttyS0")
+      (let* ((termios (sb-posix:tcgetattr s))
+             (old (sb-posix:cfgetispeed termios))
+             (new (if (= old sb-posix:b2400)
+                      sb-posix:b9600
+                      sb-posix:b2400)))
+        (sb-posix:cfsetispeed new termios)
+        (sb-posix:tcsetattr 0 sb-posix:tcsadrain termios)
+        (setf termios (sb-posix:tcgetattr s))
+        (= new (sb-posix:cfgetispeed termios))))
+  t)
+
+#+nil
+;; Requires root or special group + a sensible thing on the port
+(deftest cfget/setospeed.1
+    (with-open-file (s "/dev/ttyS0" :direction :output :if-exists :append)
+      (let* ((termios (sb-posix:tcgetattr s))
+             (old (sb-posix:cfgetospeed termios))
+             (new (if (= old sb-posix:b2400)
+                      sb-posix:b9600
+                      sb-posix:b2400)))
+        (sb-posix:cfsetospeed new termios)
+        (sb-posix:tcsetattr 0 sb-posix:tcsadrain termios)
+        (setf termios (sb-posix:tcgetattr 0))
+        (= new (sb-posix:cfgetospeed termios))))
+  t)

diff --git a/version.lisp-expr b/version.lisp-expr
index a5f9eb5..19b8859 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.17.12"
+"0.9.17.13"