Commit 0e1870a4 authored by pfdietz's avatar pfdietz

Added fallback ERROR case to classify-error. Added numerous tests to check...

Added fallback ERROR case to classify-error.  Added numerous tests to check that safe calls inside builtin functions that take function parameters are truly safe.
parent 70b7a928
......@@ -279,6 +279,7 @@ the condition to go uncaught if it cannot be classified."
(file-error () 'file-error)
(control-error () 'control-error)
(cell-error () 'cell-error)
(error () 'error)
)))
(defun classify-error** (form)
......
......@@ -19,6 +19,10 @@
(classify-error (apply #'cons nil))
program-error)
(deftest apply.error.4
(classify-errir (apply #'cons (list 1 2 3)))
program-error)
;;; Non-error cases
(deftest apply.1
......
......@@ -47,3 +47,11 @@
(deftest complement.error.2
(classify-error (complement #'not t))
program-error)
(deftest complement.error.3
(classify-error (funcall (complement #'identity)))
program-error)
(deftest complement.error.4
(classify-error (funcall (complement #'identity) t t))
program-error)
......@@ -207,18 +207,12 @@
;;; Error tests
(deftest concatenate.error.1
(handler-case
(progn (proclaim '(optimize (safety 3)))
(eval '(concatenate 'sequence '(a b c))))
(error () :caught))
:caught)
(subtypep* (classify-error (concatenate 'sequence '(a b c))) 'error)
t t)
(deftest concatenate.error.2
(handler-case
(progn (proclaim '(optimize (safety 3)))
(concatenate 'fixnum '(a b c d e)))
(error () :caught))
:caught)
(subtypep* (classify-error (concatenate 'fixnum '(a b c d e))) 'error)
t t)
(deftest concatenate.error.3
(classify-error (concatenate '(vector * 3) '(a b c d e)))
......
......@@ -181,6 +181,24 @@
(classify-error (sublis nil 'a :bad-keyword t))
program-error)
(deftest sublis.error.5
(classify-error (sublis '((a . 1) (b . 2))
(list 'a 'b 'c 'd)
:test #'identity))
program-error)
(deftest sublis.error.6
(classify-error (sublis '((a . 1) (b . 2))
(list 'a 'b 'c 'd)
:key #'cons))
program-error)
(deftest sublis.error.7
(classify-error (sublis '((a . 1) (b . 2))
(list 'a 'b 'c 'd)
:test-not #'identity))
program-error)
;; nsublis
(deftest nsublis.1
......@@ -321,6 +339,25 @@
(classify-error (nsublis nil 'a :bad-keyword t))
program-error)
(deftest nsublis.error.5
(classify-error (nsublis '((a . 1) (b . 2))
(list 'a 'b 'c 'd)
:test #'identity))
program-error)
(deftest nsublis.error.6
(classify-error (nsublis '((a . 1) (b . 2))
(list 'a 'b 'c 'd)
:key #'cons))
program-error)
(deftest nsublis.error.7
(classify-error (nsublis '((a . 1) (b . 2))
(list 'a 'b 'c 'd)
:test-not #'identity))
program-error)
;;;;;;
(deftest sublis.shared
(let* ((shared-piece (list 'a 'b))
......@@ -891,6 +928,18 @@
(classify-error (subst 'a 'b nil :bad t :allow-other-keys nil))
program-error)
(deftest subst.error.8
(classify-error (subst 'a 'b (list 'a 'b) :test #'identity))
program-error)
(deftest subst.error.9
(classify-error (subst 'a 'b (list 'a 'b) :test-not #'identity))
program-error)
(deftest subst.error.10
(classify-error (subst 'a 'b (list 'a 'b) :key #'equal))
program-error)
;;; nsubst
(deftest nsubst.error.1
(classify-error (nsubst))
......@@ -920,6 +969,18 @@
(classify-error (nsubst 'a 'b nil :bad t :allow-other-keys nil))
program-error)
(deftest nsubst.error.8
(classify-error (nsubst 'a 'b (list 'a 'b) :test #'identity))
program-error)
(deftest nsubst.error.9
(classify-error (nsubst 'a 'b (list 'a 'b) :test-not #'identity))
program-error)
(deftest nsubst.error.10
(classify-error (nsubst 'a 'b (list 'a 'b) :key #'equal))
program-error)
;;; subst-if
(deftest subst-if.error.1
(classify-error (subst-if))
......@@ -949,6 +1010,10 @@
(classify-error (subst-if 'a #'null nil :bad t :allow-other-keys nil))
program-error)
(deftest subst-if.error.8
(classify-error (subst-if 'a #'null (list 'a nil 'c) :key #'cons))
program-error)
;;; subst-if-not
(deftest subst-if-not.error.1
(classify-error (subst-if-not))
......@@ -979,6 +1044,10 @@
:bad t :allow-other-keys nil))
program-error)
(deftest subst-if-not.error.8
(classify-error (subst-if-not 'a #'null (list 'a nil 'c) :key #'cons))
program-error)
;;; nsubst-if
(deftest nsubst-if.error.1
(classify-error (nsubst-if))
......@@ -1008,6 +1077,10 @@
(classify-error (nsubst-if 'a #'null nil :bad t :allow-other-keys nil))
program-error)
(deftest nsubst-if.error.8
(classify-error (nsubst-if 'a #'null (list 'a nil 'c) :key #'cons))
program-error)
;;; nsubst-if-not
(deftest nsubst-if-not.error.1
......@@ -1038,3 +1111,8 @@
(classify-error (nsubst-if-not 'a #'null nil
:bad t :allow-other-keys nil))
program-error)
(deftest nsubst-if-not.error.8
(classify-error (nsubst-if-not 'a #'null (list 'a nil 'c) :key #'cons))
program-error)
......@@ -229,6 +229,24 @@
(a b c) (a b c)
3 1 3 2)
(deftest pushnew.error.1
(classify-error
(let ((x '(a b)))
(pushnew 'c x :test #'identity)))
program-error)
(deftest pushnew.error.2
(classify-error
(let ((x '(a b)))
(pushnew 'c x :test-not #'identity)))
program-error)
(deftest pushnew.error.3
(classify-error
(let ((x '(a b)))
(pushnew 'c x :key #'cons)))
program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; adjoin
......@@ -381,3 +399,15 @@
(deftest adjoin.error.6
(classify-error (adjoin 'a '(b c) :test))
program-error)
(deftest adjoin.error.7
(classify-error (adjoin 'a '(b c) :test #'identity))
program-error)
(deftest adjoin.error.8
(classify-error (adjoin 'a '(b c) :test-not #'identity))
program-error)
(deftest adjoin.error.9
(classify-error (adjoin 'a '(b c) :key #'cons))
program-error)
......@@ -278,3 +278,15 @@
(deftest member.error.14
(classify-error (locally (member 'a t) t))
type-error)
(deftest member.error.15
(classify-error (member 'a '(a b c) :test #'identity))
program-error)
(deftest member.error.16
(classify-error (member 'a '(a b c) :test-not #'identity))
program-error)
(deftest member.error.17
(classify-error (member 'a '(a b c) :key #'cons))
program-error)
......@@ -225,6 +225,14 @@
(classify-error (locally (member-if #'identity 'a) t))
type-error)
(deftest member-if.error.9
(classify-error (member-if #'cons '(a b c)))
program-error)
(deftest member-if.error.10
(classify-error (member-if #'identity '(a b c) :key #'cons))
program-error)
(deftest member-if-not.error.1
(classify-error (member-if-not #'identity 'a))
......@@ -257,3 +265,11 @@
(deftest member-if-not.error.8
(classify-error (locally (member-if-not #'identity 'a) t))
type-error)
(deftest member-if-not.error.9
(classify-error (member-if-not #'cons '(a b c)))
program-error)
(deftest member-if-not.error.10
(classify-error (member-if-not #'identity '(a b c) :key #'cons))
program-error)
......@@ -92,6 +92,18 @@
(classify-error (locally (mapc #'identity 1) t))
type-error)
(deftest mapc.error.5
(classify-error (mapc #'cons '(a b c)))
program-error)
(deftest mapc.error.6
(classify-error (mapc #'cons '(a b c) '(1 2 3) '(4 5 6)))
program-error)
(deftest mapc.error.7
(classify-error (mapc #'car '(a b c)))
type-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; mapcar
......@@ -184,6 +196,19 @@
(classify-error (locally (mapcar #'identity 1) t))
type-error)
(deftest mapcar.error.5
(classify-error (mapcar #'car '(a b c)))
type-error)
(deftest mapcar.error.6
(classify-error (mapcar #'cons '(a b c)))
program-error)
(deftest mapcar.error.7
(classify-error (mapcar #'cons '(a b c) '(1 2 3) '(4 5 6)))
program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; mapcan
......@@ -283,6 +308,18 @@
(classify-error (locally (mapcan #'identity 1) t))
type-error)
(deftest mapcan.error.5
(classify-error (mapcan #'car '(a b c)))
type-error)
(deftest mapcan.error.6
(classify-error (mapcan #'cons '(a b c)))
program-error)
(deftest mapcan.error.7
(classify-error (mapcan #'cons '(a b c) '(1 2 3) '(4 5 6)))
program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; mapl
......@@ -394,6 +431,19 @@
(classify-error (locally (mapl #'identity 1) t))
type-error)
(deftest mapl.error.5
(classify-error (mapl #'cons '(a b c)))
program-error)
(deftest mapl.error.6
(classify-error (mapl #'cons '(a b c) '(1 2 3) '(4 5 6)))
program-error)
(deftest mapl.error.7
(classify-error (mapl #'caar '(a b c)))
type-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; maplist
......@@ -512,6 +562,18 @@
(classify-error (locally (maplist #'identity 'a) t))
type-error)
(deftest maplist.error.8
(classify-error (maplist #'caar '(a b c)))
type-error)
(deftest maplist.error.9
(classify-error (maplist #'cons '(a b c)))
program-error)
(deftest maplist.error.10
(classify-error (maplist #'cons '(a b c) '(1 2 3) '(4 5 6)))
program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; mapcon
......@@ -576,3 +638,15 @@
(deftest mapcon.error.4
(classify-error (locally (mapcon #'identity 1) t))
type-error)
(deftest mapcon.error.5
(classify-error (mapcon #'caar '(a b c)))
type-error)
(deftest mapcon.error.6
(classify-error (mapcon #'cons '(a b c)))
program-error)
(deftest mapcon.error.7
(classify-error (mapcon #'cons '(a b c) '(1 2 3) '(4 5 6)))
program-error)
......@@ -298,6 +298,18 @@
(classify-error (assoc nil nil :bad t :allow-other-keys nil))
program-error)
(deftest assoc.error.7
(classify-error (assoc 'a '((a . b)) :test #'identity))
program-error)
(deftest assoc.error.8
(classify-error (assoc 'a '((a . b)) :test-not #'identity))
program-error)
(deftest assoc.error.9
(classify-error (assoc 'a '((a . b)) :key #'cons))
program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; assoc-if
......@@ -414,6 +426,23 @@
(classify-error (assoc-if #'null nil :bad t :allow-other-keys nil))
program-error)
(deftest assoc-if.error.7
(classify-error (assoc-if #'cons '((a b)(c d))))
program-error)
(deftest assoc-if.error.8
(classify-error (assoc-if #'identity '((a b)(c d)) :key #'cons))
program-error)
(deftest assoc-if.error.9
(classify-error (assoc-if #'car '((a b)(c d))))
type-error)
(deftest assoc-if.error.10
(classify-error (assoc-if #'identity '((a b)(c d)) :key #'car))
type-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; assoc-if-not
......@@ -532,6 +561,22 @@
(classify-error (assoc-if-not #'null nil :bad t :allow-other-keys nil))
program-error)
(deftest assoc-if-not.error.7
(classify-error (assoc-if-not #'cons '((a b)(c d))))
program-error)
(deftest assoc-if-not.error.8
(classify-error (assoc-if-not #'identity '((a b)(c d)) :key #'cons))
program-error)
(deftest assoc-if-not.error.9
(classify-error (assoc-if-not #'car '((a b)(c d))))
type-error)
(deftest assoc-if-not.error.10
(classify-error (assoc-if-not #'identity '((a b)(c d)) :key #'car))
type-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; copy-alist
......
......@@ -283,6 +283,18 @@
(classify-error (rassoc nil nil :bad t :allow-other-keys nil))
program-error)
(deftest rassoc.error.7
(classify-error (rassoc 'a '((b . a)(c . d)) :test #'identity))
program-error)
(deftest rassoc.error.8
(classify-error (rassoc 'a '((b . a)(c . d)) :test-not #'identity))
program-error)
(deftest rassoc.error.9
(classify-error (rassoc 'a '((b . a)(c . d)) :key #'cons))
program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; rassoc-if
......@@ -397,6 +409,22 @@
(classify-error (rassoc-if #'null nil :bad t :allow-other-keys nil))
program-error)
(deftest rassoc-if.error.7
(classify-error (rassoc-if #'cons '((a . b)(c . d))))
program-error)
(deftest rassoc-if.error.8
(classify-error (rassoc-if #'car '((a . b)(c . d))))
type-error)
(deftest rassoc-if.error.9
(classify-error (rassoc-if #'identity '((a . b)(c . d)) :key #'cons))
program-error)
(deftest rassoc-if.error.10
(classify-error (rassoc-if #'identity '((a . b)(c . d)) :key #'car))
type-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; rassoc-if-not
......@@ -513,3 +541,19 @@
(deftest rassoc-if-not.error.6
(classify-error (rassoc-if-not #'null nil :bad t :allow-other-keys nil))
program-error)
(deftest rassoc-if-not.error.7
(classify-error (rassoc-if-not #'cons '((a . b)(c . d))))
program-error)
(deftest rassoc-if-not.error.8
(classify-error (rassoc-if-not #'car '((a . b)(c . d))))
type-error)
(deftest rassoc-if-not.error.9
(classify-error (rassoc-if-not #'identity '((a . b)(c . d)) :key #'cons))
program-error)
(deftest rassoc-if-not.error.10
(classify-error (rassoc-if-not #'identity '((a . b)(c . d)) :key #'car))
type-error)
......@@ -372,6 +372,22 @@
(classify-error (intersection nil nil :bad t :allow-other-keys nil))
program-error)
(deftest intersection.error.7
(classify-error (intersection '(a b c) '(d e f) :test #'identity))
program-error)
(deftest intersection.error.8
(classify-error (intersection '(a b c) '(d e f) :test-not #'identity))
program-error)
(deftest intersection.error.9
(classify-error (intersection '(a b c) '(d e f) :key #'cons))
program-error)
(deftest intersection.error.10
(classify-error (intersection '(a b c) '(d e f) :key #'car))
type-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; nintersection
......@@ -704,3 +720,19 @@
(deftest nintersection.error.6
(classify-error (nintersection nil nil :bad t :allow-other-keys nil))
program-error)
(deftest nintersection.error.7
(classify-error (nintersection (list 1 2 3) (list 4 5 6) :test #'identity))
program-error)
(deftest nintersection.error.8
(classify-error (nintersection (list 1 2 3) (list 4 5 6) :test-not #'identity))
program-error)
(deftest nintersection.error.9
(classify-error (nintersection (list 1 2 3) (list 4 5 6) :key #'cons))
program-error)
(deftest nintersection.error.10
(classify-error (nintersection (list 1 2 3) (list 4 5 6) :key #'car))
type-error)
......@@ -384,3 +384,21 @@
(deftest union.error.6
(classify-error (union nil nil :bad t :allow-other-keys nil))
program-error)
(deftest union.error.7
(classify-error (union (list 1 2) (list 3 4) :test #'identity))
program-error)
(deftest union.error.8
(classify-error (union (list 1 2) (list 3 4) :test-not #'identity))
program-error)
(deftest union.error.9
(classify-error (union (list 1 2) (list 3 4) :key #'cons))
program-error)
(deftest union.error.10
(classify-error (union (list 1 2) (list 3 4) :key #'car))
type-error)
......@@ -383,3 +383,20 @@
(deftest nunion.error.6
(classify-error (nunion nil nil :bad t :allow-other-keys nil))
program-error)
(deftest nunion.error.7
(classify-error (nunion (list 1 2) (list 3 4) :test #'identity))
program-error)
(deftest nunion.error.8
(classify-error (nunion (list 1 2) (list 3 4) :test-not #'identity))
program-error)
(deftest nunion.error.9
(classify-error (nunion (list 1 2) (list 3 4) :key #'cons))
program-error)
(deftest nunion.error.10
(classify-error (nunion (list 1 2) (list 3 4) :key #'car))
type-error)
......@@ -294,6 +294,23 @@
(classify-error (set-difference nil nil :bad t :allow-other-keys nil))
program-error)
(deftest set-difference.error.7
(classify-error (set-difference (list 1 2) (list 3 4) :test #'identity))
program-error)
(deftest set-difference.error.8
(classify-error (set-difference (list 1 2) (list 3 4) :test-not #'identity))
program-error)
(deftest set-difference.error.9
(classify-error (set-difference (list 1 2) (list 3 4) :key #'cons))
program-error)
(deftest set-difference.error.10
(classify-error (set-difference (list 1 2) (list 3 4) :key #'car))
type-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; nset-difference
......@@ -578,3 +595,19 @@
(deftest nset-difference.error.6
(classify-error (nset-difference nil nil :bad t :allow-other-keys nil))
program-error)
(deftest nset-difference.error.7
(classify-error (nset-difference (list 1 2) (list 3 4) :test #'identity))
program-error)
(deftest nset-difference.error.8
(classify-error (nset-difference (list 1 2) (list 3 4) :test-not #'identity))
program-error)
(deftest nset-difference.error.9
(classify-error (nset-difference (list 1 2) (list 3 4) :key #'cons))
program-error)
(deftest nset-difference.error.10
(classify-error (nset-difference (list 1 2) (list 3 4) :key #'car))
type-error)
......@@ -331,6 +331,23 @@
(classify-error (set-exclusive-or nil nil :bad t :allow-other-keys nil))
program-error)
(deftest set-exclusive-or.error.7
(classify-error (set-exclusive-or (list 1 2) (list 3 4) :test #'identity))
program-error)
(deftest set-exclusive-or.error.8
(classify-error (set-exclusive-or (list 1 2) (list 3 4) :test-not #'identity))
program-error)
(deftest set-exclusive-or.error.9
(classify-error (set-exclusive-or (list 1 2) (list 3 4) :key #'cons))
program-error)
(deftest set-exclusive-or.error.10
(classify-error (set-exclusive-or (list 1 2) (list 3 4) :key #'car))
type-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; nset-exclusive-or
......@@ -657,3 +674,20 @@
(deftest nset-exclusive-or.error.6
(classify-error (nset-exclusive-or nil nil :bad t :allow-other-keys nil))
program-error)
(deftest nset-exclusive-or.error.7
(classify-error (nset-exclusive-or (list 1 2) (list 3 4) :test #'identity))
program-error)
(deftest nset-exclusive-or.error.8
(classify-error (nset-exclusive-or (list 1 2) (list 3 4) :test-not #'identity))
program-error)
(deftest nset-exclusive-or.error.9
(classify-error (nset-exclusive-or (list 1 2) (list 3 4) :key #'cons))
program-error)
(deftest nset-exclusive-or.error.10
(classify-error (nset-exclusive-or (list 1 2) (list 3 4) :key #'car))
type-error)
......@@ -232,3 +232,19 @@
(deftest subsetp.error.6
(classify-error (subsetp nil nil :bad t :allow-other-keys nil))
program-error)
(deftest subsetp.error.7
(classify-error (subsetp (list 1 2) (list 3 4) :test #'identity))
program-error)
(deftest subsetp.error.8
(classify-error (subsetp (list 1 2) (list 3 4) :test-not #'identity))
program-error)
(deftest subsetp.error.9
(classify-error (subsetp (list 1 2) (list 3 4) :key #'cons))
program-error)
(deftest subsetp.error.10
(classify-error (subsetp (list 1 2) (list 3 4) :key #'car))
type-error)
\ No newline at end of file
......@@ -522,3 +522,19 @@
(deftest count-if-not.error.11
(classify-error (locally (count-if-not #'identity 1) t))
type-error)
(deftest count-if-not.error.12
(classify-error (count-if-not #'cons '(a b c)))
program-error)
(deftest count-if-not.error.13
(classify-error (count-if-not #'car '(a b c)))
type-error)
(deftest count-if-not.error.14
(classify-error (count-if-not #'identity '(a b c) :key #'cdr))
type-error)
(deftest count-if-not.error.15
(classify-error (count-if-not #'identity '(a b c) :key #'cons))
program-error)
......@@ -521,3 +521,21 @@
(deftest count-if.error.11
(classify-error (locally (count-if #'identity 1) t))
type-error)
(deftest count-if.error.12
(classify-error (count-if #'cons '(a b c)))
program-error)
(deftest count-if.error.13
(classify-error (count-if #'car '(a b c)))
type-error)
(deftest count-if.error.14
(classify-error (count-if #'identity '(a b c) :key #'cdr))
type-error)
(deftest count-if.error.15
(classify-error (count-if #'identity '(a b c) :key #'cons))
program-error)
......@@ -592,3 +592,18 @@
(classify-error (locally (count 'a 1) t))
type-error)
(deftest count.error.12
(classify-error (count 'b '(a b c) :test #'identity))
program-error)
(deftest count.error.13
(classify-error (count 'b '(a b c) :key #'car))
type-error)
(deftest count.error.14
(classify-error (count 'b '(a b c) :test-not #'identity))
program-error)
(deftest count.error.15
(classify-error (count 'b '(a b c) :key #'cons))
program-error)
......@@ -136,3 +136,15 @@
(deftest every.error.10
(classify-error (locally (every 1 '(a b c)) t))