Commit 8a6bbabf authored by pfdietz's avatar pfdietz

Some more test patches (for implicit block in FLET and LABELS), new tests for...

Some more test patches (for implicit block in FLET and LABELS), new tests for those, and tests that lambda-list-keywords can be bound
parent 9e89272d
......@@ -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))
......
......@@ -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)))))
......
......@@ -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)
;-*- 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)
......@@ -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
......
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