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