rename SB-SIMPLE-STREAMS utility function

[sbcl.git] / contrib / sb-simple-streams / simple-stream-tests.lisp

diff --git a/contrib/sb-simple-streams/simple-stream-tests.lisp b/contrib/sb-simple-streams/simple-stream-tests.lisp
index 182b752..20c5a8e 100644 (file)
--- a/contrib/sb-simple-streams/simple-stream-tests.lisp
+++ b/contrib/sb-simple-streams/simple-stream-tests.lisp
@@ -60,6 +60,22 @@
               (progn ,@body))
          ,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
 
+(deftest non-existent-class
+  (handler-case
+      (with-test-file (s *test-file* :class 'non-existent-stream)
+        nil)
+    ;; find-class will raise a simple-error
+    (simple-error (c) (search "There is no class" (simple-condition-format-control c))))
+  0)
+
+(deftest non-stream-class
+  (handler-case
+      (with-test-file (s *test-file* :class 'standard-class)
+        nil)
+    ;; Will fall through sb-simple-streams:open as it is no stream class.
+    (simple-error (c) (search "Don't know how to handle" (simple-condition-format-control c))))
+  0)
+
 (deftest create-file-1
     ;; Create a file-simple-stream, write data.
     (prog1
@@ -118,13 +134,16 @@
 (deftest write-read-inet
   (handler-case
       (with-open-stream (s (make-instance 'socket-simple-stream
-                                         :remote-host #(127 0 0 1)
-                                         :remote-port 7
+                                          :remote-host #(127 0 0 1)
+                                          :remote-port 7
                                           :direction :io))
-       (string= (prog1 (write-line "Got it!" s) (finish-output s))
-                (read-line s)))
+        (string= (prog1 (write-line "Got it!" s) (finish-output s))
+                 (read-line s)))
     ;; Fail gracefully if echo isn't activated on the system
-    (sb-bsd-sockets::connection-refused-error () t))
+    (sb-bsd-sockets::connection-refused-error () t)
+    ;; Timeout may occur on the restricted systems (e.g. FreeBSD
+    ;; with jail(8) or blackhole(4) is used).
+    (sb-bsd-sockets::operation-timeout-error () t))
   t)
 
 (deftest write-read-large-sc-1
@@ -197,7 +216,10 @@
        (string= (prog1 (write-line content s) (finish-output s))
                 (read-line s))))
     ;; Fail gracefully if echo isn't activated on the system
-   (sb-bsd-sockets::connection-refused-error () t))
+   (sb-bsd-sockets::connection-refused-error () t)
+   ;; Timeout may occur on the restricted systems (e.g. FreeBSD
+   ;; with jail(8) or blackhole(4) is used).
+   (sb-bsd-sockets::operation-timeout-error () t))
   t)
 
 
@@ -373,8 +395,6 @@ Nothing to see here, move along.")
         :initial-content ,(or initial-content '*multi-line-string*))
      ,@body))
 
-;;; 0.8.3.93 tried to fix LISTEN on dual channel streams, but failed to do so:
-
 (deftest listen-dc-1
     ;; LISTEN with filled buffer
     (with-dc-test-stream (s) (read-char s) (listen s))
@@ -430,7 +450,7 @@ Nothing to see here, move along.")
   T)
 
 (deftest line-length-dc-1
-    ;; does LINE-LENGTH support simple streams?  
+    ;; does LINE-LENGTH support simple streams?
     (with-dc-test-stream (s)
       (eql (sb-simple-streams:line-length s)
            (sb-kernel:line-length s)))
@@ -502,8 +522,7 @@ Nothing to see here, move along.")
     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
     (with-sc-test-stream (*synonym*)
       (let ((s (make-synonym-stream '*synonym*)))
-        (clear-input s)
-        (listen s)))
+        (clear-input s)))
   NIL)
 
 (deftest synonym-stream-9
@@ -708,8 +727,7 @@ Nothing to see here, move along.")
     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
     (with-sc-test-stream (synonym)
       (let ((s (make-two-way-stream synonym synonym)))
-        (clear-input s)
-        (listen s)))
+        (clear-input s)))
   NIL)
 
 (deftest two-way-stream-9
@@ -794,8 +812,7 @@ Nothing to see here, move along.")
     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
     (with-sc-test-stream (*synonym*)
       (let ((s (make-echo-stream *synonym* *synonym*)))
-        (clear-input s)
-        (listen s)))
+        (clear-input s)))
   NIL)
 
 (deftest echo-stream-11
@@ -866,8 +883,7 @@ Nothing to see here, move along.")
     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
     (with-sc-test-stream (*synonym*)
       (let ((s (make-concatenated-stream *synonym*)))
-        (clear-input s)
-        (listen s)))
+        (clear-input s)))
   NIL)
 
 (deftest concatenated-stream-11
@@ -914,3 +930,40 @@ Nothing to see here, move along.")
 (deftest string-simple-stream-1
     (values (subtypep 'string-simple-stream 'string-stream))
   T)
+
+;; don't break fd-stream external-format support:
+
+(deftest external-format-1
+    (progn
+      (with-open-file (s *test-file*
+                       :direction :output
+                       :if-exists :supersede
+                       :element-type '(unsigned-byte 8))
+        (write-byte 195 s)
+        (write-byte 132 s))
+      (with-open-file (s *test-file*
+                       :direction :input
+                       :external-format :utf-8)
+        (char-code (read-char s))))
+  196)
+
+;; launchpad bug #491087
+
+(deftest lp491087
+    (labels ((read-big-int (stream)
+               (let ((b (make-array 1 :element-type '(signed-byte 32)
+                                    :initial-element 0)))
+                 (declare (dynamic-extent b))
+                 (sb-simple-streams::read-vector b stream
+                                                 :endian-swap :network-order)
+                 (aref b 0))))
+      (with-open-file (stream
+                       (merge-pathnames #P"lp491087.txt" *test-path*)
+                       :class 'file-simple-stream)
+        (let* ((start (file-position stream))
+               (integer (read-big-int stream))
+               (end (file-position stream)))
+          (and (= start 0)
+               (= integer #x30313233)
+               (= end 4)))))
+  T)