From 8bedc5b0abc9e9a693edea7b48d069cbe2071f9b Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Mon, 23 Jan 2006 02:55:21 +0000 Subject: [PATCH] Begin adding (compiler) macro expansion tests for builtin functions. Add tests for arithmetic-error and its accessors. Add separate files for array-element-type, array-has-fill-pointer-p. --- ansi-tests/abs.lsp | 5 + ansi-tests/acons.lsp | 12 ++ ansi-tests/acos.lsp | 4 + ansi-tests/acosh.lsp | 4 + ansi-tests/adjoin.lsp | 26 +++++ ansi-tests/adjust-array.lsp | 110 ++++++++++++++++++ ansi-tests/adjustable-array-p.lsp | 6 + ansi-tests/append.lsp | 17 +++ ansi-tests/apply.lsp | 15 +++ ansi-tests/apropos-list.lsp | 16 +++ ansi-tests/apropos.lsp | 21 ++++ ansi-tests/arithmetic-error.lsp | 68 ++++++++++++ ansi-tests/array-dimension.lsp | 11 ++ ansi-tests/array-dimensions.lsp | 5 + ansi-tests/array-displacement.lsp | 14 +++ ansi-tests/array-element-type.lsp | 39 +++++++ ansi-tests/array-has-fill-pointer-p.lsp | 56 ++++++++++ ansi-tests/array-in-bounds-p.lsp | 11 ++ ansi-tests/array-rank.lsp | 4 + ansi-tests/array-row-major-index.lsp | 12 ++ ansi-tests/array-total-size.lsp | 5 + ansi-tests/arrayp.lsp | 4 + ansi-tests/ash.lsp | 8 ++ ansi-tests/asin.lsp | 4 + ansi-tests/asinh.lsp | 4 + ansi-tests/assoc-if-not.lsp | 39 +++++-- ansi-tests/character.lsp | 8 ++ ansi-tests/divide.lsp | 11 ++ ansi-tests/load-arrays.lsp | 1 + ansi-tests/load-numbers.lsp | 3 + ansi-tests/minus.lsp | 19 ++++ ansi-tests/number-comparison.lsp | 142 +++++++++++++++++++++--- ansi-tests/oneminus.lsp | 4 + ansi-tests/oneplus.lsp | 4 + ansi-tests/plus.lsp | 13 +++ ansi-tests/times.lsp | 13 +++ 36 files changed, 716 insertions(+), 22 deletions(-) create mode 100644 ansi-tests/arithmetic-error.lsp create mode 100644 ansi-tests/array-element-type.lsp create mode 100644 ansi-tests/array-has-fill-pointer-p.lsp diff --git a/ansi-tests/abs.lsp b/ansi-tests/abs.lsp index 2b8280a9..dcbcf20b 100644 --- a/ansi-tests/abs.lsp +++ b/ansi-tests/abs.lsp @@ -172,3 +172,8 @@ (deftest abs.21 (abs #c(-3.0l0 4.0l0)) 5.0l0) + +(deftest abs.22 + (macrolet ((%m (z) z)) + (abs (expand-in-current-env (%m -4)))) + 4) diff --git a/ansi-tests/acons.lsp b/ansi-tests/acons.lsp index e97c9f6b..7e563878 100644 --- a/ansi-tests/acons.lsp +++ b/ansi-tests/acons.lsp @@ -37,6 +37,18 @@ (acons #\R :foo :bar) ((#\R . :foo) . :bar)) +(deftest acons.7 + (macrolet ((%m (z) z)) (acons (expand-in-current-env (%m 'a)) 'b '(c))) + ((a . b) c)) + +(deftest acons.8 + (macrolet ((%m (z) z)) (acons 'a (expand-in-current-env (%m 'b)) '(c))) + ((a . b) c)) + +(deftest acons.9 + (macrolet ((%m (z) z)) (acons 'a 'b (expand-in-current-env (%m '(c))))) + ((a . b) c)) + (deftest acons.order.1 (let ((i 0) x y z) (values diff --git a/ansi-tests/acos.lsp b/ansi-tests/acos.lsp index b8f2bc2d..829478e3 100644 --- a/ansi-tests/acos.lsp +++ b/ansi-tests/acos.lsp @@ -78,6 +78,10 @@ collect type) nil) +(deftest acos.9 + (macrolet ((%m (z) z)) (not (not (> (acos (expand-in-current-env (%m 0))) 0)))) + t) + ;;; FIXME ;;; Add accuracy tests diff --git a/ansi-tests/acosh.lsp b/ansi-tests/acosh.lsp index 2af7791c..058bf21e 100644 --- a/ansi-tests/acosh.lsp +++ b/ansi-tests/acosh.lsp @@ -68,6 +68,10 @@ collect (list x1 x2 rlist))) nil) +(deftest acosh.7 + (macrolet ((%m (z) z)) (not (not (complexp (acosh (expand-in-current-env (%m 0))))))) + t) + ;;; FIXME ;;; Add accuracy tests here diff --git a/ansi-tests/adjoin.lsp b/ansi-tests/adjoin.lsp index 18c3e77a..abc61c49 100644 --- a/ansi-tests/adjoin.lsp +++ b/ansi-tests/adjoin.lsp @@ -104,6 +104,32 @@ (adjoin 10 '(1 2 3) :test-not #'<) (1 2 3)) +;;; Test that :key satisfies the description in 17.2.1 +;;; This contradicts other parts of the spec, particularly +;;; PUSHNEW, so the test is commented out. +;;; (deftest adjoin.23 +;;; (adjoin 1 '(1 2 3) :key '1+) +;;; (1 1 2 3)) + +(deftest adjoin.24 + (macrolet ((%m (z) z)) + (values + (adjoin (expand-in-current-env (%m 'a)) '(b c)) + (adjoin 'a (expand-in-current-env (%m '(b c)))) + (adjoin 'a '(b c) (expand-in-current-env (%m :test)) 'eql) + (adjoin 'a '(a a) (expand-in-current-env (%m :test-not)) 'eql) + (adjoin 'a '(b c) :test (expand-in-current-env (%m 'eql))) + (adjoin 'a '(b c) :test (expand-in-current-env (%m #'eql))) + (adjoin 1 '(1 2 3) :key (expand-in-current-env (%m 'identity))) + )) + (a b c) + (a b c) + (a b c) + (a a a) + (a b c) + (a b c) + (1 2 3)) + (defharmless adjoin.test-and-test-not.1 (adjoin 'a '(b c) :test #'eql :test-not #'eql)) diff --git a/ansi-tests/adjust-array.lsp b/ansi-tests/adjust-array.lsp index 23a1e84e..14cc37b2 100644 --- a/ansi-tests/adjust-array.lsp +++ b/ansi-tests/adjust-array.lsp @@ -231,6 +231,116 @@ a2) #2a((#\1 #\2 #\3)(#\3 #\4 #\5))) +;;; Macro expansion tests + +(deftest adjust-array.24 + (macrolet + ((%m (z) z)) + (let ((a (make-array '(4) :initial-contents '(a b c d)))) + (adjust-array (expand-in-current-env (%m a)) '(4)))) + #(a b c d)) + +(deftest adjust-array.25 + (macrolet + ((%m (z) z)) + (let ((a (make-array '(4) :initial-contents '(a b c d)))) + (adjust-array a (expand-in-current-env (%m '(4)))))) + #(a b c d)) + +(deftest adjust-array.26 + (macrolet + ((%m (z) z)) + (let ((a (make-array '(4) :initial-contents '(a b c d)))) + (adjust-array a '(4) (expand-in-current-env (%m :element-type)) t))) + #(a b c d)) + +(deftest adjust-array.27 + (macrolet + ((%m (z) z)) + (let ((a (make-array '(4) :initial-contents '(a b c d)))) + (adjust-array a '(4) :element-type + (expand-in-current-env (%m t))))) + #(a b c d)) + +(deftest adjust-array.28 + (macrolet + ((%m (z) z)) + (let ((a (make-array '(4) :initial-contents '(a b c d)))) + (adjust-array a '(6) (expand-in-current-env (%m :initial-element)) 17))) + #(a b c d 17 17)) + +(deftest adjust-array.29 + (macrolet + ((%m (z) z)) + (let ((a (make-array '(4) :initial-contents '(a b c d)))) + (adjust-array a '(7) :initial-element (expand-in-current-env (%m 5))))) + #(a b c d 5 5 5)) + +(deftest adjust-array.30 + (macrolet + ((%m (z) z)) + (let ((a (make-array '(4) :initial-contents '(a b c d)))) + (adjust-array a '(6) (expand-in-current-env (%m :initial-contents)) + '(1 2 3 4 5 6)))) + #(1 2 3 4 5 6)) + +(deftest adjust-array.31 + (macrolet + ((%m (z) z)) + (let ((a (make-array '(4) :initial-contents '(a b c d)))) + (adjust-array a '(3) :initial-contents + (expand-in-current-env (%m "ABC"))))) + #(#\A #\B #\C)) + +(deftest adjust-array.32 + (macrolet + ((%m (z) z)) + (let ((a (make-array '(4) :initial-contents '(a b c d)))) + (adjust-array a '(4) (expand-in-current-env (%m :fill-pointer)) nil))) + #(a b c d)) + +(deftest adjust-array.33 + (macrolet + ((%m (z) z)) + (let ((a (make-array '(4) :initial-contents '(a b c d)))) + (adjust-array a '(4) :fill-pointer (expand-in-current-env (%m nil))))) + #(a b c d)) + +(deftest adjust-array.34 + (macrolet + ((%m (z) z)) + (let ((a (make-array '(4) :initial-contents '(a b c d)))) + (adjust-array a '(4) (expand-in-current-env (%m :displaced-to)) nil))) + #(a b c d)) + +(deftest adjust-array.35 + (macrolet + ((%m (z) z)) + (let ((a (make-array '(4) :initial-contents '(a b c d)))) + (adjust-array a '(4) :displaced-to + (expand-in-current-env (%m nil))))) + #(a b c d)) + +(deftest adjust-array.36 + (macrolet + ((%m (z) z)) + (let ((a (make-array '(4) :initial-contents '(a b c d))) + (c (make-array '(8) :initial-contents '(1 2 3 4 5 6 7 8)))) + (adjust-array a '(3) :displaced-to c + (expand-in-current-env (%m :displaced-index-offset)) + 2))) + #(3 4 5)) + +(deftest adjust-array.37 + (macrolet + ((%m (z) z)) + (let ((a (make-array '(4) :initial-contents '(a b c d))) + (c (make-array '(8) :initial-contents '(1 2 3 4 5 6 7 8)))) + (adjust-array a '(5) :displaced-to c + :displaced-index-offset + (expand-in-current-env (%m 1))))) + #(2 3 4 5 6)) + ;;; Adjust an adjustable array (def-adjust-array-test adjust-array.adjustable.1 diff --git a/ansi-tests/adjustable-array-p.lsp b/ansi-tests/adjustable-array-p.lsp index 6832be79..1933eac0 100644 --- a/ansi-tests/adjustable-array-p.lsp +++ b/ansi-tests/adjustable-array-p.lsp @@ -25,6 +25,12 @@ (notnot (adjustable-array-p (make-array '(2 2 2 2) :adjustable t))) t) +(deftest adjustable-array-p.6 + (macrolet ((%m (z) z)) + (let ((a (make-array '(5) :adjustable t))) + (notnot (adjustable-array-p (expand-in-current-env (%m a)))))) + t) + (deftest adjustable-array-p.order.1 (let ((i 0) x) (values diff --git a/ansi-tests/append.lsp b/ansi-tests/append.lsp index 724b9770..7a449417 100644 --- a/ansi-tests/append.lsp +++ b/ansi-tests/append.lsp @@ -47,6 +47,23 @@ (eq (append x nil) x)) nil) +;;; Compiler macro expansion in correct env + +(deftest append.8 + (macrolet ((%m (z) z)) + (append (expand-in-current-env (%m '(a b c))))) + (a b c)) + +(deftest append.9 + (macrolet ((%m (z) z)) + (append (expand-in-current-env (%m (list 1 2 3))) (list 4 5 6))) + (1 2 3 4 5 6)) + +(deftest append.10 + (macrolet ((%m (z) z)) + (append (list 1 2 3) (expand-in-current-env (%m (list 4 5 6))))) + (1 2 3 4 5 6)) + ;;; Order of evaluation tests (deftest append.order.1 diff --git a/ansi-tests/apply.lsp b/ansi-tests/apply.lsp index 30b91262..5fc0be7b 100644 --- a/ansi-tests/apply.lsp +++ b/ansi-tests/apply.lsp @@ -48,6 +48,21 @@ (apply 'cons '(a b)) (a . b)) +(deftest apply.6 + (macrolet ((%m (z) z)) + (apply (expand-in-current-env (%m 'cons)) 1 2 nil)) + (1 . 2)) + +(deftest apply.7 + (macrolet ((%m (z) z)) + (apply #'cons (expand-in-current-env (%m 1)) '(2))) + (1 . 2)) + +(deftest apply.8 + (macrolet ((%m (z) z)) + (apply #'cons (expand-in-current-env (%m '(1 2))))) + (1 . 2)) + (deftest apply.order.1 (let ((i 0) x y z) (values diff --git a/ansi-tests/apropos-list.lsp b/ansi-tests/apropos-list.lsp index 1fa7e062..ee3f2fdf 100644 --- a/ansi-tests/apropos-list.lsp +++ b/ansi-tests/apropos-list.lsp @@ -74,6 +74,22 @@ (notnot (member sym symbols))) t) +(deftest apropos-list.8 + (let ((*package* (find-package "COMMON-LISP"))) + (macrolet + ((%m (z) z)) + (intersection '(car) + (apropos-list (expand-in-current-env (%m "CAR")))))) + (car)) + +(deftest apropos-list.9 + (macrolet + ((%m (z) z)) + (intersection '(car) + (apropos-list "CAR" (expand-in-current-env + (%m (find-package "COMMON-LISP")))))) + (car)) + ;;; Error tests (deftest apropos-list.error.1 diff --git a/ansi-tests/apropos.lsp b/ansi-tests/apropos.lsp index a0dc0d0b..da70a9cb 100644 --- a/ansi-tests/apropos.lsp +++ b/ansi-tests/apropos.lsp @@ -69,6 +69,27 @@ (notnot (search "CAR" s :test #'string-equal))) t) +(deftest apropos.9 + (macrolet + ((%m (z) z)) + (let ((s (with-output-to-string + (*standard-output*) + (assert (null (multiple-value-list + (apropos (expand-in-current-env (%m "CAR"))))))))) + (notnot (search "CAR" s :test #'string-equal)))) + t) + +(deftest apropos.10 + (macrolet + ((%m (z) z)) + (let ((s (with-output-to-string + (*standard-output*) + (assert (null (multiple-value-list + (apropos "CAR" + (expand-in-current-env (%m nil))))))))) + (notnot (search "CAR" s :test #'string-equal)))) + t) + ;;; Error tests (deftest apropos.error.1 diff --git a/ansi-tests/arithmetic-error.lsp b/ansi-tests/arithmetic-error.lsp new file mode 100644 index 00000000..bcbb1860 --- /dev/null +++ b/ansi-tests/arithmetic-error.lsp @@ -0,0 +1,68 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Contains: Tests of ARITHMETIC-ERROR condition and associated accessors + +(in-package :cl-test) + +(deftest arithmethic-error.1 + (let ((a (make-condition 'arithmetic-error + :operation '/ + :operands '(0 0)))) + (values + (notnot (typep a 'arithmetic-error)) + (notnot (typep a (find-class 'arithmetic-error))) + (multiple-value-list (arithmetic-error-operation a)) + (multiple-value-list (arithmetic-error-operands a)))) + t t (/) ((0 0))) + +(deftest arithmethic-error.2 + (let ((a (make-condition 'arithmetic-error + :operation #'/ + :operands '(0 0)))) + (values + (notnot (typep a 'arithmetic-error)) + (notnot (typep a 'error)) + (notnot (typep a 'serious-condition)) + (notnot (typep a 'condition)) + (notnot (typep a (find-class 'arithmetic-error))) + (notnot (typep (arithmetic-error-operation a) 'function)) + (funcall (arithmetic-error-operation a) 1 2) + (multiple-value-list (arithmetic-error-operands a)))) + t t t t t t 1/2 ((0 0))) + +(deftest arithmetic-error.3 + (let ((a (make-condition 'arithmetic-error + :operation '/ + :operands '(0 0)))) + (macrolet + ((%m (z) z)) + (values + (arithmetic-error-operation (expand-in-current-env (%m a))) + (arithmetic-error-operands (expand-in-current-env (%m a)))))) + / (0 0)) + +;;; Error tests + +(deftest arithmetic-error-operation.error.1 + (signals-error (arithmetic-error-operation) program-error) + t) + +(deftest arithmetic-error-operation.error.2 + (signals-error (arithmetic-error-operation + (make-condition 'arithmetic-error :operation '/ + :operands '(1 0)) + nil) + program-error) + t) + +(deftest arithmetic-error-operands.error.1 + (signals-error (arithmetic-error-operands) program-error) + t) + +(deftest arithmetic-error-operands.error.2 + (signals-error (arithmetic-error-operands + (make-condition 'arithmetic-error :operation '/ + :operands '(1 0)) + nil) + program-error) + t) diff --git a/ansi-tests/array-dimension.lsp b/ansi-tests/array-dimension.lsp index 256b172f..c35b3601 100644 --- a/ansi-tests/array-dimension.lsp +++ b/ansi-tests/array-dimension.lsp @@ -37,6 +37,17 @@ (array-dimension a 0)))) 10 20) +(deftest array-dimension.7 + (macrolet ((%m (z) z)) + (array-dimension (expand-in-current-env (%m "abc")) 0)) + 3) + +(deftest array-dimension.8 + (macrolet ((%m (z) z)) + (array-dimension #2a((a b)(c d)(e f)) + (expand-in-current-env (%m 0)))) + 3) + (deftest array-dimension.order.1 (let ((i 0) a b) (values diff --git a/ansi-tests/array-dimensions.lsp b/ansi-tests/array-dimensions.lsp index 98d94cff..718d13aa 100644 --- a/ansi-tests/array-dimensions.lsp +++ b/ansi-tests/array-dimensions.lsp @@ -39,6 +39,11 @@ (array-dimension a 0)) 10) +(deftest array-dimensions.8 + (macrolet ((%m (z) z)) (array-dimensions + (expand-in-current-env (%m #2a((a b)(c d)(e f)))))) + (3 2)) + ;;; Error tests (deftest array-dimensions.error.1 diff --git a/ansi-tests/array-displacement.lsp b/ansi-tests/array-displacement.lsp index ad668be5..465bf8c4 100644 --- a/ansi-tests/array-displacement.lsp +++ b/ansi-tests/array-displacement.lsp @@ -94,6 +94,20 @@ (eqlt disp 0)))) t) +(deftest array-displacement.15 + (let* ((a (make-array '(10) :initial-contents '(a b c d e f g h i j))) + (b (make-array '(5) :displaced-to a :displaced-index-offset 2))) + (macrolet + ((%m (z) z)) + (multiple-value-bind + (x y) + (array-displacement (expand-in-current-env (%m b))) + (values (eqlt x a) y)))) + t 2) + +;;; FIXME: Add tests for other kinds of specialized arrays +;;; (character, other integer types, float types, complex types) + (deftest array-displacement.order.1 (let* ((a (make-array '(10))) (b (make-array '(10) :displaced-to a)) diff --git a/ansi-tests/array-element-type.lsp b/ansi-tests/array-element-type.lsp new file mode 100644 index 00000000..46608bde --- /dev/null +++ b/ansi-tests/array-element-type.lsp @@ -0,0 +1,39 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Contains: Tests of the function ARRAY-ELEMENT-TYPE + +(in-package :cl-test) + +;;; Mosts tests are in other files, incidental to testing of +;;; other things + +(deftest array-element-type.1 + (macrolet ((%m (z) z)) + (notnot (array-element-type (expand-in-current-env (%m #(a b c)))))) + t) + +(deftest array-element-type.order.1 + (let ((i 0)) + (array-element-type (progn (incf i) #(a b c))) + i) + 1) + +;;; Error tests + +(deftest array-element-type.error.1 + (signals-error (array-element-type) program-error) + t) + +(deftest array-element-type.error.2 + (signals-error (array-element-type #(a b c) nil) program-error) + t) + +(deftest array-element-type.error.3 + (check-type-error #'array-element-type #'arrayp) + nil) + +(deftest array-element-type.error.4 + (signals-type-error x nil (array-element-type x)) + t) + + diff --git a/ansi-tests/array-has-fill-pointer-p.lsp b/ansi-tests/array-has-fill-pointer-p.lsp new file mode 100644 index 00000000..fa1eed42 --- /dev/null +++ b/ansi-tests/array-has-fill-pointer-p.lsp @@ -0,0 +1,56 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Contains: Tests of the function ARRAY-HAS-FILL-POINTER-P + +(in-package :cl-test) + +;;; Many tests are in other files, incidental to testing of +;;; other things + +(deftest array-has-fill-pointer-p.1 + (array-has-fill-pointer-p #0a1) + nil) + +(deftest array-has-fill-pointer-p.2 + (array-has-fill-pointer-p #2a((a b)(c d))) + nil) + +(deftest array-has-fill-pointer-p.3 + (array-has-fill-pointer-p #3a(((a)))) + nil) + +(deftest array-has-fill-pointer-p.4 + (array-has-fill-pointer-p #4a((((a))))) + nil) + +(deftest array-has-fill-pointer-p.5 + (macrolet + ((%m (z) z)) + (array-has-fill-pointer-p (expand-in-current-env (%m #2a((a b)(c d)))))) + nil) + +(deftest array-has-fill-pointer-p.order.1 + (let ((i 0)) + (array-has-fill-pointer-p (progn (incf i) #(a b c))) + i) + 1) + +;;; Error tests + +(deftest array-has-fill-pointer-p.error.1 + (signals-error (array-has-fill-pointer-p) program-error) + t) + +(deftest array-has-fill-pointer-p.error.2 + (signals-error (array-has-fill-pointer-p #(a b c) nil) program-error) + t) + +(deftest array-has-fill-pointer-p.error.3 + (check-type-error #'array-has-fill-pointer-p #'arrayp) + nil) + +(deftest array-has-fill-pointer-p.error.4 + (signals-type-error x nil (array-has-fill-pointer-p x)) + t) + + diff --git a/ansi-tests/array-in-bounds-p.lsp b/ansi-tests/array-in-bounds-p.lsp index b18ff0ec..42169c6c 100644 --- a/ansi-tests/array-in-bounds-p.lsp +++ b/ansi-tests/array-in-bounds-p.lsp @@ -132,6 +132,17 @@ (array-in-bounds-p #(a b c) -1000000000000000000) nil) +;;; Macro expansion + +(deftest array-in-bounds-p.24 + (macrolet ((%m (z) z)) (array-in-bounds-p (expand-in-current-env (%m #(a b))) 3)) + nil) + +(deftest array-in-bounds-p.25 + (macrolet ((%m (z) z)) + (array-in-bounds-p #(a b) (expand-in-current-env (%m 2)))) + nil) + ;;; Order of evaluation tests (deftest array-in-bounds-p.order.1 diff --git a/ansi-tests/array-rank.lsp b/ansi-tests/array-rank.lsp index e08dc1f7..fd282127 100644 --- a/ansi-tests/array-rank.lsp +++ b/ansi-tests/array-rank.lsp @@ -16,6 +16,10 @@ (eql (array-rank e) 1)))) nil) +(deftest array-rank.3 + (macrolet ((%m (z) z)) (array-rank (expand-in-current-env (%m "abc")))) + 1) + (deftest array-rank.order.1 (let ((i 0) a) (values diff --git a/ansi-tests/array-row-major-index.lsp b/ansi-tests/array-row-major-index.lsp index 418b88eb..e57f0603 100644 --- a/ansi-tests/array-row-major-index.lsp +++ b/ansi-tests/array-row-major-index.lsp @@ -22,6 +22,18 @@ collect (array-row-major-index a i))) (0 1 2 3 4)) +(deftest array-row-major-index.4 + (macrolet + ((%m (z) z)) + (array-row-major-index (expand-in-current-env (%m #(a b c))) 1)) + 1) + +(deftest array-row-major-index.5 + (macrolet + ((%m (z) z)) + (array-row-major-index #(a b c) (expand-in-current-env (%m 1)))) + 1) + (deftest array-row-major-index.order.1 (let ((x 0) y z (a #(a b c d e f))) diff --git a/ansi-tests/array-total-size.lsp b/ansi-tests/array-total-size.lsp index 50ab953f..05ad68b7 100644 --- a/ansi-tests/array-total-size.lsp +++ b/ansi-tests/array-total-size.lsp @@ -27,6 +27,11 @@ (array-total-size #2a((1 2 3)(4 5 6)(7 8 9)(a b c))) 12) +(deftest array-total-size.6 + (macrolet ((%m (z) z)) + (array-total-size (expand-in-current-env (%m #(a b c))))) + 3) + (deftest array-total-size.order.1 (let ((i 0) a) (values diff --git a/ansi-tests/arrayp.lsp b/ansi-tests/arrayp.lsp index 341626ad..6b354e96 100644 --- a/ansi-tests/arrayp.lsp +++ b/ansi-tests/arrayp.lsp @@ -31,6 +31,10 @@ (check-type-predicate #'arrayp 'array) nil) +(deftest arrayp.7 + (macrolet ((%m (z) z)) (arrayp (expand-in-current-env (%m 0)))) + nil) + (deftest arrayp.order.1 (let ((i 0) a) (values diff --git a/ansi-tests/ash.lsp b/ansi-tests/ash.lsp index 3f26369f..ad7db5b3 100644 --- a/ansi-tests/ash.lsp +++ b/ansi-tests/ash.lsp @@ -63,6 +63,14 @@ always (eql (ash j j) -1)) t) +(deftest ash.6 + (macrolet + ((%m (z) z)) + (values + (ash (expand-in-current-env (%m 3)) 1) + (ash 1 (expand-in-current-env (%m 3))))) + 6 8) + (deftest ash.order.1 (let ((i 0) x y) (values (ash (progn (setf x (incf i)) 1) diff --git a/ansi-tests/asin.lsp b/ansi-tests/asin.lsp index 7db773c5..c723e362 100644 --- a/ansi-tests/asin.lsp +++ b/ansi-tests/asin.lsp @@ -78,6 +78,10 @@ collect type) nil) +(deftest asin.9 + (macrolet ((%m (z) z)) (asin (expand-in-current-env (%m 0.0)))) + 0.0) + ;;; FIXME ;;; Add accuracy tests diff --git a/ansi-tests/asinh.lsp b/ansi-tests/asinh.lsp index 9501c01c..44f832e0 100644 --- a/ansi-tests/asinh.lsp +++ b/ansi-tests/asinh.lsp @@ -66,6 +66,10 @@ collect (list x1 x2 rlist))) nil) +(deftest asinh.7 + (macrolet ((%m (z) z)) (asinh (expand-in-current-env (%m 0.0)))) + 0.0) + ;;; FIXME ;;; Add accuracy tests here diff --git a/ansi-tests/assoc-if-not.lsp b/ansi-tests/assoc-if-not.lsp index 05daecb5..8abb70c7 100644 --- a/ansi-tests/assoc-if-not.lsp +++ b/ansi-tests/assoc-if-not.lsp @@ -28,17 +28,17 @@ (6 . c)) (deftest assoc-if-not.3 - (let* ((x (copy-list '((1 . a) nil (3 . b) (6 . c) (7 . d)))) - (xcopy (make-scaffold-copy x)) - (result (assoc-if-not #'oddp x))) - (and - (check-scaffold-copy x xcopy) - (eqt result (fourth x)) - result)) + (let* ((x (copy-list '((1 . a) nil (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (assoc-if-not #'oddp x))) + (and + (check-scaffold-copy x xcopy) + (eqt result (fourth x)) + result)) (6 . c)) (deftest assoc-if-not.4 - (assoc-if-not #'identity '((a . b) nil (c . d) (nil . e) (f . g))) + (assoc-if-not #'identity '((a . b) nil (c . d) (nil . e) (f . g))) (nil . e)) ;;; Order of argument evaluation tests @@ -96,6 +96,29 @@ (assoc-if-not #'identity '((a . 1) (nil . 2) (c . 3)) :key nil :key #'null) (nil . 2)) +;;; Macro env tests + +(deftest assoc-if-not.env.1 + (macrolet + ((%m (z) z)) + (let ((alist '((1 . a) (3 . b) (4 . c) (6 . d)))) + (values + (assoc-if-not (expand-in-current-env (%m 'oddp)) alist) + (assoc-if-not (expand-in-current-env (%m #'oddp)) alist) + (assoc-if-not 'oddp (expand-in-current-env (%m alist)))))) + (4 . c) + (4 . c) + (4 . c)) + +(deftest assoc-if-not.env.2 + (macrolet + ((%m (z) z)) + (let ((alist '((1 . a) (3 . b) (4 . c) (6 . d)))) + (values + (assoc-if-not 'evenp alist (expand-in-current-env (%m :key)) #'1+) + (assoc-if-not #'evenp alist :key (expand-in-current-env (%m '1+))) + + ;;; Error tests (deftest assoc-if-not.error.1 diff --git a/ansi-tests/character.lsp b/ansi-tests/character.lsp index df9c14f2..9be18586 100644 --- a/ansi-tests/character.lsp +++ b/ansi-tests/character.lsp @@ -125,6 +125,10 @@ (char-type-error-check #'alpha-char-p) t) +(deftest alpha-char-p.4 + (macrolet ((%m (z) z)) (alpha-char-p (expand-in-current-env (%m #\?)))) + nil) + (deftest alpha-char-p.order.1 (let ((i 0)) (values @@ -165,6 +169,10 @@ (alphanumericp.5.body) t) +(deftest alphanumbericp.6 + (macrolet ((%m (z) z)) (alphanumericp (expand-in-current-env (%m #\=)))) + nil) + (deftest alphanumericp.order.1 (let ((i 0)) (values diff --git a/ansi-tests/divide.lsp b/ansi-tests/divide.lsp index ea142c71..00f8e0e8 100644 --- a/ansi-tests/divide.lsp +++ b/ansi-tests/divide.lsp @@ -204,3 +204,14 @@ (eql (/ frneg) frpos))) collect (list i rpos rneg (float rpos one) (float rneg one)))) nil) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest /.13 + (macrolet ((%m (z) z)) + (values + (/ (expand-in-current-env (%m 1/2))) + (/ (expand-in-current-env (%m 2)) 3) + (/ 5 (expand-in-current-env (%m 7))))) + 2 2/3 5/7) diff --git a/ansi-tests/load-arrays.lsp b/ansi-tests/load-arrays.lsp index e7d66538..897a9af8 100644 --- a/ansi-tests/load-arrays.lsp +++ b/ansi-tests/load-arrays.lsp @@ -14,6 +14,7 @@ (load "array-displacement.lsp") (load "array-dimension.lsp") (load "array-dimensions.lsp") +(load "array-element-type.lsp") (load "array-in-bounds-p.lsp") (load "array-misc.lsp") (load "array-rank.lsp") diff --git a/ansi-tests/load-numbers.lsp b/ansi-tests/load-numbers.lsp index 5f491a93..7aad8e5a 100644 --- a/ansi-tests/load-numbers.lsp +++ b/ansi-tests/load-numbers.lsp @@ -111,3 +111,6 @@ (load "real.lsp") (load "upgraded-complex-part-type.lsp") + +(load "arithmetic-error.lsp") + diff --git a/ansi-tests/minus.lsp b/ansi-tests/minus.lsp index 0f37f880..70cb2ce0 100644 --- a/ansi-tests/minus.lsp +++ b/ansi-tests/minus.lsp @@ -95,6 +95,13 @@ collect x)) nil) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest minus.9 + (macrolet ((%m (z) z)) (- (expand-in-current-env (%m 1)))) + -1) + ;;; Binary minus tests (deftest subtract.1 @@ -173,3 +180,15 @@ unless (eql diff (complex (- i j) (+ (- i j) 300))) collect (list i ci j cj (- ci cj))) nil) + +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest subtract.6 + (macrolet ((%m (z) z)) + (values + (- (expand-in-current-env (%m 2)) 1) + (- 17 (expand-in-current-env (%m 5))) + (- 1/2 (expand-in-current-env (%m 1/6)) + (expand-in-current-env (%m 0))))) + 1 12 1/3) diff --git a/ansi-tests/number-comparison.lsp b/ansi-tests/number-comparison.lsp index 989aefb4..0a004a4d 100644 --- a/ansi-tests/number-comparison.lsp +++ b/ansi-tests/number-comparison.lsp @@ -1633,17 +1633,131 @@ collect (list r p q x fr cr)))) nil) - - - - - - - - - - - - - - +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest =.env.1 + (macrolet ((%m (z) z)) + (mapcar 'notnot + (list (= (expand-in-current-env (%m 0))) + (= 1 (expand-in-current-env (%m 1))) + (= (expand-in-current-env (%m 2)) 2) + (= (expand-in-current-env (%m 3)) + (expand-in-current-env (%m 3))) + (= (expand-in-current-env (%m #c(1 2))) + (expand-in-current-env (%m #c(1 2)))) + + (= 1 (expand-in-current-env (%m 2.0))) + (= (expand-in-current-env (%m 2)) 2/3) + (= (expand-in-current-env (%m 4)) + (expand-in-current-env (%m 5))) + + (= (expand-in-current-env (%m 0)) 0 0) + (= 0 (expand-in-current-env (%m 0)) 0) + (= 0 0 (expand-in-current-env (%m 0))) + ))) + (t t t t t nil nil nil t t t)) + + +(deftest /=.env.1 + (macrolet ((%m (z) z)) + (mapcar 'notnot + (list (/= (expand-in-current-env (%m 0))) + (/= 1 (expand-in-current-env (%m 1))) + (/= (expand-in-current-env (%m 2)) 2) + (/= (expand-in-current-env (%m 3)) + (expand-in-current-env (%m 3))) + (/= (expand-in-current-env (%m #c(1 2))) + (expand-in-current-env (%m #c(1 2)))) + + (/= 1 (expand-in-current-env (%m 2.0))) + (/= (expand-in-current-env (%m 2)) 2/3) + (/= (expand-in-current-env (%m 4)) + (expand-in-current-env (%m 5))) + + (/= (expand-in-current-env (%m 2)) 0 1) + (/= 0 (expand-in-current-env (%m 2)) 1) + (/= 0 1 (expand-in-current-env (%m 2))) + ))) + (t nil nil nil nil t t t t t t)) + +(deftest <.env.1 + (macrolet ((%m (z) z)) + (mapcar 'notnot + (list (< (expand-in-current-env (%m 0))) + (< 0 (expand-in-current-env (%m 1))) + (< (expand-in-current-env (%m 2)) 3) + (< (expand-in-current-env (%m 5)) + (expand-in-current-env (%m 7))) + + (< 3 (expand-in-current-env (%m 2.0))) + (< (expand-in-current-env (%m 2)) 2/3) + (< (expand-in-current-env (%m 6)) + (expand-in-current-env (%m 5))) + + (< (expand-in-current-env (%m 1)) 2 3) + (< 1 (expand-in-current-env (%m 2)) 3) + (< 1 2 (expand-in-current-env (%m 3))) + ))) + (t t t t nil nil nil t t t)) + +(deftest <=.env.1 + (macrolet ((%m (z) z)) + (mapcar 'notnot + (list (<= (expand-in-current-env (%m 0))) + (<= 0 (expand-in-current-env (%m 1))) + (<= (expand-in-current-env (%m 2)) 3) + (<= (expand-in-current-env (%m 5)) + (expand-in-current-env (%m 7))) + + (<= 3 (expand-in-current-env (%m 2.0))) + (<= (expand-in-current-env (%m 2)) 2/3) + (<= (expand-in-current-env (%m 6)) + (expand-in-current-env (%m 5))) + + (<= (expand-in-current-env (%m 2)) 2 3) + (<= 1 (expand-in-current-env (%m 1)) 3) + (<= 1 2 (expand-in-current-env (%m 2))) + ))) + (t t t t nil nil nil t t t)) + +(deftest >.env.1 + (macrolet ((%m (z) z)) + (mapcar 'notnot + (list (> (expand-in-current-env (%m 0))) + (> 2 (expand-in-current-env (%m 1))) + (> (expand-in-current-env (%m 4)) 3) + (> (expand-in-current-env (%m 10)) + (expand-in-current-env (%m 7))) + + (> 1 (expand-in-current-env (%m 2.0))) + (> (expand-in-current-env (%m -1)) 2/3) + (> (expand-in-current-env (%m 4)) + (expand-in-current-env (%m 5))) + + (> (expand-in-current-env (%m 2)) 1 0) + (> 2 (expand-in-current-env (%m 1)) 0) + (> 2 1 (expand-in-current-env (%m 0))) + ))) + (t t t t nil nil nil t t t)) + + +(deftest >=.env.1 + (macrolet ((%m (z) z)) + (mapcar 'notnot + (list (>= (expand-in-current-env (%m 0))) + (>= 2 (expand-in-current-env (%m 1))) + (>= (expand-in-current-env (%m 4)) 3) + (>= (expand-in-current-env (%m 7)) + (expand-in-current-env (%m 7))) + + (>= 1 (expand-in-current-env (%m 2.0))) + (>= (expand-in-current-env (%m -1)) 2/3) + (>= (expand-in-current-env (%m 4)) + (expand-in-current-env (%m 5))) + + (>= (expand-in-current-env (%m 2)) 1 1) + (>= 1 (expand-in-current-env (%m 1)) 0) + (>= 2 2 (expand-in-current-env (%m 0))) + ))) + (t t t t nil nil nil t t t)) diff --git a/ansi-tests/oneminus.lsp b/ansi-tests/oneminus.lsp index 1b786ed5..a0a5a3e5 100644 --- a/ansi-tests/oneminus.lsp +++ b/ansi-tests/oneminus.lsp @@ -168,3 +168,7 @@ unless (eql xc1 (complex (- xr 1) xi)) collect (list xr xi xc xc1))) nil) + +(deftest 1-.15 + (macrolet ((%m (z) z)) (1- (expand-in-current-env (%m 2)))) + 1) diff --git a/ansi-tests/oneplus.lsp b/ansi-tests/oneplus.lsp index 83895642..b70da29c 100644 --- a/ansi-tests/oneplus.lsp +++ b/ansi-tests/oneplus.lsp @@ -164,3 +164,7 @@ unless (eql xc1 (complex (+ xr 1) xi)) collect (list xr xi xc xc1))) nil) + +(deftest 1+.15 + (macrolet ((%m (z) z)) (1+ (expand-in-current-env (%m 1)))) + 2) diff --git a/ansi-tests/plus.lsp b/ansi-tests/plus.lsp index 9e6f0681..1319414d 100644 --- a/ansi-tests/plus.lsp +++ b/ansi-tests/plus.lsp @@ -347,8 +347,21 @@ -0.0l0) 0.0l0) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest plus.28 + (macrolet ((%m (z) z)) + (values + (+ (expand-in-current-env (%m 1))) + (+ (expand-in-current-env (%m 2)) 3) + (+ 4 (expand-in-current-env (%m 5))) + (+ 1/2 (expand-in-current-env (%m 6)) 2/3))) + 1 5 9 43/6) + ;;; Must test combinations of reals and complex arguments. +;;; Order of evaluation tests (deftest plus.order.1 (let ((i 0) x y) diff --git a/ansi-tests/times.lsp b/ansi-tests/times.lsp index 96306d5f..6b1b2e3e 100644 --- a/ansi-tests/times.lsp +++ b/ansi-tests/times.lsp @@ -359,6 +359,19 @@ collect (list type i j x y (* cx cy)))) nil) +;;; Test that explicit calls to macroexpand in subforms +;;; are done in the correct environment + +(deftest *.28 + (macrolet ((%m (z) z)) + (values + (* (expand-in-current-env (%m 2))) + (* (expand-in-current-env (%m 3)) 4) + (* 5 (expand-in-current-env (%m 3))))) + 2 12 15) + +;;; Order of evaluation tests + (deftest times.order.1 (let ((i 0) x y) (values -- GitLab