diff --git a/ansi-tests/abs.lsp b/ansi-tests/abs.lsp index 2b8280a916a4d30c9b5379dad1f63a97f3878ce2..dcbcf20b39e4e5421f3750d467c4f467f8d921d5 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 e97c9f6b5fa1da2d106e844585df06365128b872..7e5638785233cba71abeeb1e1392ddc93f10b75e 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 b8f2bc2d069b566d967749b116553867400fa353..829478e37744fcb0ce8ccccce9a10b8ae69b23fc 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 2af7791c5cdb47e4150d1614b239cb239f8a31b6..058bf21efab55cb40c52836f0edea2820b4fdc2e 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 18c3e77a9df8d4e839dcf063cd88c8a1a78f81d4..abc61c49279b7d95a96a37d45ec7f754ce66dbab 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 23a1e84ecfc459164c8d53bff60240e4b2b0a98e..14cc37b21506b755951c7473a3b48fcde4870b30 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 6832be79f863cef073a13b156cac702b0debeb6a..1933eac0d76e43ffcc250c5ad0f250c2fc906fb9 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 724b97708b8e5566dd92b406de00d12124489f28..7a4494171ebb60c3b0d6c4f94a7e12b1b180f457 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 30b9126281e224bfc88acf6922d177a59ce7a4d3..5fc0be7b359eec311ac52d557af77eae9b62bbfa 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 1fa7e0627a0b68961a47207eedffaacc6c53413b..ee3f2fdf273f285f499de20a9e454063084b295d 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 a0dc0d0bf93dda8978ac078bebe64b9c35028f74..da70a9cb7fecf4e09ef2fe1ec8a19f8617411561 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 0000000000000000000000000000000000000000..bcbb1860a1ca76f17bc25be41c309cef91f62d51 --- /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 256b172ff9fe4b81b1e33b5c64fc6d80b277c423..c35b3601806fdce60272edbd8a1e42cba60f31c5 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 98d94cff522348785c2aa5da991c7d57fdf3f06f..718d13aae2e3b2c6cfb44b9d63e6fe05af837cfd 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 ad668be567a4a35c732ae23113b866d4a61a972f..465bf8c4b71171dc6b35df34e46ef199edb7aefd 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 0000000000000000000000000000000000000000..46608bdeb4aa2827f1bba49a139787b978f27bfb --- /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 0000000000000000000000000000000000000000..fa1eed4248edd18580047a46a6bd39c198bb85e4 --- /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 b18ff0ec7ac1809a987a3cbc1d08450e80c50bc8..42169c6c0fddb37eb68fc207689f568a5ac17464 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 e08dc1f7b502936cb765da1d58562d9eb31959b2..fd282127333aac05b2f83a66e107d05c1aeefea3 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 418b88eb4ad67ce317426378632376a9314c3ee8..e57f0603a31882677548b2afcfca8895f5e56261 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 50ab953f24251f46765304a3d9394adc28acd9f4..05ad68b7cfe31694c5234c2370e49ded44e5f2f7 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 341626add881068ece18ff6749171867be173e45..6b354e96aeae402612f7eac6d644498319a41e32 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 3f26369f004b011295c1e9f6fbaa5f53176209a2..ad7db5b3c21990b7568360369ae9c840886fff9d 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 7db773c581883afd01e014eff8a77bda4fc426ce..c723e362019340b42abf65885dd9bce53ff20970 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 9501c01c6041b08bc4ad0a08c5e0793309e98d79..44f832e03482dfe39f3bb44abf1784dbd196808d 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 05daecb5f2c988a560efcf35de984a734a4d2024..8abb70c70d68bee704e08e23fb20d409bf6acc15 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 df9c14f27cedd98ebf065491ba4d49f2cf280823..9be1858652573581cf47b4bd2872c396b2cefadb 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 ea142c71a09ee4e4950ea15277d48e99485ab202..00f8e0e84581e8caee0f6e2a2287897fb3d97827 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 e7d66538f21a642210881dcab76cf5e5e5bfe3a8..897a9af8109a0484654fdaa7e5d4e81b45c60194 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 5f491a933b585bf0ea8b2701d2be7f5f14539eef..7aad8e5ac8b1e42e46012dfd09d785d43c122959 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 0f37f880f80f205da74a144c89543c845a3407e7..70cb2ce05cb85ac0c8a627c4c06b3ba3d0ff7a02 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 989aefb416276f92a8e1a54362861212ccfb6a92..0a004a4d8c4250240123f18258166d149c8cf713 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 1b786ed543c874265722e7656544cd4fcd57cf75..a0a5a3e5d39ac3b8571a5e4f810f3d6957a860ef 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 83895642b6dd35838ebb1458ed3df58fb3468312..b70da29cdb5c6b95cf037909f60b286b97cbc37b 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 9e6f068192bc81cb706f5dcc72c2b211cd92dc23..1319414da51c80c38775625ada5bce0479574db0 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 96306d5f3f26426937993e47f8d728a3b6e4134e..6b1b2e3e2f304e62da5c78342ccd865c29979c33 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