Commit 76614e6a authored by pfdietz's avatar pfdietz

Extend error tests in some cases where the error should also be signalled in unsafe code.

parent 888e046b
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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)
......
......@@ -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)
......@@ -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)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment