From cc361df9e2e41fa1ca0dc0f19e6cb1aa750af62d Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Sat, 19 Apr 2003 04:30:43 +0000
Subject: [PATCH] Added more tests for ordinary lambda lists in LAMBDA forms,
 FLET, and LABELS.

---
 ansi-tests/flet.lsp   |  38 ++++++++
 ansi-tests/labels.lsp |  41 ++++++++-
 ansi-tests/lambda.lsp | 206 +++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 283 insertions(+), 2 deletions(-)

diff --git a/ansi-tests/flet.lsp b/ansi-tests/flet.lsp
index 0b3099fe..4798c8e9 100644
--- a/ansi-tests/flet.lsp
+++ b/ansi-tests/flet.lsp
@@ -437,3 +437,41 @@
      10
      (return-from done 'good)))
   good)
+
+;;; Check that nil keyword arguments do not enable the default values
+
+(deftest flet.53
+  (flet ((%f (&key (a 'wrong)) a)) (%f :a nil))
+  nil)
+
+(deftest flet.54
+  (flet ((%f (&key (a 'wrong a-p)) (list a (not a-p)))) (%f :a nil))
+  (nil nil))
+
+(deftest flet.55
+  (flet ((%f (&key ((:a b) 'wrong)) b)) (%f :a nil))
+  nil)
+
+(deftest flet.56
+  (flet ((%f (&key ((:a b) 'wrong present?)) (list b (not present?)))) (%f :a nil))
+  (nil nil))
+
+(deftest flet.57
+  (flet ((%f (&key) 'good))
+    (%f :allow-other-keys nil))
+  good)
+
+(deftest flet.58
+  (flet ((%f (&key) 'good))
+    (%f :allow-other-keys t))
+  good)
+
+(deftest flet.59
+  (flet ((%f (&key) 'good))
+    (%f :allow-other-keys t :a 1 :b 2))
+  good)
+
+(deftest flet.60
+  (flet ((%f (&key &allow-other-keys) 'good))
+    (%f :a 1 :b 2))
+  good)
diff --git a/ansi-tests/labels.lsp b/ansi-tests/labels.lsp
index 466c1502..04d904d6 100644
--- a/ansi-tests/labels.lsp
+++ b/ansi-tests/labels.lsp
@@ -221,4 +221,43 @@
        (%f))
      10
      (return-from done 'good)))
-  good)
\ No newline at end of file
+  good)
+
+;;; Check that nil keyword arguments do not enable the default values
+
+(deftest labels.28
+  (labels ((%f (&key (a 'wrong)) a)) (%f :a nil))
+  nil)
+
+(deftest labels.29
+  (labels ((%f (&key (a 'wrong a-p)) (list a (not a-p)))) (%f :a nil))
+  (nil nil))
+
+(deftest labels.30
+  (labels ((%f (&key ((:a b) 'wrong)) b)) (%f :a nil))
+  nil)
+
+(deftest labels.31
+  (labels ((%f (&key ((:a b) 'wrong present?)) (list b (not present?))))
+    (%f :a nil))
+  (nil nil))
+
+(deftest labels.32
+  (labels ((%f (&key) 'good))
+    (%f :allow-other-keys nil))
+  good)
+
+(deftest labels.33
+  (labels ((%f (&key) 'good))
+    (%f :allow-other-keys t))
+  good)
+
+(deftest labels.34
+  (labels ((%f (&key) 'good))
+    (%f :allow-other-keys t :a 1 :b 2))
+  good)
+
+(deftest labels.35
+  (labels ((%f (&key &allow-other-keys) 'good))
+    (%f :a 1 :b 2))
+  good)
diff --git a/ansi-tests/lambda.lsp b/ansi-tests/lambda.lsp
index d3751a8e..07d830ea 100644
--- a/ansi-tests/lambda.lsp
+++ b/ansi-tests/lambda.lsp
@@ -45,7 +45,211 @@
   ((lambda (x) (declare (type symbol x))) 'z)
   nil)
 
-;;; Should test lambda argument lists more fully here
+(deftest lambda.11
+  ((lambda (x &optional y z) (list x y z)) 1 2)
+  (1 2 nil))
+
+(deftest lambda.12
+  ((lambda (&optional (x 'a) (y 'b) (z 'c)) (list x y z)) 1 nil)
+  (1 nil c))
+
+(deftest lambda.13
+  ((lambda (&optional (x 'a x-p) (y 'b y-p) (z 'c z-p))
+     (list* x y z (mapcar #'notnot (list x-p y-p z-p)))) 1 nil)
+  (1 nil c t t nil))
+
+(deftest lambda.14
+  (let ((x 1))
+    ((lambda (&optional (x (1+ x))) x)))
+  2)
+
+(deftest lambda.15
+  ((lambda (y &optional (x (1+ y))) (list y x)) 10)
+  (10 11))
+
+(deftest lambda.16
+  ((lambda (y &optional (x (1+ y))) (list y x)) 10 14)
+  (10 14))
+
+(deftest lambda.17
+  ((lambda (&rest x) x) 1 2 3)
+  (1 2 3))
+
+(deftest lambda.18
+  (let ((b 10))
+    ((lambda (&optional (a b) (b (1+ a))) (list a b)) 3 7))
+  (3 7))
+
+(deftest lambda.19
+  (let ((b 10))
+    ((lambda (&optional (a b) (b (1+ a))) (list a b)) 3))
+  (3 4))
+
+(deftest lambda.20
+  (let ((b 10))
+    ((lambda (&optional (a b) (b (1+ a))) (list a b))))
+  (10 11))
+
+(deftest lambda.21
+  (flet ((%f () (locally (declare (special *x*)) (incf *x*))))
+    ((lambda (*x*)
+       (declare (special *x*))
+       (%f)
+       *x*)
+     10))
+  11)
+
+(deftest lambda.22
+  (flet ((%f () (locally (declare (special *x*)) (1+ *x*))))
+    ((lambda (*x*)
+       (declare (special *x*))
+       (%f))
+     15))
+  16)
+
+(deftest lambda.23
+  ((lambda (&key a) a))
+  nil)
+
+(deftest lambda.24
+  ((lambda (&key a b c) (list a b c)))
+  (nil nil nil))
+
+(deftest lambda.25
+  ((lambda (&key (a 1) (b 2) (c 3)) (list a b c)))
+  (1 2 3))
+
+(deftest lambda.26
+  ((lambda (&key)))
+  nil)
+
+(deftest lambda.27
+  ((lambda (&key) 'good) :allow-other-keys nil)
+  good)
+
+(deftest lambda.28
+  ((lambda (&key) 'good) :allow-other-keys t :foo t)
+  good)
+
+(deftest lambda.29
+  ((lambda (&key) 'good) :allow-other-keys t :allow-other-keys nil :foo t)
+  good)
+
+(deftest lambda.30
+  ((lambda (&key x) x) :allow-other-keys t :x 10
+   :allow-other-keys nil :foo t)
+  10)
+
+(deftest lambda.31
+  ((lambda (&rest x &key) x))
+  nil)
+
+(deftest lambda.32
+  ((lambda (&rest x &key) x) :allow-other-keys nil)
+  (:allow-other-keys nil))
+
+(deftest lambda.33
+  ((lambda (&rest x &key) x) :w 5 :allow-other-keys t :x 10)
+  (:w 5 :allow-other-keys t :x 10))
+
+(deftest lambda.34
+  ((lambda (&key (a 1 a-p) (b 2 b-p) (c 3 c-p)) (list a (notnot a-p)
+						      b (notnot b-p)
+						      c (notnot c-p)))
+   :c 5 :a 0)
+  (0 t 2 nil 5 t))
+
+(deftest lambda.35
+  ((lambda (&key (a 1 a-p) (b 2 b-p) (c 3 c-p)) (list a (notnot a-p)
+						      b (notnot b-p)
+						      c (notnot c-p)))
+   :c 5 :a nil :a 17 :c 100)
+  (nil t 2 nil 5 t))
+
+(deftest lambda.36
+  ((lambda (&key (a 1 a-p) (b 2 b-p) (c 3 c-p)) (list a (notnot a-p)
+						      b (notnot b-p)
+						      c (notnot c-p)))
+   :c 5 :a 0 :allow-other-keys t 'b 100)
+  (0 t 2 nil 5 t))
+
+(deftest lambda.37
+  (let ((b 1))
+    ((lambda (&key (a b) b) (list a b)) :b 'x))
+  (1 x))
+
+(deftest lambda.38
+  (let ((b 1))
+    ((lambda (&key (a b) b) (list a b)) :b 'x :a nil))
+  (nil x))
+
+(deftest lambda.39
+  (let ((a-p :bad))
+    ((lambda (&key (a nil a-p) (b a-p)) (list a (notnot a-p) (notnot b)))))
+  (nil nil nil))
+     
+(deftest lambda.40
+  (let ((a-p :bad))
+    ((lambda (&key (a nil a-p) (b a-p)) (list a (notnot a-p) (notnot b)))
+     :a 1))
+  (1 t t))
+
+(deftest lambda.41
+  (let ((a-p :bad))
+    ((lambda (&key (a nil a-p) (b a-p)) (list a (notnot a-p) (notnot b)))
+     :a nil))
+  (nil t t))
+
+(deftest lambda.42
+  ((lambda (&key a b &allow-other-keys) (list a b)) :a 1 :b 2)
+  (1 2))
+
+(deftest lambda.43
+  ((lambda (&key a b &allow-other-keys) (list a b)) :b 2 :a 1)
+  (1 2))
+
+(deftest lambda.44
+  ((lambda (&key a b &allow-other-keys) (list a b)) :z 10 :b 2 :b nil :a 1
+   :a 2 'x 100)
+  (1 2))
+
+(deftest lambda.45
+  ((lambda (&key a b &allow-other-keys) (list a b)) :allow-other-keys nil
+   :z 10 :b 2 :b nil :a 1 :a 2 'x 100)
+  (1 2))
+
+(deftest lambda.46
+  ((lambda (&key a b allow-other-keys) (list allow-other-keys a b))
+   :allow-other-keys nil :a 1 :b 2)
+  (nil 1 2))
+
+(deftest lambda.47
+  ((lambda (&key a b allow-other-keys) (list allow-other-keys a b))
+   :c 10 :allow-other-keys t :a 1 :b 2 :d 20)
+  (t 1 2))
+
+(deftest lambda.48
+  ((lambda (&key a b allow-other-keys &allow-other-keys)
+     (list allow-other-keys a b))
+   :d 40 :allow-other-keys nil :a 1 :b 2 :c 20)
+  (nil 1 2))
+
+(deftest lambda.48
+  ((lambda (&key a b allow-other-keys &allow-other-keys)
+     (list allow-other-keys a b))
+   :d 40 :a 1 :b 2 :c 20)
+  (nil 1 2))
+
+(deftest lambda.49
+  ((lambda (&key a b ((:allow-other-keys aok)))
+     (list aok a b))
+   :d 40 :a 1 :allow-other-keys t :b 2 :c 20)
+  (t 1 2))
+
+(deftest lambda.50
+  ((lambda (&key &allow-other-keys)) :a 1 :b 2 :c 3)
+  nil)
+
 
 ;;; Tests of lambda as a macro
 
-- 
GitLab