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