0.6.11.31:
[sbcl.git] / tests / stream.pure.lisp
1 ;;;; tests related to Lisp streams
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
8 ;;;; from CMU CL.
9 ;;;; 
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
13
14 (in-package :cl-user)
15
16 ;;; Until sbcl-0.6.11.31, we didn't have an N-BIN method for
17 ;;; CONCATENATED-STRING, so stuff like this would fail.
18 (let ((stream (make-concatenated-stream (make-string-input-stream "Demo")))
19       (buffer (make-string 4)))
20   (read-sequence buffer stream))
21 ;;; test for the new N-BIN method doing what it's supposed to
22 (let* ((substrings (list "This " "is " "a " ""
23                          "test of concatenated streams behaving "
24                          "as ordinary streams do under READ-SEQUENCE. "
25                          (make-string 140041 :initial-element #\%)
26                          "For any size of read.."
27                          (make-string 4123 :initial-element #\.)
28                          "they should give the same results."
29                          (make-string (expt 2 14) :initial-element #\*)
30                          "There should be no differences."))
31        (substreams (mapcar #'make-string-input-stream substrings))
32        (concatenated-stream (apply #'make-concatenated-stream substreams))
33        (concatenated-string (apply #'concatenate 'string substrings))
34        (stream (make-string-input-stream concatenated-string))
35        (max-n-to-read 24)
36        (buffer-1 (make-string max-n-to-read))
37        (buffer-2 (make-string max-n-to-read)))
38   (loop
39    (let* ((n-to-read (random max-n-to-read))
40           (n-actually-read-1 (read-sequence buffer-1
41                                             concatenated-stream
42                                             :end n-to-read))
43           (n-actually-read-2 (read-sequence buffer-2
44                                             stream
45                                             :end n-to-read)))
46 ;;     (format t "buffer-1=~S~%buffer-2=~S~%" buffer-1 buffer-2)
47      (assert (= n-actually-read-1 n-actually-read-2))
48      (assert (string= buffer-1 buffer-2
49                       :end1 n-actually-read-1
50                       :end2 n-actually-read-2))
51      (unless (= n-actually-read-1 n-to-read)
52        (assert (< n-actually-read-1 n-to-read))
53        (return)))))
54
55 ;;; success
56 (quit :unix-status 104)