Commit ffabd0cb authored by pfdietz's avatar pfdietz

Added tests for allowed behavior of section 11.1.2.1.2.1 of the ANSI CL spec.

parent 20923588
......@@ -990,6 +990,11 @@
"YES-OR-NO-P"
"ZEROP"))
(defparameter *cl-symbols*
(let ((pkg (find-package "COMMON-LISP")))
(mapcar #'(lambda (str) (intern str pkg))
*cl-symbol-names*)))
;;; Symbols classified by their kind in the spec
(defparameter *cl-function-symbols*
'(
......@@ -1593,6 +1598,7 @@
/
//
///
-
))
(defparameter *cl-constant-symbols*
......@@ -1651,6 +1657,7 @@
most-positive-long-float
most-positive-short-float
most-positive-single-float
multiple-values-limit
nil
pi
short-float-epsilon
......@@ -2122,3 +2129,22 @@
(list *cl-type-symbols* *cl-types-that-are-classes-symbols*
*cl-system-class-symbols* *cl-class-symbols*
*cl-condition-type-symbols*)))
(defparameter *cl-non-function-macro-special-operator-symbols*
(set-difference
*cl-symbols*
(reduce #'union
(list *cl-function-symbols*
*cl-macro-symbols*
*cl-accessor-symbols*
*cl-local-function-symbols*
*cl-local-macro-symbols*
*cl-special-operator-symbols*
*cl-standard-generic-function-symbols*
'(declare)))))
(defparameter *cl-non-variable-constant-symbols*
(set-difference
*cl-symbols*
(union *cl-variable-symbols*
*cl-constant-symbols*)))
......@@ -399,3 +399,33 @@
(flet ((:foo () 'bar)) (funcall #':foo))
bar)
(deftest flet.49
(loop for s in *cl-non-function-macro-special-operator-symbols*
for form = `(classify-error (flet ((,s () 'a)) (,s)))
unless (eq (eval form) 'a)
collect s)
nil)
(deftest flet.50
(loop for s in *cl-non-function-macro-special-operator-symbols*
for form = `(classify-error (flet ((,s () 'a))
(declare (ftype (function () symbol)
,s))
(,s)))
unless (eq (eval form) 'a)
collect s)
nil)
;;; Binding SETF functions of certain COMMON-LISP symbols
(deftest flet.51
(loop for s in *cl-non-function-macro-special-operator-symbols*
for form = `(classify-error
(flet (((setf ,s) (&rest args)
(declare (ignore args))
'a))
(setf (,s) 10)))
unless (eq (eval form) 'a)
collect s)
nil)
......@@ -176,3 +176,39 @@
(:bar () (1+ (funcall #':foo))))
(funcall #':bar))
11)
(deftest labels.24
(loop for s in *cl-non-function-macro-special-operator-symbols*
for form = `(classify-error (labels ((,s (x) (foo (1- x)))
(foo (y)
(if (<= y 0) 'a
(,s (1- y)))))
(,s 10)))
unless (eq (eval form) 'a)
collect s)
nil)
(deftest labels.25
(loop for s in *cl-non-function-macro-special-operator-symbols*
for form = `(classify-error
(labels ((,s (x) (foo (1- x)))
(foo (y)
(if (<= y 0) 'a
(,s (1- y)))))
(declare (ftype (function (integer) symbol)
foo ,s))
(,s 10)))
unless (eq (eval form) 'a)
collect s)
nil)
(deftest labels.26
(loop for s in *cl-non-function-macro-special-operator-symbols*
for form = `(classify-error
(labels (((setf ,s) (&rest args)
(declare (ignore args))
'a))
(setf (,s) 10)))
unless (eq (eval form) 'a)
collect s)
nil)
......@@ -101,6 +101,15 @@
(or (eqlt val (/ (* n (1+ n)) 2)) (list val)))
t)
;;; Test that all non-variables exported from COMMON-LISP can be bound
;;; in LET forms.
(deftest let.15
(loop for s in *cl-non-variable-constant-symbols*
for form = `(classify-error (let ((,s 17)) ,s))
unless (eql (eval form) 17)
collect s)
nil)
;;; Tests for LET*
(deftest let*.1
......@@ -190,3 +199,12 @@
(val (eval expr)))
(or (eqlt val (/ (* n (1+ n)) 2)) (list val)))
t)
;;; Test that all non-variables exported from COMMON-LISP can be bound
;;; in LET* forms.
(deftest let*.15
(loop for s in *cl-non-variable-constant-symbols*
for form = `(classify-error (let* ((,s 17)) ,s))
unless (eql (eval form) 17)
collect s)
nil)
......@@ -138,4 +138,23 @@
(foo a)))
2)
(deftest macrolet.15
(macrolet ((nil () ''a))
(nil))
a)
(deftest macrolet.16
(loop for s in *cl-non-function-macro-special-operator-symbols*
for form = `(classify-error (macrolet ((,s () ''a)) (,s)))
unless (eq (eval form) 'a)
collect s)
nil)
;;; Symbol-macrolet tests
(deftest symbol-macrolet.1
(loop for s in *cl-non-variable-constant-symbols*
for form = `(classify-error (symbol-macrolet ((,s 17)) ,s))
unless (eql (eval form) 17)
collect s)
nil)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment