Skip to content
Snippets Groups Projects
Commit 8a6bbabf authored by pfdietz's avatar pfdietz
Browse files

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
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment