From a7091afb6457395312fac3cd43f88efb96249670 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sun, 22 May 2005 01:13:37 +0000 Subject: [PATCH] Add tests for SPECIAL declarations, and more tests for function type specifiers and ftype declarations --- ansi-tests/function.lsp | 83 ++++++++++++++++++++++++++++ ansi-tests/load-eval-and-compile.lsp | 1 + ansi-tests/special.lsp | 33 +++++++++++ 3 files changed, 117 insertions(+) create mode 100644 ansi-tests/special.lsp diff --git a/ansi-tests/function.lsp b/ansi-tests/function.lsp index 6ebd4b22..07ead156 100644 --- a/ansi-tests/function.lsp +++ b/ansi-tests/function.lsp @@ -102,3 +102,86 @@ (declare (type (function () null) f)) (funcall f))) nil) + +(deftest function.15 + (flet ((%f (x) (declare (ignore x)) nil)) + (declare (ftype (function (nil) nil) %f)) + :good) + :good) + +(deftest function.16 + (flet ((%f (x) (declare (ignore x)) nil)) + (declare (ftype (function (t) null) %f)) + (values + (%f 'a) + (locally (declare (ftype (function (integer) t) %f)) + (%f 10)) + (%f 'b))) + nil nil nil) + +(deftest function.17 + (flet ((%f (&optional x) x)) + (declare (ftype (function (&optional integer) t) %f)) + (values (%f) (%f 10) (%f) (%f (1+ most-positive-fixnum)))) + nil 10 nil #.(1+ most-positive-fixnum)) + +(deftest function.18 + (flet ((%f (&rest x) x)) + (declare (ftype (function (&rest symbol) t) %f)) + (values (%f) (%f 'a) (%f 'a 'b 'c))) + () (a) (a b c)) + +(deftest function.19 + (flet ((%f (&key foo bar) (list foo bar))) + (declare (ftype (function (&key (:foo t) (:bar t)) list) %f)) + (values + (%f) (%f :foo 1) + (%f :foo 1 :foo 2) + (%f :bar 'a) + (%f :bar 'a :bar 'b) + (%f :foo 'x :bar 'y) + (%f :bar 'x :foo 'y) + (%f :bar 'x :foo 'y :bar 'z :foo 'w) + )) + (nil nil) + (1 nil) + (1 nil) + (nil a) + (nil a) + (x y) + (y x) + (y x)) + +(deftest function.20 + (flet ((%f (&key foo) foo)) + (declare (ftype (function (&key (:foo t) (:allow-other-keys t)) t) %f)) + (values (%f) (%f :foo 'a) (%f :allow-other-keys nil) + (%f :allow-other-keys t :foo 'z))) + nil a nil z) + +(deftest function.21 + (flet ((%f (&key foo &allow-other-keys) foo)) + (declare (ftype (function (&key (:foo integer)) t) %f)) + (values (%f) (%f :foo 123))) + nil 123) + +(deftest function.22 + (flet ((%f (&key foo &allow-other-keys) foo)) + (declare (ftype (function (&key (:foo integer) (:bar t)) t) %f)) + (values (%f) (%f :foo 123) (%f :bar 'x) (%f :foo 12 :bar 'y))) + nil 123 nil 12) + +(deftest function.23 + (flet ((%f (&key foo &allow-other-keys) foo)) + (declare (ftype (function (&key (:foo integer) &allow-other-keys) t) %f)) + (values (%f) (%f :foo 123) (%f :bar 'x) (%f :foo 12 :bar 'y))) + nil 123 nil 12) + +(deftest function.24 + (flet ((%f (&rest r &key foo bar) (list r foo bar))) + (declare (ftype (function (&rest symbol &key (:foo t) (:bar t)) list) %f)) + (values (%f) (%f :foo 'a) (%f :bar 'b) (%f :bar 'd :foo 'c))) + (nil nil nil) + ((:foo a) a nil) + ((:bar b) nil b) + ((:bar d :foo c) c d)) diff --git a/ansi-tests/load-eval-and-compile.lsp b/ansi-tests/load-eval-and-compile.lsp index 835962cd..422a8d97 100644 --- a/ansi-tests/load-eval-and-compile.lsp +++ b/ansi-tests/load-eval-and-compile.lsp @@ -18,3 +18,4 @@ (load "ignorable.lsp") (load "dynamic-extent.lsp") (load "optimize.lsp") +(load "special.lsp") diff --git a/ansi-tests/special.lsp b/ansi-tests/special.lsp new file mode 100644 index 00000000..3f03af74 --- /dev/null +++ b/ansi-tests/special.lsp @@ -0,0 +1,33 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat May 21 12:51:59 2005 +;;;; Contains: Tests of the declaration SPECIAL + +(in-package :cl-test) + +;;; Many tests for this declaration are in the tests +;;; for specific binding forms. + +(deftest special.1 + (let ((f 1)) + (declare (special f)) + (flet ((f () :good)) + (flet ((g () (f))) + (flet ((f () :bad)) + (g))))) + :good) + +(deftest special.2 + (let ((x 'a)) + (declare (special x)) + (let ((x 'b)) + (values x (locally (declare (special x)) x) x))) + b a b) + +(deftest special.3 + (flet ((%f () (declare (special x10)) x10)) + (let ((x10 'a)) + (declare (special x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12)) + (%f))) + a) + -- GitLab