Skip to content
Snippets Groups Projects
Commit e0725c20 authored by pfdietz's avatar pfdietz
Browse files

Indentation/style changes. Tests for empty implicit PROGNs in case, ccase,...

Indentation/style changes.  Tests for empty implicit PROGNs in case, ccase, ecase.  Added some tests of argument evaluation order to many function calls.
parent 0f52a92a
No related branches found
No related tags found
No related merge requests found
Showing
with 350 additions and 16 deletions
......@@ -42,3 +42,13 @@
(deftest apply.5
(apply 'cons '(a b))
(a . b))
(deftest apply.6
(let ((x 0) y z)
(values
(apply (progn (setf y (incf x))
#'identity)
(progn (setf z (incf x))
(list 'a)))
x y z))
a 2 1 2)
......@@ -132,6 +132,18 @@
(array-in-bounds-p #(a b c) -1000000000000000000)
nil)
;;; Order of evaluation tests
(deftest array-in-bounds-p.24
(let ((x 0) y z)
(values
(array-in-bounds-p (progn (setf y (incf x))
#())
(progn (setf z (incf x))
10))
x y z))
nil 2 1 2)
;;; Error tests
(deftest array-in-bounds-p.error.1
......
......@@ -22,6 +22,16 @@
collect (array-row-major-index a i)))
(0 1 2 3 4))
(deftest array-row-major-index.4
(let ((x 0) y z
(a #(a b c d e f)))
(values
(array-row-major-index
(progn (setf y (incf x)) a)
(progn (setf z (incf x)) 0))
x y z))
0 2 1 2)
;;; Error tests
(deftest array-row-major-index.error.1
......
......@@ -24,7 +24,7 @@
(deftest bit-and.3
(let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
(s2 (make-array nil :initial-element 1 :element-type 'bit)))
(values(bit-and s1 s2) s1 s2))
(values (bit-and s1 s2) s1 s2))
#0a0
#0a0
#0a1)
......@@ -218,6 +218,16 @@
#2a((0 0)(1 1))
#2a((0 0)(0 1)))
(deftest bit-and.20
(let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit))
(s2 (make-array 1 :initial-element 0 :element-type 'bit))
(x 0) y z)
(values
(bit-and (progn (setf y (incf x)) s1)
(progn (setf z (incf x)) s2))
x y z))
#*0 2 1 2)
;;; Error tests
(deftest bit-and.error.1
......
......@@ -24,7 +24,7 @@
(deftest bit-andc1.3
(let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
(s2 (make-array nil :initial-element 1 :element-type 'bit)))
(values(bit-andc1 s1 s2) s1 s2))
(values (bit-andc1 s1 s2) s1 s2))
#0a1
#0a0
#0a1)
......@@ -218,6 +218,16 @@
#2a((0 0)(1 1))
#2a((0 0)(1 0)))
(deftest bit-andc1.20
(let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit))
(s2 (make-array 1 :initial-element 0 :element-type 'bit))
(x 0) y z)
(values
(bit-andc1 (progn (setf y (incf x)) s1)
(progn (setf z (incf x)) s2))
x y z))
#*0 2 1 2)
;;; Error tests
(deftest bit-andc1.error.1
......
......@@ -24,7 +24,7 @@
(deftest bit-andc2.3
(let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
(s2 (make-array nil :initial-element 1 :element-type 'bit)))
(values(bit-andc2 s1 s2) s1 s2))
(values (bit-andc2 s1 s2) s1 s2))
#0a0
#0a0
#0a1)
......@@ -218,6 +218,16 @@
#2a((0 0)(1 1))
#2a((0 1)(0 0)))
(deftest bit-andc2.20
(let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit))
(s2 (make-array 1 :initial-element 0 :element-type 'bit))
(x 0) y z)
(values
(bit-andc2 (progn (setf y (incf x)) s1)
(progn (setf z (incf x)) s2))
x y z))
#*0 2 1 2)
;;; Error tests
(deftest bit-andc2.error.1
......
......@@ -25,7 +25,7 @@
(deftest bit-eqv.3
(let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
(s2 (make-array nil :initial-element 1 :element-type 'bit)))
(values(bit-eqv s1 s2) s1 s2))
(values (bit-eqv s1 s2) s1 s2))
#0a0
#0a0
#0a1)
......@@ -219,6 +219,16 @@
#2a((0 0)(1 1))
#2a((1 0)(0 1)))
(deftest bit-eqv.20
(let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit))
(s2 (make-array 1 :initial-element 0 :element-type 'bit))
(x 0) y z)
(values
(bit-eqv (progn (setf y (incf x)) s1)
(progn (setf z (incf x)) s2))
x y z))
#*1 2 1 2)
;;; Error tests
(deftest bit-eqv.error.1
......
......@@ -24,7 +24,7 @@
(deftest bit-ior.3
(let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
(s2 (make-array nil :initial-element 1 :element-type 'bit)))
(values(bit-ior s1 s2) s1 s2))
(values (bit-ior s1 s2) s1 s2))
#0a1
#0a0
#0a1)
......@@ -218,6 +218,16 @@
#2a((0 0)(1 1))
#2a((0 1)(1 1)))
(deftest bit-ior.20
(let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit))
(s2 (make-array 1 :initial-element 0 :element-type 'bit))
(x 0) y z)
(values
(bit-ior (progn (setf y (incf x)) s1)
(progn (setf z (incf x)) s2))
x y z))
#*0 2 1 2)
;;; Error tests
(deftest bit-ior.error.1
......
......@@ -24,7 +24,7 @@
(deftest bit-nand.3
(let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
(s2 (make-array nil :initial-element 1 :element-type 'bit)))
(values(bit-nand s1 s2) s1 s2))
(values (bit-nand s1 s2) s1 s2))
#0a1
#0a0
#0a1)
......@@ -218,6 +218,16 @@
#2a((0 0)(1 1))
#2a((1 1)(1 0)))
(deftest bit-nand.20
(let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit))
(s2 (make-array 1 :initial-element 0 :element-type 'bit))
(x 0) y z)
(values
(bit-nand (progn (setf y (incf x)) s1)
(progn (setf z (incf x)) s2))
x y z))
#*1 2 1 2)
;;; Error tests
(deftest bit-nand.error.1
......
......@@ -24,7 +24,7 @@
(deftest bit-nor.3
(let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
(s2 (make-array nil :initial-element 1 :element-type 'bit)))
(values(bit-nor s1 s2) s1 s2))
(values (bit-nor s1 s2) s1 s2))
#0a0
#0a0
#0a1)
......@@ -218,6 +218,16 @@
#2a((0 0)(1 1))
#2a((1 0)(0 0)))
(deftest bit-nor.20
(let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit))
(s2 (make-array 1 :initial-element 0 :element-type 'bit))
(x 0) y z)
(values
(bit-nor (progn (setf y (incf x)) s1)
(progn (setf z (incf x)) s2))
x y z))
#*1 2 1 2)
;;; Error tests
(deftest bit-nor.error.1
......
......@@ -24,7 +24,7 @@
(deftest bit-orc1.3
(let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
(s2 (make-array nil :initial-element 1 :element-type 'bit)))
(values(bit-orc1 s1 s2) s1 s2))
(values (bit-orc1 s1 s2) s1 s2))
#0a1
#0a0
#0a1)
......@@ -218,6 +218,16 @@
#2a((0 0)(1 1))
#2a((1 0)(1 1)))
(deftest bit-orc1.20
(let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit))
(s2 (make-array 1 :initial-element 0 :element-type 'bit))
(x 0) y z)
(values
(bit-orc1 (progn (setf y (incf x)) s1)
(progn (setf z (incf x)) s2))
x y z))
#*1 2 1 2)
;;; Error tests
(deftest bit-orc1.error.1
......
......@@ -24,7 +24,7 @@
(deftest bit-orc2.3
(let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
(s2 (make-array nil :initial-element 1 :element-type 'bit)))
(values(bit-orc2 s1 s2) s1 s2))
(values (bit-orc2 s1 s2) s1 s2))
#0a0
#0a0
#0a1)
......@@ -218,6 +218,16 @@
#2a((0 0)(1 1))
#2a((1 1)(0 1)))
(deftest bit-orc2.20
(let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit))
(s2 (make-array 1 :initial-element 0 :element-type 'bit))
(x 0) y z)
(values
(bit-orc2 (progn (setf y (incf x)) s1)
(progn (setf z (incf x)) s2))
x y z))
#*1 2 1 2)
;;; Error tests
(deftest bit-orc2.error.1
......
......@@ -24,7 +24,7 @@
(deftest bit-xor.3
(let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
(s2 (make-array nil :initial-element 1 :element-type 'bit)))
(values(bit-xor s1 s2) s1 s2))
(values (bit-xor s1 s2) s1 s2))
#0a1
#0a0
#0a1)
......@@ -218,6 +218,16 @@
#2a((0 0)(1 1))
#2a((0 1)(1 0)))
(deftest bit-xor.20
(let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit))
(s2 (make-array 1 :initial-element 0 :element-type 'bit))
(x 0) y z)
(values
(bit-xor (progn (setf y (incf x)) s1)
(progn (setf z (incf x)) s2))
x y z))
#*0 2 1 2)
;;; Error tests
(deftest bit-xor.error.1
......
......@@ -108,3 +108,26 @@
(1 0 0 1 1 0 0 0 1 1)
(1 0 0 1 1 0 0 0 1 1)
(1 0 0 1 1 0 0 0 1 1))
;;; Order of evaluation tests
(deftest bit.9
(let ((x 0) y z
(b (copy-seq #*01010)))
(values
(bit (progn (setf y (incf x)) b)
(progn (setf z (incf x)) 1))
x y z))
1 2 1 2)
(deftest bit.10
(let ((x 0) y z w
(b (copy-seq #*01010)))
(values
(setf (bit (progn (setf y (incf x)) b)
(progn (setf z (incf x)) 1))
(progn (setf w (incf x)) 0))
b
x y z w))
0 #*00010 3 1 2 3)
......@@ -153,3 +153,16 @@
(deftest case.31
(case (values 'b 'c) (c 0) ((a b) 10) (t 20))
10)
(deftest case.32
(case 'a (a) (t 'b))
nil)
(deftest case.33
(case 'a (b 'b) (t))
nil)
(deftest case.34
(case 'a (b 'b) (otherwise))
nil)
......@@ -166,5 +166,9 @@
x))
y b)
(deftest ccase.30
(ccase 'a (a))
nil)
;;; Need to add tests for continuability of the error,
;;; and resetting of the place.
......@@ -35,6 +35,15 @@
#'(lambda (c1 c2) (not (char= c1 c2))))
t)
(deftest char=.5
(let ((i 0) a b c)
(values
(char= (progn (setq a (incf i)) #\a)
(progn (setq b (incf i)) #\a)
(progn (setq c (incf i)) #\b))
i a b c))
nil 3 1 2 3)
(deftest char/=.1
(is-ordered-by +code-chars+ #'char/=)
t)
......@@ -52,6 +61,15 @@
(is-ordered-by +rev-code-chars+ #'char/=)
t)
(deftest char/=.5
(let ((i 0) a b c)
(values
(char/= (progn (setq a (incf i)) #\a)
(progn (setq b (incf i)) #\b)
(progn (setq c (incf i)) #\b))
i a b c))
nil 3 1 2 3)
(deftest char<=.1
(loop for c across +code-chars+
always (char<= c c))
......@@ -85,6 +103,15 @@
(notnot-mv (or (char<= #\9 #\a) (char<= #\z #\0)))
t)
(deftest char<=.9
(let ((i 0) a b c)
(values
(char<= (progn (setq a (incf i)) #\a)
(progn (setq b (incf i)) #\b)
(progn (setq c (incf i)) #\a))
i a b c))
nil 3 1 2 3)
(deftest char<.1
(loop for c across +code-chars+
never (char< c c))
......@@ -118,6 +145,14 @@
(notnot-mv (or (char< #\9 #\a) (char< #\z #\0)))
t)
(deftest char<.9
(let ((i 0) a b c)
(values
(char< (progn (setq a (incf i)) #\a)
(progn (setq b (incf i)) #\b)
(progn (setq c (incf i)) #\a))
i a b c))
nil 3 1 2 3)
(deftest char>=.1
(loop for c across +code-chars+
......@@ -152,6 +187,15 @@
(notnot-mv (or (char>= #\a #\9) (char>= #\0 #\z)))
t)
(deftest char>=.9
(let ((i 0) a b c)
(values
(char>= (progn (setq a (incf i)) #\b)
(progn (setq b (incf i)) #\a)
(progn (setq c (incf i)) #\b))
i a b c))
nil 3 1 2 3)
(deftest char>.1
(loop for c across +code-chars+
never (char> c c))
......@@ -185,6 +229,15 @@
(notnot-mv (or (char> #\a #\9) (char> #\0 #\z)))
t)
(deftest char>.9
(let ((i 0) a b c)
(values
(char> (progn (setq a (incf i)) #\b)
(progn (setq b (incf i)) #\a)
(progn (setq c (incf i)) #\b))
i a b c))
nil 3 1 2 3)
;;; Case-insensitive comparisons
(deftest char-equal.1
......@@ -213,6 +266,15 @@
(not (char-equal c1 c2)))))
t)
(deftest char-equal.5
(let ((i 0) a b c)
(values
(char-equal (progn (setq a (incf i)) #\a)
(progn (setq b (incf i)) #\a)
(progn (setq c (incf i)) #\b))
i a b c))
nil 3 1 2 3)
(deftest char-not-equal.1
(is-ordered-by +code-chars+ #'(lambda (c1 c2)
(or (char= (char-downcase c1)
......@@ -236,6 +298,15 @@
(char-not-equal c1 c2))))
t)
(deftest char-not-equal.5
(let ((i 0) a b c)
(values
(char-not-equal (progn (setq a (incf i)) #\a)
(progn (setq b (incf i)) #\b)
(progn (setq c (incf i)) #\b))
i a b c))
nil 3 1 2 3)
(deftest char-not-greaterp.1
(loop for c across +code-chars+
always (char-not-greaterp c c))
......@@ -269,6 +340,15 @@
(notnot-mv (or (char-not-greaterp #\9 #\a) (char-not-greaterp #\z #\0)))
t)
(deftest char-not-greaterp.9
(let ((i 0) a b c)
(values
(char-not-greaterp (progn (setq a (incf i)) #\a)
(progn (setq b (incf i)) #\b)
(progn (setq c (incf i)) #\a))
i a b c))
nil 3 1 2 3)
(deftest char-lessp.1
(loop for c across +code-chars+
never (char-lessp c c))
......@@ -302,6 +382,15 @@
(notnot-mv (or (char-lessp #\9 #\a) (char-lessp #\z #\0)))
t)
(deftest char-lessp.9
(let ((i 0) a b c)
(values
(char-lessp (progn (setq a (incf i)) #\a)
(progn (setq b (incf i)) #\b)
(progn (setq c (incf i)) #\a))
i a b c))
nil 3 1 2 3)
(deftest char-not-lessp.1
(loop for c across +code-chars+
always (char-not-lessp c c))
......@@ -336,6 +425,15 @@
(notnot-mv (or (char-not-lessp #\a #\9) (char-not-lessp #\0 #\z)))
t)
(deftest char-not-lessp.9
(let ((i 0) a b c)
(values
(char-not-lessp (progn (setq a (incf i)) #\b)
(progn (setq b (incf i)) #\a)
(progn (setq c (incf i)) #\b))
i a b c))
nil 3 1 2 3)
(deftest char-greaterp.1
(loop for c across +code-chars+
never (char-greaterp c c))
......@@ -369,3 +467,12 @@
(deftest char-greaterp.8
(notnot-mv (or (char-greaterp #\a #\9) (char-greaterp #\0 #\z)))
t)
(deftest char-greaterp.9
(let ((i 0) a b c)
(values
(char-greaterp (progn (setq a (incf i)) #\b)
(progn (setq b (incf i)) #\a)
(progn (setq c (incf i)) #\b))
i a b c))
nil 3 1 2 3)
......@@ -78,6 +78,24 @@
s)
"aaaXa")
(deftest char.11
(let ((i 0) a b)
(values
(char (progn (setf a (incf i)) "abc")
(progn (setf b (incf i)) 1))
i a b))
#\b 2 1 2)
(deftest char.12
(let ((i 0) a b c (s (make-string 5 :initial-element #\z)))
(values
(setf
(char (progn (setf a (incf i)) s)
(progn (setf b (incf i)) 1))
(progn (setf c (incf i)) #\a))
s i a b c))
#\a "zazzz" 3 1 2 3)
;;; Tests of schar
(deftest schar.1
......@@ -126,3 +144,21 @@
(setf (schar s 2) #\X)
s)
"xxXxxx")
(deftest schar.11
(let ((i 0) a b)
(values
(schar (progn (setf a (incf i)) "abc")
(progn (setf b (incf i)) 1))
i a b))
#\b 2 1 2)
(deftest schar.12
(let ((i 0) a b c (s (copy-seq "zzzzz")))
(values
(setf
(schar (progn (setf a (incf i)) s)
(progn (setf b (incf i)) 1))
(progn (setf c (incf i)) #\a))
s i a b c))
#\a "zazzz" 3 1 2 3)
......@@ -1205,7 +1205,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; copy-symbol
(deftest copy-symbol-1
(deftest copy-symbol.1
(notnot-mv
(every
#'(lambda (x)
......@@ -1221,7 +1221,7 @@
'(nil t a b |a| |123|)))
t)
(deftest copy-symbol-2
(deftest copy-symbol.2
(progn
(setf (symbol-plist '|foo|) '(a b c d))
(makunbound '|foo|)
......@@ -1242,7 +1242,7 @@
'(nil t a b |foo| |a| |123|))))
t)
(deftest copy-symbol-3
(deftest copy-symbol.3
(progn
(setf (symbol-plist '|foo|) '(a b c d))
(setf (symbol-value '|a|) 12345)
......@@ -1269,15 +1269,26 @@
'(nil t a b |foo| |a| |123|))))
t)
(deftest copy-symbol-4
(deftest copy-symbol.4
(eqt (copy-symbol 'a) (copy-symbol 'a))
nil)
(deftest copy-symbol-5
(deftest copy-symbol.5
(let ((i 0) x y (s '#:|x|))
(let ((s2 (copy-symbol
(progn (setf x (incf i)) s)
(progn (setf y (incf i)) nil))))
(values
(symbol-name s2)
(eq s s2)
i x y)))
"x" nil 2 1 2)
(deftest copy-symbol.error.1
(classify-error (copy-symbol))
program-error)
(deftest copy-symbol-6
(deftest copy-symbol.error.2
(classify-error (copy-symbol 'a t 'foo))
program-error)
......
......@@ -130,6 +130,14 @@
(funcall (coerce '(lambda () 10) 'function))
10)
(deftest coerce.23
(let ((i 0) a b)
(values
(coerce (progn (setf a (incf i)) 10)
(progn (setf b (incf i)) 'single-float))
i a b))
10.0f0 2 1 2)
;;; Error tests
;;; (deftest coerce.error.1
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment