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