93 lines
2.7 KiB
Plaintext
93 lines
2.7 KiB
Plaintext
;; Function To Be Tested: print
|
|
;;
|
|
;; Source: CLtL p. 383
|
|
;;
|
|
;; Chapter 22: Input/Output Section 3.1: Output to Character Streams
|
|
;;
|
|
;; Created By: Peter Reidy
|
|
;;
|
|
;; Creation Date: 1 December 86
|
|
;;
|
|
;; Last Update: 2 December 86
|
|
;;
|
|
;; Filed As: {eris}<lispcore>cml>test>22-3-1-print.test
|
|
;;
|
|
;; Syntax: print object &optional output-stream
|
|
;;
|
|
;; Function Description: outputs object to output-stream (default: *standard-output*) with escape characters, preceded by a (terpri) and followed by a space.
|
|
;;
|
|
;; Argument(s): object - a cml object
|
|
;; output-stream - a stream
|
|
;;
|
|
;; Returns: object
|
|
;;
|
|
(do-test-group (print-group
|
|
:before (progn
|
|
(test-setq
|
|
stream (open 'file :direction :output :if-exists :new-version :if-does-not-exist :create :element-type 'unsigned-byte)
|
|
examples (list
|
|
(make-array '(3 5) :adjustable t) ; array
|
|
'100.88 ; atom
|
|
(1+ most-positive-fixnum) ; bignum
|
|
1 ; bit
|
|
(make-array 3 :element-type 'bit :fill-pointer 2) ; bit-vector
|
|
#\newline ; character
|
|
(car (list-all-packages)) ; common
|
|
#'cons ; compiled-function
|
|
#c(3 3) ; complex
|
|
'(1 . 2) ; cons
|
|
1.00 ; double-float
|
|
#'(lambda nil 100) ; function
|
|
(make-hash-table) ; hash-table
|
|
100000 ; integer
|
|
:skate ; keyword
|
|
(cons nil nil) ; list
|
|
2.25 ; long-float
|
|
;; nothing for type NIL
|
|
nil ; null
|
|
.4761 ; number
|
|
*package* ; package
|
|
*default-pathname-defaults*
|
|
(make-random-state)
|
|
3/4 ; ratio, rational
|
|
(copy-readtable)
|
|
"sequence"
|
|
3.33 ; short-float
|
|
"simple array"
|
|
(make-array 10) ; simple-vector
|
|
.5 ; single-float
|
|
#\5 ; standard-char
|
|
*standard-input* ; stream
|
|
(make-array 5 :element-type 'string-char :adjustable t) ; string
|
|
#\ ; string-char
|
|
'\A\ bcd\E ; symbol
|
|
nil ; t
|
|
"vector"
|
|
) ; list
|
|
newline "
|
|
"
|
|
blank " "
|
|
) ; test-setq
|
|
(test-defun printtest (object)
|
|
"PRINT an object to a file and to *standard-output*, seeing in each case that PRINT's value is eq to the object. Verify that it starts with a newline and ends with a space."
|
|
(let ((stringstream (with-output-to-string (charstream) (print object charstream))))
|
|
(and
|
|
(eq object (print object))
|
|
(eq object (print object stream))
|
|
;; Acknowledgements to Bob Bane.
|
|
(= 0 (search newline stringstream))
|
|
(= 0 (search blank (reverse stringstream)))
|
|
) ; and
|
|
) ; let
|
|
) ; test-defun
|
|
) ; progn
|
|
:after (progn (close stream) (delete-file 'file))
|
|
) ; print-group
|
|
(do-test print-test
|
|
;; Print an example of each of the standard types
|
|
(every 'printtest examples)
|
|
) ; do-test print-test
|
|
) ; do-test-group
|
|
STOP
|
|
|