diff --git a/ansi-tests/flet.lsp b/ansi-tests/flet.lsp index 0f024ae967cb6b72180c0b70917fe25d54bc6971..4590f040f893cd11eac79302fd78dd8a83d09104 100644 --- a/ansi-tests/flet.lsp +++ b/ansi-tests/flet.lsp @@ -30,6 +30,16 @@ :bad)) :good) +;;; Key arguments are not in the block defined by +;;; the local function declaration +(deftest flet.4a + (block %f + (flet ((%f (&key (x (return-from %f :good))) + nil)) + (%f) + :bad)) + :good) + (deftest flet.5 (flet ((%f () (return-from %f 15) 35)) (%f)) diff --git a/ansi-tests/labels.lsp b/ansi-tests/labels.lsp index 5e0dce8c2408b4e639c1ea93aae668c2a48ea429..506ba088a42caa1c722f7409f6909374d2fa8060 100644 --- a/ansi-tests/labels.lsp +++ b/ansi-tests/labels.lsp @@ -30,6 +30,17 @@ :bad)) :good) +;;; Keyword parameter initializers are not in the blocked defined +;;; by the local function declaration + +(deftest labels.4a + (block %f + (labels ((%f (&key (x (return-from %f :good))) + nil)) + (%f) + :bad)) + :good) + (deftest labels.5 (labels ((%f () (return-from %f 15) 35)) (%f)) @@ -41,7 +52,8 @@ (block %f (labels ((%f (&aux (x (return-from %f 10))) 20)) - (%f))) + (%f) + :bad)) 10) ;;; The function is visible inside itself @@ -59,6 +71,22 @@ (%f 10)) 20) +;;; Scope of defined function names includes &OPTIONAL parameters + +(deftest labels.7c + (labels ((%f (x &optional (b (%g x))) b) + (%g (y) (+ y y))) + (%f 10)) + 20) + +;;; Scope of defined function names includes &KEY parameters + +(deftest labels.7d + (labels ((%f (x &key (b (%g x))) b) + (%g (y) (+ y y))) + (%f 10)) + 20) + ;;; Keyword arguments (deftest labels.8 (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) diff --git a/ansi-tests/let.lsp b/ansi-tests/let.lsp index 3a63c7fc4d3bc7388122a59bbb03d493cc2f30c5..7e4874658aa629982ca1deeec645bbddf91b7521 100644 --- a/ansi-tests/let.lsp +++ b/ansi-tests/let.lsp @@ -151,156 +151,8 @@ foo)) lexical) -;;; Tests for LET* - -(deftest let*.1 - (let* ((x 0)) x) - 0) - -(deftest let*.2 - (let* ((x 0) (y 1)) (values x y)) - 0 1) - -(deftest let*.3 - (let* ((x 0) (y 1)) (declare (special x y)) (values x y)) - 0 1) - -(deftest let*.4 - (let* ((x 0)) - (let* ((x 1)) - x)) - 1) - -(deftest let*.5 - (let* ((x 0)) - (let* ((#:x 1)) - x)) - 0) - -(deftest let*.6 - (let* ((x 0)) - (declare (special x)) - (let* ((x 1)) - (values x (locally (declare (special x)) x)))) - 1 0) - -(deftest let*.7 - (let* ((x '(a b c))) - (declare (dynamic-extent x)) - x) - (a b c)) - -(deftest let*.8 - (let* ((x 0) (x 1)) x) - 1) - -(deftest let*.9 - (let* (x y z) (values x y z)) - nil nil nil) - -(deftest let*.10 - (let* ((x 1) x) x) - nil) - -(deftest let*.11 - (let* ((x 1)) - (list x - (let* (x x x) - (declare (special x)) - x) - x)) - (1 nil 1)) - -(deftest let*.12 - (let* ((x 1) - (y (1+ x)) - (x (1+ y)) - (z (+ x y))) - (values x y z)) - 3 2 5) - -;;; (deftest let*.13 -;;; (flet ((%f () (declare (special x)) x)) -;;; (let* ((x 1) -;;; (x (1+ (%f)))) -;;; (declare (special x)) -;;; x)) -;;; 2) - -;;; Tests of large number of LET* variables -(deftest let*.14 - (let* ((n 100) - (vars (mapcar #'gensym (make-list n :initial-element "G"))) - (expr `(let* ,(let ((i 0)) - (mapcar #'(lambda (v) (list v (incf i))) vars)) - ,(let ((sumexpr 0)) - (dolist (v vars) - (setq sumexpr `(+ ,v ,sumexpr))) - sumexpr))) - (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 = `(ignore-errors (let* ((,s 17)) ,s)) - unless (eql (eval form) 17) - collect s) +(deftest let.19 + (loop for k in lambda-list-keywords + unless (eql (eval `(let ((,k :foo)) ,k)) :foo) + collect k) nil) - -;;; Check that LET* does not have a tagbody -(deftest let*.16 - (block done - (tagbody - (let () (go 10) 10 (return-from done 'bad)) - 10 - (return-from done 'good))) - good) - -;;; Check that free declarations do not apply to the init forms - -(deftest let*.17 - (let ((x :bad)) - (declare (special x)) - (let ((x :good)) ;; lexical binding - (let* ((y x)) - (declare (special x)) ;; free declaration - y))) - :good) - -(deftest let*.17a - (funcall - (compile - nil - '(lambda () - (let ((x :bad)) - (declare (special x)) - (let ((x :good)) ;; lexical binding - (let* ((y x)) - (declare (special x)) ;; free declaration - y)))))) - :good) - -(deftest let*.18 - (let ((x :bad1) - (z :bad2)) - (declare (special x z)) - (let ((x :good) - (z :good)) ;; lexical bindings - (let* ((y x) - (w z)) - (declare (special x)) ;; free declaration - (values y w)))) - :good - :good) - -(deftest let*.19 - (let ((foo 'special)) - (declare (special foo)) - (let* ((foo 'lexical)) - (locally (declare (special foo))) - foo)) - lexical) - diff --git a/ansi-tests/letstar.lsp b/ansi-tests/letstar.lsp new file mode 100644 index 0000000000000000000000000000000000000000..37eca99979e3f511e2dcbb141df38c028aea2a96 --- /dev/null +++ b/ansi-tests/letstar.lsp @@ -0,0 +1,163 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Jun 24 20:53:36 2005 +;;;; Contains: Tests for LET* + +(in-package :cl-test) + +(deftest let*.1 + (let* ((x 0)) x) + 0) + +(deftest let*.2 + (let* ((x 0) (y 1)) (values x y)) + 0 1) + +(deftest let*.3 + (let* ((x 0) (y 1)) (declare (special x y)) (values x y)) + 0 1) + +(deftest let*.4 + (let* ((x 0)) + (let* ((x 1)) + x)) + 1) + +(deftest let*.5 + (let* ((x 0)) + (let* ((#:x 1)) + x)) + 0) + +(deftest let*.6 + (let* ((x 0)) + (declare (special x)) + (let* ((x 1)) + (values x (locally (declare (special x)) x)))) + 1 0) + +(deftest let*.7 + (let* ((x '(a b c))) + (declare (dynamic-extent x)) + x) + (a b c)) + +(deftest let*.8 + (let* ((x 0) (x 1)) x) + 1) + +(deftest let*.9 + (let* (x y z) (values x y z)) + nil nil nil) + +(deftest let*.10 + (let* ((x 1) x) x) + nil) + +(deftest let*.11 + (let* ((x 1)) + (list x + (let* (x x x) + (declare (special x)) + x) + x)) + (1 nil 1)) + +(deftest let*.12 + (let* ((x 1) + (y (1+ x)) + (x (1+ y)) + (z (+ x y))) + (values x y z)) + 3 2 5) + +;;; (deftest let*.13 +;;; (flet ((%f () (declare (special x)) x)) +;;; (let* ((x 1) +;;; (x (1+ (%f)))) +;;; (declare (special x)) +;;; x)) +;;; 2) + +;;; Tests of large number of LET* variables +(deftest let*.14 + (let* ((n 100) + (vars (mapcar #'gensym (make-list n :initial-element "G"))) + (expr `(let* ,(let ((i 0)) + (mapcar #'(lambda (v) (list v (incf i))) vars)) + ,(let ((sumexpr 0)) + (dolist (v vars) + (setq sumexpr `(+ ,v ,sumexpr))) + sumexpr))) + (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 = `(ignore-errors (let* ((,s 17)) ,s)) + unless (eql (eval form) 17) + collect s) + nil) + +;;; Check that LET* does not have a tagbody +(deftest let*.16 + (block done + (tagbody + (let () (go 10) 10 (return-from done 'bad)) + 10 + (return-from done 'good))) + good) + +;;; Check that free declarations do not apply to the init forms + +(deftest let*.17 + (let ((x :bad)) + (declare (special x)) + (let ((x :good)) ;; lexical binding + (let* ((y x)) + (declare (special x)) ;; free declaration + y))) + :good) + +(deftest let*.17a + (funcall + (compile + nil + '(lambda () + (let ((x :bad)) + (declare (special x)) + (let ((x :good)) ;; lexical binding + (let* ((y x)) + (declare (special x)) ;; free declaration + y)))))) + :good) + +(deftest let*.18 + (let ((x :bad1) + (z :bad2)) + (declare (special x z)) + (let ((x :good) + (z :good)) ;; lexical bindings + (let* ((y x) + (w z)) + (declare (special x)) ;; free declaration + (values y w)))) + :good + :good) + +(deftest let*.19 + (let ((foo 'special)) + (declare (special foo)) + (let* ((foo 'lexical)) + (locally (declare (special foo))) + foo)) + lexical) + +(deftest let*.20 + (loop for k in lambda-list-keywords + unless (eql (eval `(let* ((,k :foo)) ,k)) :foo) + collect k) + nil) diff --git a/ansi-tests/load-data-and-control-flow.lsp b/ansi-tests/load-data-and-control-flow.lsp index f1fd74fcf3528ba7fba7e3636ff39cc57845ddcb..f5cab57694e68d17582b3351609ded015065d3d9 100644 --- a/ansi-tests/load-data-and-control-flow.lsp +++ b/ansi-tests/load-data-and-control-flow.lsp @@ -50,6 +50,7 @@ (load "lambda-list-keywords.lsp") (load "lambda-parameters-limit.lsp") (load "let.lsp") +(load "letstar.lsp") (load "macrolet.lsp") (load "multiple-value-bind.lsp") (load "multiple-value-call.lsp") ;; include multiple-value-list