Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Karsten Poeck
ansi-test
Commits
e30ff557
Commit
e30ff557
authored
May 06, 2005
by
pfdietz
Browse files
More type error refactoring
parent
9365b190
Changes
81
Hide whitespace changes
Inline
Side-by-side
ansi-tests/ansi-aux.lsp
View file @
e30ff557
...
...
@@ -1144,3 +1144,14 @@ the condition to go uncaught if it cannot be classified."
(rational 0)))
(defun sequencep (x) (typep x 'sequence))
(defun typef (type) #'(lambda (x) (typep x type)))
(defun package-designator-p (x)
"TRUE if x could be a package designator. The package need not
actually exist."
(or (packagep x)
(handler-case (and (locally (declare (optimize safety))
(string x))
t)
(type-error () nil))))
ansi-tests/intersection.lsp
View file @
e30ff557
...
...
@@ -405,3 +405,11 @@
(signals-error (intersection '(a b . c) '(d e f))
type-error)
t)
(deftest intersection.error.13
(check-type-error #'(lambda (x) (intersection x '(a b c))) #'listp)
nil)
(deftest intersection.error.14
(check-type-error #'(lambda (x) (intersection '(a b c) x)) #'listp)
nil)
\ No newline at end of file
ansi-tests/logand.lsp
View file @
e30ff557
...
...
@@ -10,17 +10,15 @@
;;; Error tests
(deftest logand.error.1
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logand ',x) type-error)))
collect x)
(check-type-error #'logand #'integerp)
nil)
(deftest logand.error.2
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logand 0 ',x) type-error)))
collect x)
(check-type-error #'(lambda (x) (logand 0 x)) #'integerp)
nil)
(deftest logand.error.3
(check-type-error #'(lambda (x) (logand x 1)) #'integerp)
nil)
;;; Non-error tests
...
...
ansi-tests/logandc2.lsp
View file @
e30ff557
...
...
@@ -10,17 +10,11 @@
;;; Error tests
(deftest logandc2.error.1
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logandc2 ',x 0) type-error)))
collect x)
(check-type-error #'(lambda (x) (logandc2 x 0)) #'integerp)
nil)
(deftest logandc2.error.2
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logandc2 0 ',x) type-error)))
collect x)
(check-type-error #'(lambda (x) (logandc2 0 x)) #'integerp)
nil)
(deftest logandc2.error.3
...
...
ansi-tests/logbitp.lsp
View file @
e30ff557
...
...
@@ -22,14 +22,11 @@
t)
(deftest logbitp.error.4
(
signals-error
(logbitp
-1
0) type
-error
)
t
)
(
check-type-error #'(lambda (x)
(logbitp
x
0)
)
(
type
f 'unsigned-byte)
)
nil
)
(deftest logbitp.error.5
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logbitp 0 ',x) type-error)))
collect x)
(check-type-error #'(lambda (x) (logbitp 0 x)) #'integerp)
nil)
;;; Non-error tests
...
...
ansi-tests/logcount.lsp
View file @
e30ff557
...
...
@@ -16,10 +16,7 @@
t)
(deftest logcount.error.3
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logcount ',x) type-error)))
collect x)
(check-type-error #'logcount #'integerp)
nil)
;;; Non-error tests
...
...
ansi-tests/logeqv.lsp
View file @
e30ff557
...
...
@@ -10,17 +10,11 @@
;;; Error tests
(deftest logeqv.error.1
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logeqv ',x) type-error)))
collect x)
(check-type-error #'logeqv #'integerp)
nil)
(deftest logeqv.error.2
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logeqv 0 ',x) type-error)))
collect x)
(check-type-error #'(lambda (x) (logeqv 0 x)) #'integerp)
nil)
;;; Non-error tests
...
...
ansi-tests/logical-pathname.lsp
View file @
e30ff557
...
...
@@ -29,13 +29,8 @@
;;; Error tests
(deftest logical-pathname.error.1
(loop for x in *mini-universe*
unless (or (stringp x)
(typep x 'stream)
(typep x 'logical-pathname)
(eval `(signals-error (logical-pathname ',x)
type-error)))
collect x)
(check-type-error #'logical-pathname
(typef '(or string stream logical-pathname)))
nil)
(deftest logical-pathname.error.2
...
...
ansi-tests/logior.lsp
View file @
e30ff557
...
...
@@ -12,17 +12,11 @@
;;; Error tests
(deftest logior.error.1
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logior ',x) type-error)))
collect x)
(check-type-error #'logior #'integerp)
nil)
(deftest logior.error.2
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logior 0 ',x) type-error)))
collect x)
(check-type-error #'(lambda (x) (logior 0 x)) #'integerp)
nil)
;;; Non-error tests
...
...
ansi-tests/lognand.lsp
View file @
e30ff557
...
...
@@ -10,17 +10,11 @@
;;; Error tests
(deftest lognand.error.1
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (lognand ',x 0) type-error)))
collect x)
(check-type-error #'(lambda (x) (lognand x 0)) #'integerp)
nil)
(deftest lognand.error.2
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (lognand 0 ',x) type-error)))
collect x)
(check-type-error #'(lambda (x) (lognand 0 x)) #'integerp)
nil)
(deftest lognand.error.3
...
...
ansi-tests/lognor.lsp
View file @
e30ff557
...
...
@@ -10,17 +10,11 @@
;;; Error tests
(deftest lognor.error.1
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (lognor ',x 0) type-error)))
collect x)
(check-type-error #'(lambda (x) (lognor x 0)) #'integerp)
nil)
(deftest lognor.error.2
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (lognor 0 ',x) type-error)))
collect x)
(check-type-error #'(lambda (x) (lognor 0 x)) #'integerp)
nil)
(deftest lognor.error.3
...
...
ansi-tests/lognot.lsp
View file @
e30ff557
...
...
@@ -10,10 +10,7 @@
;;; Error tests
(deftest lognot.error.1
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (lognot ',x) type-error)))
collect x)
(check-type-error #'lognot #'integerp)
nil)
(deftest lognot.error.2
...
...
ansi-tests/logorc1.lsp
View file @
e30ff557
...
...
@@ -10,17 +10,11 @@
;;; Error tests
(deftest logorc1.error.1
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logorc1 ',x 0) type-error)))
collect x)
(check-type-error #'(lambda (x) (logorc1 x 0)) #'integerp)
nil)
(deftest logorc1.error.2
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logorc1 0 ',x) type-error)))
collect x)
(check-type-error #'(lambda (x) (logorc1 0 x)) #'integerp)
nil)
(deftest logorc1.error.3
...
...
ansi-tests/logorc2.lsp
View file @
e30ff557
...
...
@@ -10,17 +10,11 @@
;;; Error tests
(deftest logorc2.error.1
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logorc2 ',x 0) type-error)))
collect x)
(check-type-error #'(lambda (x) (logorc2 x 0)) #'integerp)
nil)
(deftest logorc2.error.2
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logorc2 0 ',x) type-error)))
collect x)
(check-type-error #'(lambda (x) (logorc2 0 x)) #'integerp)
nil)
(deftest logorc2.error.3
...
...
ansi-tests/logtest.lsp
View file @
e30ff557
...
...
@@ -20,17 +20,11 @@
t)
(deftest logtest.error.4
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logtest ',x -1) type-error)))
collect x)
(check-type-error #'(lambda (x) (logtest x -1)) #'integerp)
nil)
(deftest logtest.error.5
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logtest -1 ',x) type-error)))
collect x)
(check-type-error #'(lambda (x) (logtest -1 x)) #'integerp)
nil)
;;; Non-error tests
...
...
ansi-tests/logxor.lsp
View file @
e30ff557
...
...
@@ -10,17 +10,11 @@
;;; Error tests
(deftest logxor.error.1
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logxor ',x) type-error)))
collect x)
(check-type-error #'logxor #'integerp)
nil)
(deftest logxor.error.2
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (logxor 0 ',x) type-error)))
collect x)
(check-type-error #'(lambda (x) (logxor 0 x)) #'integerp)
nil)
...
...
ansi-tests/make-broadcast-stream.lsp
View file @
e30ff557
...
...
@@ -88,22 +88,12 @@
;;; Error tests
(deftest make-broadcast-stream.error.1
(loop for x in *mini-universe*
unless (or (and (typep x 'stream) (output-stream-p x))
(handler-case (progn (make-broadcast-stream x) nil)
(type-error () t)
(condition nil)))
collect x)
(check-type-error #'make-broadcast-stream
#'(lambda (x) (and (streamp x) (output-stream-p x))))
nil)
(deftest make-broadcast-stream.error.2
(loop for x in *streams*
unless (or (and (typep x 'stream) (output-stream-p x))
(handler-case (progn (make-broadcast-stream x) nil)
(type-error () t)
(condition nil)))
collect x)
(check-type-error #'make-broadcast-stream
#'(lambda (x) (and (streamp x) (output-stream-p x)))
*streams*)
nil)
ansi-tests/make-list.lsp
View file @
e30ff557
...
...
@@ -71,12 +71,8 @@
(deftest make-list.error.1
(catch-type-error (make-list -1))
type-error)
(deftest make-list.error.2
(signals-error (make-list 'a) type-error)
t)
(check-type-error #'make-list (typef 'unsigned-byte))
nil)
(deftest make-list.error.3
(signals-error (make-list) program-error)
...
...
ansi-tests/make-random-state.lsp
View file @
e30ff557
...
...
@@ -20,10 +20,7 @@
t)
(deftest make-random-state.error.4
(loop for x in *mini-universe*
unless (or (null x) (eq x t) (random-state-p x)
(eval `(signals-error (make-random-state ',x) type-error)))
collect x)
(check-type-error #'make-random-state (typef '(or (member nil t) random-state)))
nil)
;;; Non-error tests
...
...
ansi-tests/make-symbol.lsp
View file @
e30ff557
...
...
@@ -118,36 +118,8 @@
"ABC" 1)
(deftest make-symbol.error.1
(signals-error (make-symbol nil) type-error)
t)
(deftest make-symbol.error.2
(signals-error (make-symbol 'a) type-error)
t)
(deftest make-symbol.error.3
(signals-error (make-symbol 1) type-error)
t)
(deftest make-symbol.error.4
(signals-error (make-symbol -1) type-error)
t)
(deftest make-symbol.error.5
(signals-error (make-symbol 1.213) type-error)
t)
(deftest make-symbol.error.6
(signals-error (make-symbol -1312.2) type-error)
t)
(deftest make-symbol.error.7
(signals-error (make-symbol #\w) type-error)
t)
(deftest make-symbol.error.8
(signals-error (make-symbol '(a)) type-error)
t)
(check-type-error #'make-symbol #'stringp)
nil)
(deftest make-symbol.error.9
(signals-error (make-symbol) program-error)
...
...
@@ -158,5 +130,5 @@
t)
(deftest make-symbol.error.11
(signals-error
(make-symbol
'(#\a #\b #\c)
) type-error
)
(signals-
type-
error
x
'(#\a #\b #\c)
(make-symbol x)
)
t)
Prev
1
2
3
4
5
Next
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment