70 lines
2.0 KiB
Plaintext
70 lines
2.0 KiB
Plaintext
;; Function To Be Tested: read
|
|
;;
|
|
;; Source: CLtL p. 375
|
|
;;
|
|
;; Chapter 22: Input/Output Section 2.1: Input from Character Streams
|
|
;;
|
|
;; Created By: Peter Reidy
|
|
;;
|
|
;; Creation Date: 7 November 86
|
|
;;
|
|
;; Last Update: 2-3-87 Jim Blum - Changed (read test t nil t) to (read test)
|
|
;; to run on the SUN
|
|
;;
|
|
;; Filed As: {eris}<lispcore>cml>test>22-2-1-read.test
|
|
;;
|
|
;; Syntax: read &optional input-stream eof-error-p eof-value recursive-p
|
|
;;
|
|
;; Function Description: reads the printed representation of an object from input-stream, builds an object and returns it.
|
|
;;
|
|
;; Argument(s): input-stream: a stream
|
|
;; eof-error-p: if true, signal an error at end-of-file.
|
|
;; eof-value: if eof-error-p is false, return this value at end-of-file.
|
|
;; recursive-p: if true, this is an embedded call, not top-level.
|
|
;;
|
|
;; Returns: the lisp object or eof-value.
|
|
;;
|
|
(do-test-group
|
|
(read-char-group
|
|
:before
|
|
(test-setq test (make-string-input-stream "#@50")
|
|
test2 (make-string-input-stream "")
|
|
test3 (make-string-input-stream "@(a b c)"))
|
|
:after
|
|
(progn (mapcar 'close (list test test2 test3))
|
|
(setq *readtable* (copy-readtable nil))
|
|
) ; progn
|
|
) ;read-char-group
|
|
|
|
(do-test basic-read-test
|
|
(set-macro-character #\@
|
|
'(lambda (stream char)
|
|
(declare (ignore char))
|
|
(read stream)
|
|
) ; lambda
|
|
) ; set-macro-character
|
|
(set-dispatch-macro-character #\# #\@
|
|
'(lambda (stream subchar integer)
|
|
(declare (ignore subchar) (ignore integer))
|
|
(read stream)
|
|
) ; lambda
|
|
) ; set-dispatch-macro-character
|
|
(= 50 (read test t nil t))
|
|
) ; do-test basic-read-test
|
|
|
|
(do-test read-with-eof-error-p-test
|
|
(null (read test2 nil))
|
|
) ; do-test read-with-eof-error-p-test
|
|
;;
|
|
(do-test read-with-eof-value-test
|
|
(equal "EOF" (read test2 nil "EOF"))
|
|
) ; do-test read-with-eof-value-test
|
|
;;
|
|
(do-test read-with-recursive-p-test
|
|
;; From CLtL p. 374
|
|
(equal '(a b c) (read test3))
|
|
) ; do-test read-with-recursive-p-test
|
|
) ; do-test group
|
|
STOP
|
|
|