Commit 60b12ff5 authored by pfdietz's avatar pfdietz

Added a large number of tests to check error handling on badly formatted calls in safe code.

parent 0d46fa84
......@@ -63,6 +63,14 @@
(character.2.body)
nil)
(deftest character.3
(classify-error (character))
program-error)
(deftest character.4
(classify-error (character #\a #\a))
program-error)
(deftest characterp.1
(every #'characterp +standard-chars+)
t)
......@@ -75,6 +83,15 @@
(characterp.3.body)
t)
(deftest characterp.error.1
(classify-error (characterp))
program-error)
(deftest characterp.error.2
(classify-error (characterp #\a #\b))
program-error)
(deftest alpha-char-p.1
(loop for c across +standard-chars+
always
......@@ -90,6 +107,14 @@
(char-type-error-check #'alpha-char-p)
t)
(deftest alpha-char-p.error.1
(classify-error (alpha-char-p))
program-error)
(deftest alpha-char-p.error.2
(classify-error (alpha-char-p #\a #\b))
program-error)
(deftest alphanumericp.1
(loop for c across +standard-chars+
always
......@@ -114,6 +139,14 @@
(alphanumericp.5.body)
t)
(deftest alphanumericp.error.1
(classify-error (alphanumericp))
program-error)
(deftest alphanumericp.error.2
(classify-error (alphanumericp #\a #\b))
program-error)
(deftest digit-char.1
(digit-char.1.body)
t)
......@@ -125,6 +158,14 @@
nil nil nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil nil nil))
(deftest digit-char.error.1
(classify-error (digit-char))
program-error)
(deftest digit-char.error.2
(classify-error (digit-char 0 10 'foo))
program-error)
(deftest digit-char-p.1
(digit-char-p.1.body)
t)
......@@ -154,6 +195,15 @@
always (eqlt (digit-char-p c) i))
t)
(deftest digit-char-p.error.1
(classify-error (digit-char-p))
program-error)
(deftest digit-char-p.error.2
(classify-error (digit-char-p #\1 10 'foo))
program-error)
(deftest graphic-char-p.1
(loop for c across +standard-chars+
always (if (eqlt c #\Newline)
......@@ -172,6 +222,14 @@
(char-type-error-check #'graphic-char-p)
t)
(deftest graphic-char-p.error.1
(classify-error (graphic-char-p))
program-error)
(deftest graphic-char-p.error.2
(classify-error (graphic-char-p #\a #\a))
program-error)
(deftest standard-char-p.1
(every #'standard-char-p +standard-chars+)
t)
......@@ -188,6 +246,15 @@
(char-type-error-check #'standard-char-p)
t)
(deftest standard-char-p.error.1
(classify-error (standard-char-p))
program-error)
(deftest standard-char-p.error.2
(classify-error (standard-char-p #\a #\a))
program-error)
(deftest char-upcase.1
(char-upcase.1.body)
t)
......@@ -202,7 +269,15 @@
(deftest char-upcase.4
(char-type-error-check #'char-upcase)
t)
t)
(deftest char-upcase.error.1
(classify-error (char-upcase))
program-error)
(deftest char-upcase.error.2
(classify-error (char-upcase #\a #\a))
program-error)
(deftest char-downcase.1
(char-downcase.1.body)
......@@ -220,6 +295,14 @@
(char-type-error-check #'char-downcase)
t)
(deftest char-downcase.error.1
(classify-error (char-downcase))
program-error)
(deftest char-downcase.error.2
(classify-error (char-downcase #\A #\A))
program-error)
(deftest upper-case-p.1
(find-if-not #'upper-case-p +standard-chars+ :start 26 :end 52)
nil)
......@@ -236,6 +319,14 @@
(char-type-error-check #'upper-case-p)
t)
(deftest upper-case-p.error.1
(classify-error (upper-case-p))
program-error)
(deftest upper-case-p.error.2
(classify-error (upper-case-p #\a #\A))
program-error)
(deftest lower-case-p.1
(find-if-not #'lower-case-p +standard-chars+ :end 26)
nil)
......@@ -248,6 +339,14 @@
(char-type-error-check #'lower-case-p)
t)
(deftest lower-case-p.error.1
(classify-error (lower-case-p))
program-error)
(deftest lower-case-p.error.2
(classify-error (lower-case-p #\a #\a))
program-error)
(deftest both-case-p.1
(both-case-p.1.body)
t)
......@@ -260,6 +359,14 @@
(char-type-error-check #'both-case-p)
t)
(deftest both-case-p.error.1
(classify-error (both-case-p))
program-error)
(deftest both-case-p.error.2
(classify-error (both-case-p #\a #\a))
program-error)
(deftest char-code.1
(char-type-error-check #'char-code)
t)
......@@ -268,11 +375,27 @@
(char-code.2.body)
t)
(deftest char-code.error.1
(classify-error (char-code))
program-error)
(deftest char-code.error.2
(classify-error (char-code #\a #\a))
program-error)
(deftest code-char.1
(loop for x across +standard-chars+
always (eqlt (code-char (char-code x)) x))
t)
(deftest code-char.error.1
(classify-error (code-char))
program-error)
(deftest code-char.error.2
(classify-error (code-char 1 1))
program-error)
(deftest char-int.1
(loop for x across +standard-chars+
always (eqlt (char-int x) (char-code x)))
......@@ -282,6 +405,14 @@
(char-int.2.fn)
t)
(deftest char-int.error.1
(classify-error (char-int))
program-error)
(deftest char-int.error.2
(classify-error (char-int #\a #\a))
program-error)
(deftest char-name.1
(char-name.1.fn)
t)
......@@ -316,6 +447,14 @@
(char-type-error-check #'char-name)
t)
(deftest char-name.error.1
(classify-error (char-name))
program-error)
(deftest char-name.error.2
(classify-error (char-name #\a #\a))
program-error)
(deftest name-char.1
(name-char.1.body)
t)
......@@ -330,3 +469,11 @@
(c4 (name-char s)))
(and (eqlt c1 c2) (eqlt c2 c3) (eqlt c3 c4))))
t)
(deftest name-char.error.1
(classify-error (name-char))
program-error)
(deftest name-char.error.2
(classify-error (name-char "space" "space"))
program-error)
......@@ -1005,7 +1005,7 @@
(multiple-value-bind (sym status)
(find-symbol (symbol-name s) keyword-package)
(cond
((not (eqt s sym)) (push (list s sym) results))
((not (eqt s sym)) (push (list s sym) result))
((eqt status :internal)
(push (list s status) result))
((eqt status :external)
......@@ -1052,6 +1052,14 @@
(classify-error (special-operator-p 1))
type-error)
(deftest special-operator-p.4
(classify-error (special-operator-p))
program-error)
(deftest special-operator-p.5
(classify-error (special-operator-p 'cons 'cons))
program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; keywordp
......@@ -1068,6 +1076,8 @@
;;; This next test was busted. ::foo is not portable syntax
;;(deftest keywordp-11 (not (not (keywordp ::foo))) t)
(deftest keywordp-12 (keywordp t) nil)
(deftest keywordp-13 (classify-error (keywordp)) program-error)
(deftest keywordp-14 (classify-error (keywordp :x :x)) program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; symbol-name
......@@ -1100,6 +1110,14 @@
(symbol-name :|abcdefg|)
"abcdefg")
(deftest symbol-name-8
(classify-error (symbol-name))
program-error)
(deftest symbol-name-9
(classify-error (symbol-name 'a 'b))
program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; make-symbol
......@@ -1176,6 +1194,14 @@
(symbol-name (safe-make-symbol ""))
"")
(deftest make-symbol-19
(classify-error (make-symbol))
program-error)
(deftest make-symbol-20
(classify-error (make-symbol "a" "a"))
program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; copy-symbol
......@@ -1251,6 +1277,14 @@
(eqt (copy-symbol 'a) (copy-symbol 'a))
nil)
(deftest copy-symbol-5
(classify-error (copy-symbol))
program-error)
(deftest copy-symbol-6
(classify-error (copy-symbol 'a t 'foo))
program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; gensym
......@@ -1348,29 +1382,33 @@
;;; argument defaults to "G", with NIL causing an error.
(deftest gensym-14
(catch-type-error (gensym 'aaa))
(classify-error (gensym 'aaa))
type-error)
(deftest gensym-15
(catch-type-error (gensym 12.3))
(classify-error (gensym 12.3))
type-error)
(deftest gensym-16
(catch-type-error (gensym t))
(classify-error (gensym t))
type-error)
(deftest gensym-17
(catch-type-error (gensym nil))
(classify-error (gensym nil))
type-error) ;; NIL /= no argument!
(deftest gensym-18
(catch-type-error (gensym '(a)))
(classify-error (gensym '(a)))
type-error)
(deftest gensym-19
(catch-type-error (gensym #\x))
(classify-error (gensym #\x))
type-error)
(deftest gensym-20
(classify-error (gensym 10 'foo))
program-error)
;;;;;;;;;;;;;;;;;;;;
;;; Tests of CL package constraints from section 11.1.2.1.1
......@@ -1435,3 +1473,62 @@
(typep c 'class))
collect s)
nil)
;;; Various error cases for symbol-related functions
(deftest symbolp.error.1
(classify-error (symbolp))
program-error)
(deftest symbolp.error.2
(classify-error (symbolp nil nil))
program-error)
(deftest keywordp.error.1
(classify-error (keywordp))
program-error)
(deftest keywordp.error.2
(classify-error (keywordp nil nil))
program-error)
(deftest symbol-function.error.1
(classify-error (symbol-function))
program-error)
(deftest symbol-function.error.2
(classify-error (symbol-function 'cons nil))
program-error)
(deftest symbol-name.error.1
(classify-error (symbol-name))
program-error)
(deftest symbol-name.error.2
(classify-error (symbol-name 'cons nil))
program-error)
(deftest symbol-package.error.1
(classify-error (symbol-package))
program-error)
(deftest symbol-package.error.2
(classify-error (symbol-package 'cons nil))
program-error)
(deftest symbol-plist.error.1
(classify-error (symbol-plist))
program-error)
(deftest symbol-plist.error.2
(classify-error (symbol-plist 'cons nil))
program-error)
(deftest symbol-value.error.1
(classify-error (symbol-value))
program-error)
(deftest symbol-value.error.2
(classify-error (symbol-value '*package* nil))
program-error)
......@@ -151,7 +151,14 @@
(error () :caught))
:caught)
(deftest coerce.error.6
(classify-error (coerce))
program-error)
(deftest coerce.error.7
(classify-error (coerce t))
program-error)
\ No newline at end of file
(deftest coerce.error.8
(classify-error (coerce 'x t 'foo))
program-error)
......@@ -87,3 +87,11 @@
(let ((x (list 'a 'b)))
(eqt x (funcall (compile nil `(lambda () ',x)))))
t)
(deftest compile.9
(classify-error (compile))
program-error)
(deftest compile.10
(classify-error (compile nil '(lambda () nil) 'garbage))
program-error)
......@@ -26,3 +26,14 @@
(push #\a x)
(apply (cl::complement #'char=) x))))
t)
(deftest complement.5
(classify-error (complement))
program-error)
(deftest complement.6
(classify-error (complement #'not t))
program-error)
......@@ -200,3 +200,7 @@
(deftest concatenate-error.3
(classify-error (concatenate '(vector * 3) '(a b c d e)))
type-error)
(deftest concatenate-error.4
(classify-error (concatenate))
program-error)
......@@ -188,6 +188,22 @@
(check-type-predicate 'consp 'cons)
0)
(deftest consp.error.1
(classify-error (consp))
program-error)
(deftest consp.error.2
(classify-error (consp 'a 'b))
program-error)
(deftest atom.error.1
(classify-error (atom))
program-error)
(deftest atom.error.2
(classify-error (atom 'a 'b))
program-error)
;; Tests of car, cdr and compound forms
(deftest cons-23
(car '(a))
......@@ -322,6 +338,18 @@
(cddddr *cons-test-4*)
p)
(deftest cons.error.1
(classify-error (cons))
program-error)
(deftest cons.error.2
(classify-error (cons 'a))
program-error)
(deftest cons.error.3
(classify-error (cons 'a 'b 'c))
program-error)
;; Test rplaca, rplacd
(deftest rplaca-1
......@@ -343,15 +371,40 @@
t)
;; rplaca on a fixnum is a type error
(deftest rplaca-error-1
(deftest rplaca.error.1
(loop for x in *universe*
thereis (and (not (consp x))
(not (eq (catch-type-error (rplaca x 1)) 'type-error))))
nil)
(deftest rplaca.error.2
(classify-error (rplaca))
program-error)
(deftest rplaca.error.3
(classify-error (rplaca (cons 'a 'b)))
program-error)
(deftest rplaca.error.4
(classify-error (rplaca (cons 'a 'b) (cons 'c 'd) 'garbage))
program-error)
;; rplacd on a fixnum is a type error
(deftest rplacd-error-1
(deftest rplacd.error.1
(loop for x in *universe*
thereis (and (not (consp x))
(not (eq (catch-type-error (rplacd x 1)) 'type-error))))
nil)
(deftest rplacd.error.2
(classify-error (rplacd))
program-error)
(deftest rplacd.error.3
(classify-error (rplacd (cons 'a 'b)))
program-error)
(deftest rplacd.error.4
(classify-error (rplacd (cons 'a 'b) (cons 'c 'd) 'garbage))
program-error)
......@@ -29,6 +29,14 @@
(check-cons-copy x y)))
t)
(deftest copy-tree.error.1
(classify-error (copy-tree))
program-error)
(deftest copy-tree.error.2
(classify-error (copy-tree 'a 'b))
program-error)
(deftest sublis-1
(check-sublis '((a b) g (d e 10 g h) 15 . g)
'((e . e2) (g . 17)))
......@@ -87,6 +95,28 @@
:key nil)
(2 2 b b))
(deftest sublis-9
(sublis nil 'a :bad-keyword t :allow-other-keys t)
a)
;; Argument error cases
(deftest sublis.error.1
(classify-error (sublis))
program-error)
(deftest sublis.error.2
(classify-error (sublis nil))
program-error)
(deftest sublis.error.3
(classify-error (sublis nil 'a :test))
program-error)
(deftest sublis.error.4
(classify-error (sublis nil 'a :bad-keyword t))
program-error)
;; nsublis
(deftest nsublis-1
......@@ -138,6 +168,10 @@
'*not-present*)))
(1 (z . 2) ((x . "aa"))))
(deftest nsublis-9
(nsublis nil 'a :bad-keyword t :allow-other-keys t)
a)
;; Check that a null key arg is ignored.
(deftest nsublis-8
......@@ -147,6 +181,25 @@
:key nil)
(2 2 b b))
;; Argument error cases
(deftest nsublis.error.1
(classify-error (nsublis))
program-error)
(deftest nsublis.error.2
(classify-error (nsublis nil))
program-error)
(deftest nsublis.error.3
(classify-error (nsublis nil 'a :test))
program-error)
(deftest nsublis.error.4
(classify-error (nsublis nil 'a :bad-keyword t))
program-error)
(deftest sublis-shared
(let* ((shared-piece (list 'a 'b))
(a (list shared-piece shared-piece)))
......@@ -168,39 +221,39 @@
"Z")
(deftest subst-4
(check-subst 'grape 'dick
'(melville wrote (moby dick)))
(check-subst 'grape 'dick
'(melville wrote (moby dick)))
(MELVILLE WROTE (MOBY GRAPE)))
(deftest subst-5
(check-subst 'cha-cha-cha 'nil '(melville wrote (moby dick)))
(check-subst 'cha-cha-cha 'nil '(melville wrote (moby dick)))
(MELVILLE WROTE (MOBY DICK . CHA-CHA-CHA) . CHA-CHA-CHA))
(deftest subst-6
(check-subst
'(1 2) '(foo . bar)
'((foo . baz) (foo . bar) (bar . foo) (baz foo . bar))
:test #'equal)
(check-subst
'(1 2) '(foo . bar)
'((foo . baz) (foo . bar) (bar . foo) (baz foo . bar))
:test #'equal)
((foo . baz) (1 2) (bar . foo) (baz 1 2)))
(deftest subst-7
(check-subst
'foo "aaa"
'((1 . 2) (4 . 5) (6 7 8 9 10 (11 12)))
:key #'(lambda (x) (if (and (numberp x) (evenp x))
"aaa"
nil))
:test #'string=)
(check-subst
'foo "aaa"
'((1 . 2) (4 . 5) (6 7 8 9 10 (11 12)))
:key #'(lambda (x) (if (and (numberp x) (evenp x))
"aaa"
nil))
:test #'string=)
((1 . foo) (foo . 5) (foo 7 foo 9 foo (11 foo))))
(deftest subst-8
(check-subst
'foo nil
'((1 . 2) (4 . 5) (6 7 8 9 10 (11 12)))
:key #'(lambda (x) (if (and (numberp x) (evenp x))
(copy-seq "aaa")
nil))
:test-not #'equal)
(check-subst
'foo nil
'((1 . 2) (4 . 5) (6 7 8 9 10 (11 12)))
:key #'(lambda (x) (if (and (numberp x) (evenp x))
(copy-seq "aaa")
nil))
:test-not #'equal)
((1 . foo) (foo . 5) (foo 7 foo 9 foo (11 foo))))
(deftest subst-9
......@@ -208,6 +261,10 @@
(copy-tree '(a b c d a b))
:key nil)
(a a c d a a))
(deftest subst-10
(subst 'a 'b nil :bad t :allow-other-keys t)
nil)
(deftest subst-if-1
(check-subst-if 'a #'consp '((100 1) (2 3) (4 3 2 1) (a b c)))
......@@ -275,12 +332,22 @@
:key nil)
((a) (a) (c) (d)))
(deftest subst-if-7
(subst-if 'a #'null nil :bad t :allow-other-keys t)
a)
(deftest subst-if-not-5
(check-subst-if-not 'a #'(lambda (x) (not (eql x 'b)))
'((a) (b) (c) (d))
:key nil)
((a) (a) (c) (d)))
(deftest subst-if-not-7
(subst-if 'a #'identity nil :bad t :allow-other-keys t)
nil)
(defvar *nsubst-tree-1* '(10 (30 20 10) (20 10) (10 20 30 40)))