Fix make-array transforms.

[sbcl.git] / tests / stream.impure-cload.lisp

diff --git a/tests/stream.impure-cload.lisp b/tests/stream.impure-cload.lisp
index 0075908..acfc228 100644 (file)
--- a/tests/stream.impure-cload.lisp
+++ b/tests/stream.impure-cload.lisp
@@ -6,7 +6,7 @@
 ;;;; While most of SBCL is derived from the CMU CL system, the test
 ;;;; files (like this one) were written from scratch after the fork
 ;;;; from CMU CL.
-;;;; 
+;;;;
 ;;;; This software is in the public domain and is provided with
 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
 ;;;; more information.
@@ -28,35 +28,48 @@
 (defparameter *scratch-file-name* "sbcl-wrapped-stream-test-data.tmp")
 (defvar *scratch-file-stream*)
 (dolist (scratch-file-length '(1 ; everyone's favorite corner case
-                              200123)) ; hopefully much bigger than buffer
-  (format t "/SCRATCH-FILE-LENGTH=~D~%" scratch-file-length)
+                               200123)) ; hopefully much bigger than buffer
+  (format t "/SCRATCH-FILE-LENGTH=~W~%" scratch-file-length)
   (with-open-file (s *scratch-file-name* :direction :output)
     (dotimes (i scratch-file-length)
       (write-char #\x s)))
   (dolist (wrap-named-stream-fn
-          ;; All kinds of wrapped input streams have the same issue.
-          (list (lambda (wrapped-stream-name)
-                  (make-synonym-stream wrapped-stream-name))
-                (lambda (wrapped-stream-name)
-                  (make-two-way-stream (symbol-value wrapped-stream-name)
-                                       *standard-output*))
-                (lambda (wrapped-stream-name)
-                  (make-concatenated-stream (symbol-value wrapped-stream-name)
-                                            (make-string-input-stream "")))))
+           ;; All kinds of wrapped input streams have the same issue.
+           (list (lambda (wrapped-stream-name)
+                   (make-synonym-stream wrapped-stream-name))
+                 (lambda (wrapped-stream-name)
+                   (make-two-way-stream (symbol-value wrapped-stream-name)
+                                        *standard-output*))
+                 (lambda (wrapped-stream-name)
+                   (make-concatenated-stream (symbol-value wrapped-stream-name)
+                                             (make-string-input-stream "")))))
     (format t "/WRAP-NAMED-STREAM-FN=~S~%" wrap-named-stream-fn)
     (with-open-file (*scratch-file-stream* *scratch-file-name*
-                                          :direction :input)
+                                           :direction :input)
       (let ((ss (funcall wrap-named-stream-fn '*scratch-file-stream*)))
-       (flet ((expect (thing-expected)
-                (let ((thing-found (read-char ss nil nil)))
-                  (unless (eql thing-found thing-expected)
-                    (error "expected ~S, found ~S"
-                           thing-expected thing-found)))))
-         (dotimes (i scratch-file-length)
-           (expect #\x)
-           (unread-char #\y ss)
-           (expect #\y)
-           (unread-char #\z ss)
-           (expect #\z))
-         (expect nil))))) ; i.e. end of file
+        (flet ((expect (thing-expected)
+                 (let ((thing-found (read-char ss nil nil)))
+                   (unless (eql thing-found thing-expected)
+                     (error "expected ~S, found ~S"
+                            thing-expected thing-found)))))
+          (dotimes (i scratch-file-length)
+            (expect #\x)
+            (unread-char #\y ss)
+            (expect #\y)
+            (unread-char #\z ss)
+            (expect #\z))
+          (expect nil))))) ; i.e. end of file
   (delete-file *scratch-file-name*))
+
+(with-open-file (s *scratch-file-name* :direction :output)
+  (format s "1234~%"))
+(assert
+ (string=
+  (with-open-file (s *scratch-file-name* :direction :input)
+    (let* ((b (make-string 10)))
+      (peek-char nil s)
+      (read-sequence b s)
+      b))
+  (format nil "1234")
+  :end1 4))
+(delete-file *scratch-file-name*)