(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
(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
(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)
: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))
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)))
;; 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
;; 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
;; 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
;; 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
(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)