diff --git a/ansi-tests/pprint-dispatch.lsp b/ansi-tests/pprint-dispatch.lsp index 0e276ce02ebb3cd2984dd0ccf5cf91275874f958..3bbde684718615dcc80655c1d1ca4c64705512fc 100644 --- a/ansi-tests/pprint-dispatch.lsp +++ b/ansi-tests/pprint-dispatch.lsp @@ -265,8 +265,22 @@ t) +(deftest set-pprint-dispatch.error.4 + (loop for x in *mini-universe* + unless (or (typep x 'real) + (eval `(signals-error (let ((table (copy-pprint-dispatch nil))) + (set-pprint-dispatch t 'identity ',x)) + error))) + collect x) + nil) - - - +(deftest set-pprint-dispatch.error.4-unsafe + (loop for x in *mini-universe* + unless (or (typep x 'real) + (eval `(signals-error (let ((table (copy-pprint-dispatch nil))) + (declare (optimize (safety 0))) + (set-pprint-dispatch t 'identity ',x)) + error))) + collect x) + nil) diff --git a/ansi-tests/pprint-exit-if-list-exhausted.lsp b/ansi-tests/pprint-exit-if-list-exhausted.lsp index 361c57519af449c95a4db3d5694ed7e3c1f2e60c..5a54947ce3d626e5a2116f84a383ba2e2eac8158 100644 --- a/ansi-tests/pprint-exit-if-list-exhausted.lsp +++ b/ansi-tests/pprint-exit-if-list-exhausted.lsp @@ -308,10 +308,19 @@ (signals-error (pprint-exit-if-list-exhausted) error) t) +(deftest pprint-exit-if-list-exhausted.error.1-unsafe + (locally (declare (optimize (safety 0))) + (signals-error (locally (declare (optimize (safety 0))) + (pprint-exit-if-list-exhausted)) + error)) + t) + (deftest pprint-pop.error.1 (signals-error (pprint-pop) error) t) - - +(deftest pprint-pop.error.1-unsafe + (locally (declare (optimize (safety 0))) + (signals-error (locally (declare (optimize (safety 0))) (pprint-pop)) error)) + t) diff --git a/ansi-tests/pprint-indent.lsp b/ansi-tests/pprint-indent.lsp index 594f09464be0bbb73d8f20feb93a53158d1fd511..1c00b55a055aef6a60f4700ea2e34b5e3a882b8d 100644 --- a/ansi-tests/pprint-indent.lsp +++ b/ansi-tests/pprint-indent.lsp @@ -404,3 +404,12 @@ M") (not (eval `(signals-error (pprint-indent ',x 0) error)))) collect x) nil) + +(deftest pprint-indent.error.4-unsafe + (loop for x in *mini-universe* + when (and (not (member x '(:block :current))) + (not (eval `(signals-error (locally (declare (optimize (safety 0))) (pprint-indent ',x 0)) + error)))) + collect x) + nil) + diff --git a/ansi-tests/pprint-logical-block.lsp b/ansi-tests/pprint-logical-block.lsp index 120cae415d4e26624a51397e0c4e194a1b13fbae..49bf0cb307cd888a5d0907574c0a75455db62139 100644 --- a/ansi-tests/pprint-logical-block.lsp +++ b/ansi-tests/pprint-logical-block.lsp @@ -259,6 +259,14 @@ abcd3") collect x) nil) +(deftest pprint-logical-block.error.1-unsafe + (loop for x in *mini-universe* + for form = `(pprint-logical-block (*standard-output* '(1) :prefix ',x)) + unless (or (stringp x) + (eq (eval `(signals-error ,form type-error :safety 0)) t)) + collect x) + nil) + (deftest pprint-logical-block.error.2 (loop for x in *mini-universe* for form = `(pprint-logical-block (*standard-output* '(1) :suffix ',x)) @@ -267,6 +275,14 @@ abcd3") collect x) nil) +(deftest pprint-logical-block.error.2-unsafe + (loop for x in *mini-universe* + for form = `(pprint-logical-block (*standard-output* '(1) :suffix ',x)) + unless (or (stringp x) + (eq (eval `(signals-error ,form type-error :safety 0)) t)) + collect x) + nil) + (deftest pprint-logical-block.error.3 (loop for x in *mini-universe* for form = `(pprint-logical-block (*standard-output* '(1) :per-line-prefix ',x)) @@ -275,6 +291,14 @@ abcd3") collect x) nil) +(deftest pprint-logical-block.error.3-unsafe + (loop for x in *mini-universe* + for form = `(pprint-logical-block (*standard-output* '(1) :per-line-prefix ',x)) + unless (or (stringp x) + (eq (eval `(signals-error ,form type-error :safety 0)) t)) + collect x) + nil) + (deftest pprint-logical-block.error.4 (signals-error (with-standard-io-syntax (let ((*print-pretty* t) @@ -285,3 +309,15 @@ abcd3") (write (car val) :stream os)))) error) t) + +(deftest pprint-logical-block.error.4-unsafe + (signals-error (with-standard-io-syntax + (let ((*print-pretty* t) + (*print-right-margin* 100) + (*print-readably* nil) + (val '(7))) + (pprint-logical-block (os val :prefix "" :per-line-prefix "") + (write (car val) :stream os)))) + error + :safety 0) + t) diff --git a/ansi-tests/pprint-newline.lsp b/ansi-tests/pprint-newline.lsp index b025af7f2fc65feea81db6edf405995fb8aedad9..fc35ec4ad7371fba313cc28435914f442c9f184d 100644 --- a/ansi-tests/pprint-newline.lsp +++ b/ansi-tests/pprint-newline.lsp @@ -459,6 +459,13 @@ A " collect x) nil) +(deftest pprint-newline.error.1-unsafe + (loop for x in *mini-universe* + unless (member x '(:linear :miser :fill :mandatory)) + unless (eval `(signals-error (locally (declare (optimize (safety 0))) (pprint-newline ',x)) type-error)) + collect x) + nil) + (deftest pprint-newline.error.2 (signals-error (pprint-newline) program-error) t) diff --git a/ansi-tests/pprint-tab.lsp b/ansi-tests/pprint-tab.lsp index 81870aa51c9aaa934d611f9c163b48eb390760e7..d13cd4c787c571430d8b96862982952752a796a6 100644 --- a/ansi-tests/pprint-tab.lsp +++ b/ansi-tests/pprint-tab.lsp @@ -230,6 +230,9 @@ collect x) nil) - - - +(deftest pprint-tab.error.5-unsafe + (loop for x in *mini-universe* + unless (or (member x '(:line :section :line-relative :section-relative)) + (eval `(signals-error (locally (declare (optimize (safety 0))) (pprint-tab ',x 1 1)) error))) + collect x) + nil) diff --git a/ansi-tests/wild-pathname-p.lsp b/ansi-tests/wild-pathname-p.lsp index c99433102944810827e31f655a1d3d07b1d94aed..9a1c57872bc9fb2648bd66575aca6b1ebf95436a 100644 --- a/ansi-tests/wild-pathname-p.lsp +++ b/ansi-tests/wild-pathname-p.lsp @@ -5,6 +5,8 @@ (in-package :cl-test) +(compile-and-load "pathnames-aux.lsp") + (deftest wild-pathname-p.1 (wild-pathname-p (make-pathname)) nil) @@ -216,3 +218,12 @@ type-error))) collect x) nil) + +(deftest wild-pathname-p.error.4 + (loop for x in *mini-universe* + unless (or (could-be-pathname-designator x) + (eval `(signals-error (wild-pathname-p ',x) + type-error + :safety 0))) + collect x) + nil)