1.0.23.21: Stack allocated conses for MIPS.
[sbcl.git] / tests / stream.impure-cload.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 ;;; The unread and clear-input functions on input streams need to
17 ;;; sneak past the old CMU CL encapsulation. As explained by DTC in
18 ;;; the checkin message for his CMU CL patch ca. April 2001,
19 ;;;   These streams encapsulate other input streams which may
20 ;;;   have an input buffer so they need to call unread-char
21 ;;;   and clear-input on the encapsulated stream rather than
22 ;;;   directly calling the encapsulated streams misc method
23 ;;;   as the misc methods are below the layer of the input buffer.
24 ;;;
25 ;;; The code below tests only UNREAD-CHAR. It would be nice to test
26 ;;; CLEAR-INPUT too, but I'm not sure how to do it cleanly and
27 ;;; portably in a noninteractive test. -- WHN 2001-05-05
28 (defparameter *scratch-file-name* "sbcl-wrapped-stream-test-data.tmp")
29 (defvar *scratch-file-stream*)
30 (dolist (scratch-file-length '(1 ; everyone's favorite corner case
31                                200123)) ; hopefully much bigger than buffer
32   (format t "/SCRATCH-FILE-LENGTH=~W~%" scratch-file-length)
33   (with-open-file (s *scratch-file-name* :direction :output)
34     (dotimes (i scratch-file-length)
35       (write-char #\x s)))
36   (dolist (wrap-named-stream-fn
37            ;; All kinds of wrapped input streams have the same issue.
38            (list (lambda (wrapped-stream-name)
39                    (make-synonym-stream wrapped-stream-name))
40                  (lambda (wrapped-stream-name)
41                    (make-two-way-stream (symbol-value wrapped-stream-name)
42                                         *standard-output*))
43                  (lambda (wrapped-stream-name)
44                    (make-concatenated-stream (symbol-value wrapped-stream-name)
45                                              (make-string-input-stream "")))))
46     (format t "/WRAP-NAMED-STREAM-FN=~S~%" wrap-named-stream-fn)
47     (with-open-file (*scratch-file-stream* *scratch-file-name*
48                                            :direction :input)
49       (let ((ss (funcall wrap-named-stream-fn '*scratch-file-stream*)))
50         (flet ((expect (thing-expected)
51                  (let ((thing-found (read-char ss nil nil)))
52                    (unless (eql thing-found thing-expected)
53                      (error "expected ~S, found ~S"
54                             thing-expected thing-found)))))
55           (dotimes (i scratch-file-length)
56             (expect #\x)
57             (unread-char #\y ss)
58             (expect #\y)
59             (unread-char #\z ss)
60             (expect #\z))
61           (expect nil))))) ; i.e. end of file
62   (delete-file *scratch-file-name*))
63
64 (with-open-file (s *scratch-file-name* :direction :output)
65   (format s "1234~%"))
66 (assert
67  (string=
68   (with-open-file (s *scratch-file-name* :direction :input)
69     (let* ((b (make-string 10)))
70       (peek-char nil s)
71       (read-sequence b s)
72       b))
73   (format nil "1234")
74   :end1 4))
75 (delete-file *scratch-file-name*)