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

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.
parent 91fc7832
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......@@ -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")
......
......@@ -111,3 +111,6 @@
(load "real.lsp")
(load "upgraded-complex-part-type.lsp")
(load "arithmetic-error.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)
......@@ -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))
......@@ -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)
......@@ -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)
......@@ -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)
......
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment