diff --git a/ansi-tests/load-printer.lsp b/ansi-tests/load-printer.lsp index ff43d6d91ffa8afc47bfac4c59fa4d99729a796e..9b6bfb245c7c85ecf6a3f2808b3dab5691fcd120 100644 --- a/ansi-tests/load-printer.lsp +++ b/ansi-tests/load-printer.lsp @@ -25,3 +25,5 @@ (load "print-pathname.lsp") (load "print-structure.lsp") (load "printer-control-vars.lsp") +(load "pprint-dispatch.lsp") +(load "pprint-fill.lsp") \ No newline at end of file diff --git a/ansi-tests/makefile b/ansi-tests/makefile index 01fc6bb43a02641b5b3e9d9dda05f062b0b32507..fc7a512da383b1b8f0e2402a82f12da59cb91216 100644 --- a/ansi-tests/makefile +++ b/ansi-tests/makefile @@ -31,7 +31,7 @@ random-test: clean: @rm -f test.out *.cls *.fasl *.o *.so *~ *.fn *.x86f *.fasl *.ufsl *.abcl *.fas *.lib \#*\# @rm -rf scratch/ - @rm -f foo.txt foo.lsp file-that-was-renamed.txt tmp.dat temp.dat + @rm -f foo.txt foo.lsp file-that-was-renamed.txt tmp.dat tmp2.dat temp.dat @rm -f gazonk* @rm -rf TMP/ diff --git a/ansi-tests/pprint-fill.lsp b/ansi-tests/pprint-fill.lsp new file mode 100644 index 0000000000000000000000000000000000000000..84055e1211955f6e1273fc5cedd61aaa6bd475e0 --- /dev/null +++ b/ansi-tests/pprint-fill.lsp @@ -0,0 +1,92 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Jun 25 22:03:01 2004 +;;;; Contains: Tests of PPRINT-FILL + +(in-package :cl-test) + +;;; When printing a non-list, the result is the same as calling WRITE." +(deftest pprint-fill.1 + (my-with-standard-io-syntax + (let ((*print-pretty* t) + (*print-readably* nil)) + (loop for obj in *mini-universe* + nconc + (and (not (listp obj)) + (let ((s1 (write-to-string obj)) + (s2 (with-output-to-string (s) (assert (null (pprint-fill s obj)))))) + (unless (equal s1 s2) + (list (list obj s1 s2)))))))) + nil) + +(deftest pprint-fill.2 + (my-with-standard-io-syntax + (let ((*print-pretty* nil) + (*print-readably* nil)) + (loop for obj in *mini-universe* + nconc + (and (not (listp obj)) + (let ((s1 (write-to-string obj)) + (s2 (with-output-to-string (s) (assert (null (pprint-fill s obj)))))) + (unless (equal s1 s2) + (list (list obj s1 s2)))))))) + nil) + +(deftest pprint-fill.3 + (my-with-standard-io-syntax + (let ((*print-pretty* nil) + (*print-readably* nil) + (*print-right-margin* 100)) + (with-output-to-string + (s) + (assert (null (pprint-fill s '(cl-user::|A|))))))) + "(A)") + +(deftest pprint-fill.4 + (my-with-standard-io-syntax + (let ((*print-pretty* nil) + (*print-readably* nil) + (*print-right-margin* 100)) + (with-output-to-string + (s) + (assert (null (pprint-fill s '(cl-user::|A|) t)))))) + "(A)") + +(deftest pprint-fill.5 + (my-with-standard-io-syntax + (let ((*print-pretty* nil) + (*print-readably* nil) + (*print-right-margin* 100)) + (with-output-to-string + (s) + (assert (null (pprint-fill s '(cl-user::|A|) nil)))))) + "A") + +(deftest pprint-fill.6 + (my-with-standard-io-syntax + (let ((*print-pretty* nil) + (*print-readably* nil) + (*print-right-margin* 100)) + (with-output-to-string + (s) + (assert (null (pprint-fill s '(1 2 3 4 5))))))) + "(1 2 3 4 5)") + +(deftest pprint-fill.7 + (my-with-standard-io-syntax + (let ((*print-pretty* nil) + (*print-readably* nil) + (*print-right-margin* 100)) + (with-output-to-string + (s) + (assert (null (pprint-fill s '((1) (2) #(3) "abc" 5) nil)))))) + "(1) (2) #(3) \"abc\" 5") + + + + + + + + +