Commit 443737cd authored by pfdietz's avatar pfdietz

Tests updates due to feedback from Martin Simmons.

  Added more error tests for assoc/assoc-if/assoc-if-not.
  Annotated standardized package nickname tests.
  Removed test that assumed REPEAT loop clause could appear
   later in the loop (too many complaints about this, and the standard
   is inconsistent.)
  Added tests for LOOP ... SUM into various types.  I didn't add
   some COMPLEX tests here that were suggested, since I didn't think
   they were correct.  I am really not liking the (complex rat 0) ==> rat
   rule of CL complex numbers.
  Changed "RT" to "REGRESSION-TEST" in a test in packages-03.lsp.
  Fixed error report in random remove test so it works better with delete.
  Changed :metaclass in substandard-generic-function (I am still not
   entirely convinced this is correct.)
parent c3c3bca0
......@@ -140,3 +140,10 @@
(classify-error (assoc-if-not #'identity '((a . b) . c)))
type-error)
(deftest assoc-if-not.error.12
(classify-error (assoc-if-not #'identity ((a . b) :bad (c . d))))
type-error)
(deftest assoc-if-not.error.13
(classify-error (assoc-if-not #'identity 'y))
type-error)
......@@ -138,3 +138,11 @@
(deftest assoc-if.error.11
(classify-error (assoc-if #'null '((a . b) . c)))
type-error)
(deftest assoc-if.error.12
(classify-error (assoc-if #'null ((a . b) :bad (c . d))))
type-error)
(deftest assoc-if.error.13
(classify-error (assoc-if #'null 'y))
type-error)
......@@ -268,3 +268,10 @@
(classify-error (assoc 'z '((a . b) . c)))
type-error)
(deftest assoc.error.11
(classify-error (assoc 'z '((a . b) :bad (c . d))))
type-error)
(deftest assoc.error.12
(classify-error (assoc 'x 'y))
type-error)
......@@ -1174,7 +1174,9 @@
file-length
file-namestring
file-position
file-string-length
file-write-date
fill
find
find-all-symbols
find-if
......@@ -1387,6 +1389,7 @@
probe-file
proclaim
provide
random
random-state-p
rassoc
rassoc-if
......
......@@ -994,14 +994,17 @@
;;; Standardized packages have the right names, nicknames
(deftest keyword-package-nicknames
:notes :standardized-package-nicknames
(package-nicknames (find-package "KEYWORD"))
nil)
(deftest common-lisp-package-nicknames
:notes :standardized-package-nicknames
(package-nicknames (find-package "COMMON-LISP"))
("CL"))
(deftest common-lisp-user-package-nicknames
:notes :standardized-package-nicknames
(package-nicknames (find-package "COMMON-LISP-USER"))
("CL-USER"))
......
......@@ -763,9 +763,12 @@
nil a nil a a)
;;; I'm not sure this one is proper
;;; Added :metaclass at prompting of Martin Simmons
(when (subtypep (class-of (find-class 'standard-generic-function))
'standard-class)
(defclass substandard-generic-function (standard-generic-function) ())
(defclass substandard-generic-function (standard-generic-function) ()
(:metaclass #.(class-name (class-of
(find-class 'standard-generic-function)))))
(deftest defgeneric.30
(let ((fn
(eval '(defgeneric defgeneric.fun.29 (x)
......
......@@ -448,3 +448,47 @@
(deftest loop.10.93
(loop for i from 1 to 4 summing (return 100))
100)
(deftest loop.10.94
(loop for i in nil sum i of-type integer)
0)
(deftest loop.10.95
(loop for i in nil sum i of-type fixnum)
0)
(deftest loop.10.96
(loop for i in nil sum i of-type bit)
0)
(deftest loop.10.97
(loop for i in nil sum i of-type (integer 0 100))
0)
(deftest loop.10.98
(loop for i in nil sum i of-type (integer -100 0))
0)
(deftest loop.10.99
(loop for i in nil sum i of-type (integer -100 100))
0)
(deftest loop.10.100
(loop for i in nil sum i of-type (and integer (real -100.0 100.0)))
0)
(deftest loop.10.101
(loop for i in nil sum i of-type short-float)
0.0s0)
(deftest loop.10.102
(loop for i in nil sum i of-type single-float)
0.0f0)
(deftest loop.10.103
(loop for i in nil sum i of-type double-float)
0.0d0)
(deftest loop.10.104
(loop for i in nil sum i of-type long-float)
0.0l0)
......@@ -53,9 +53,13 @@
(loop repeat 3 for i in '(a b c d e) collect i)
(a b c))
(deftest loop.11.9
(loop for i in '(a b c d e) collect i repeat 3)
(a b c))
;;; Enough implementors have complained about this test that
;;; I'm removing it. The standard is self-contradictory
;;; on whether REPEAT can occur later in a LOOP form.
;;; (deftest loop.11.9
;;; (loop for i in '(a b c d e) collect i repeat 3)
;;; (a b c))
;;; Tests of WHILE
......
......@@ -14,4 +14,5 @@
(defnote :nil-vectors-are-strings
"Assume that (VECTOR NIL) objects are strings.")
(defnote :standardized-package-nicknames
"The standardized package nicknames specified in section 11 of ANSI CL are exclusive (disputed).")
......@@ -21,7 +21,7 @@
(find-package "CL-USER")
(find-package "KEYWORD")
(find-package "A")
(find-package "RT")
(find-package "REGRESSION-TEST")
(find-package "CL-TEST")
(find-package "B"))
(list-all-packages))
......
......@@ -216,7 +216,7 @@
(seq2 (copy-seq seq))
(seq1r (apply (the function tested-fn) element seq1 arg-list))
(seq2r (apply (the function check-fn) element seq2 arg-list)))
(setq *remove-fail-args* (list* element seq1 arg-list))
(setq *remove-fail-args* (list* element seq arg-list))
(cond
((and pure (not (equalp seq seq1))) :fail1)
((and pure (not (equalp seq seq2))) :fail2)
......
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