X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=contrib%2Fsb-cltl2%2Ftests.lisp;h=e32a20a846f812b75d026c023afdb612d1846999;hb=760de025ce5437902c8a289bc831c6f6dc92fd16;hp=d710d17d04a35cc96eb80ddc33dd72c1921ec76a;hpb=002f475dadf4e8f5dceba3a7eee65c56f12f7cd0;p=sbcl.git

diff --git a/contrib/sb-cltl2/tests.lisp b/contrib/sb-cltl2/tests.lisp
index d710d17..e32a20a 100644
--- a/contrib/sb-cltl2/tests.lisp
+++ b/contrib/sb-cltl2/tests.lisp
@@ -65,6 +65,8 @@
     (macroexpand-all '(symbol-macrolet ((srlt '(nil zool))) (testr)))
   (symbol-macrolet ((srlt '(nil zool))) 'zool))
 
+;;;; DECLARATION-INFORMATION
+
 (defmacro dinfo (thing &environment env)
   `',(declaration-information thing env))
 
@@ -90,6 +92,27 @@
   (def compilation-speed)
   (def space))
 
+
+(deftest declaration-information.restrict-compiler-policy.1
+    (with-compilation-unit (:policy '(optimize) :override t)
+      (restrict-compiler-policy 'speed 3)
+      (eval '(cadr (assoc 'speed (dinfo optimize)))))
+  3)
+
+(deftest declaration-information.restrict-compiler-policy.2
+    (with-compilation-unit (:policy '(optimize) :override t)
+      (restrict-compiler-policy 'speed 3)
+      (locally (declare (optimize (speed 2)))
+        (cadr (assoc 'speed (dinfo optimize)))))
+  2)
+
+(deftest declaration-information.restrict-compiler-policy.3
+    (locally (declare (optimize (speed 2)))
+      (with-compilation-unit (:policy '(optimize) :override t)
+        (restrict-compiler-policy 'speed 3)
+        (cadr (assoc 'speed (dinfo optimize)))))
+  2)
+
 (deftest declaration-information.muffle-conditions.default
   (dinfo sb-ext:muffle-conditions)
   nil)
@@ -226,6 +249,11 @@
     (var-info this-is-global-too)
   (:global nil ((always-bound . t))))
 
+(sb-alien:define-alien-variable "errno" sb-alien:int)
+(deftest alien-variable
+    (var-info errno)
+  (:alien nil nil))
+
 ;;;; FUNCTION-INFORMATION
 
 (defmacro fun-info (var &environment env)
@@ -423,3 +451,246 @@
    :lexical))
 
 
+
+;;;;; DEFINE-DECLARATION
+
+(defmacro third-value (form)
+  (sb-int::with-unique-names (a b c)
+    `(multiple-value-bind (,a ,b ,c) ,form
+       (declare (ignore ,a ,b))
+       ,c)))
+
+(deftest define-declaration.declare
+    (progn
+      (define-declaration zaphod (spec env)
+        (declare (ignore env))
+        (values :declare (cons 'zaphod spec)))
+      (locally (declare (zaphod beblebrox))
+         (locally (declare (zaphod and ford))
+           (ct (declaration-information 'zaphod lexenv)))))
+  (zaphod and ford))
+
+
+(deftest define-declaration.declare2
+    (progn
+      (define-declaration zaphod (spec env)
+        (declare (ignore env))
+        (values :declare (cons 'zaphod spec)))
+      (locally
+           (declare (zaphod beblebrox)
+                    (special x))
+         (ct (declaration-information 'zaphod lexenv))))
+  (zaphod beblebrox))
+
+(deftest define-declaration.variable
+    (progn
+      (define-declaration vogon (spec env)
+        (declare (ignore env))
+        (values :variable `((,(cadr spec) vogon-key vogon-value))))
+      (locally (declare (vogon poetry))
+        (ct
+         (assoc 'vogon-key
+                (third-value
+                 (variable-information
+                  'poetry
+                  lexenv))))))
+  (vogon-key . vogon-value))
+
+
+(deftest define-declaration.variable.special
+    (progn
+      (define-declaration vogon (spec env)
+        (declare (ignore env))
+        (values :variable `((,(cadr spec) vogon-key vogon-value))))
+      (let (x)
+        (declare (vogon x))
+        (declare (special x))
+        (ct
+         (assoc 'vogon-key
+                (third-value
+                 (variable-information 'x lexenv))))))
+  (vogon-key . vogon-value))
+
+(deftest define-declaration.variable.special2
+    (progn
+      (define-declaration vogon (spec env)
+        (declare (ignore env))
+        (values :variable `((,(cadr spec) vogon-key vogon-value))))
+      (let (x)
+        (declare (special x))
+        (declare (vogon x))
+        (ct
+         (assoc 'vogon-key
+                (third-value
+                 (variable-information 'x lexenv))))))
+  (vogon-key . vogon-value))
+
+(deftest define-declaration.variable.mask
+    (progn
+      (define-declaration vogon (spec env)
+        (declare (ignore env))
+        (values :variable `((,(cadr spec) vogon-key vogon-value))))
+      (let (x)
+        (declare (vogon x))
+        (let (x)
+          (ct
+           (assoc
+            'vogon-key
+            (third (multiple-value-list (variable-information 'x lexenv))))))))
+  nil)
+
+(deftest define-declaration.variable.macromask
+    (progn
+      (define-declaration vogon (spec env)
+        (declare (ignore env))
+        (values :variable `((,(cadr spec) vogon-key vogon-value))))
+      (let (x)
+        (declare (vogon x))
+        (symbol-macrolet ((x 42))
+          (ct
+           (assoc
+            'vogon-key
+            (third (multiple-value-list (variable-information 'x lexenv))))))))
+  nil)
+
+(deftest define-declaration.variable.macromask2
+    (progn
+      (define-declaration vogon (spec env)
+        (declare (ignore env))
+        (values :variable `((,(cadr spec) vogon-key vogon-value))))
+      (symbol-macrolet ((x 42))
+        (declare (vogon x))
+        (list
+         (let (x)
+           (ct
+            (assoc
+             'vogon-key
+             (third (multiple-value-list (variable-information 'x lexenv))))))
+         (ct
+          (assoc
+           'vogon-key
+           (third (multiple-value-list (variable-information 'x lexenv))))))))
+  (nil (vogon-key . vogon-value)))
+
+(deftest define-declaration.variable.mask2
+    (progn
+      (define-declaration vogon-a (spec env)
+        (declare (ignore env))
+        (values :variable `((,(cadr spec) vogon-key a))))
+      (define-declaration vogon-b (spec env)
+        (declare (ignore env))
+        (values :variable `((,(cadr spec) vogon-key b))))
+      (let (x)
+        (declare (vogon-a x))
+        (let (x)
+          (declare (vogon-b x)))
+        (ct
+         (assoc
+          'vogon-key
+          (third (multiple-value-list (variable-information 'x lexenv)))))))
+  (vogon-key . a))
+
+(deftest define-declaration.variable.specialmask
+    (progn
+      (define-declaration vogon (spec env)
+        (declare (ignore env))
+        (values :variable `((,(cadr spec) vogon-key vogon-value))))
+      (locally
+          (declare (vogon *foo*))
+        (let (*foo*)
+          (ct
+           (assoc
+            'vogon-key
+            (third (multiple-value-list (variable-information '*foo* lexenv))))))))
+  (vogon-key . vogon-value))
+
+
+
+(deftest define-declaration.function
+    (progn
+      (define-declaration sad (spec env)
+        (declare (ignore env))
+        (values :function `((,(cadr spec) emotional-state sad))))
+      (locally (declare (zaphod beblebrox))
+        (locally (declare (sad robot))
+          (ct
+           (assoc 'emotional-state
+                  (third-value (function-information
+                                'robot
+                                lexenv)))))))
+  (emotional-state . sad))
+
+(deftest define-declaration.function.lexical
+    (progn
+      (define-declaration sad (spec env)
+        (declare (ignore env))
+        (values :function `((,(cadr spec) emotional-state sad))))
+      (flet ((robot nil))
+        (locally (declare (sad robot))
+          (ct
+           (assoc 'emotional-state
+                  (third-value (function-information
+                                'robot
+                                lexenv)))))))
+  (emotional-state . sad))
+
+
+(deftest define-declaration.function.lexical2
+    (progn
+      (define-declaration sad (spec env)
+        (declare (ignore env))
+        (values :function `((,(cadr spec) emotional-state sad))))
+      (labels ((robot nil))
+        (declare (sad robot))
+        (ct
+         (assoc 'emotional-state
+                (third-value (function-information
+                              'robot
+                              lexenv))))))
+  (emotional-state . sad))
+
+(deftest define-declaration.function.mask
+    (progn
+      (define-declaration sad (spec env)
+        (declare (ignore env))
+        (values :function `((,(cadr spec) emotional-state sad))))
+      (labels ((robot nil))
+        (declare (sad robot))
+        (labels ((robot nil))
+          (ct
+           (assoc 'emotional-state
+                  (third-value (function-information
+                                'robot
+                                lexenv)))))))
+  nil)
+
+
+(deftest define-declaration.function.mask2
+    (progn
+      (define-declaration sad (spec env)
+        (declare (ignore env))
+        (values :function `((,(cadr spec) emotional-state sad))))
+      (locally
+          (declare (sad robot))
+        (labels ((robot nil))
+          (ct
+           (assoc 'emotional-state
+                  (third-value (function-information
+                                'robot
+                                lexenv)))))))
+  nil)
+
+(deftest define-declaration.function2
+    (progn
+      (define-declaration happy (spec env)
+        (declare (ignore env))
+        (values :function `((,(cadr spec) emotional-state happy))))
+      (locally (declare (zaphod beblebrox))
+        (locally (declare (sad robot))
+          (locally (declare (happy robot))
+            (ct
+             (assoc 'emotional-state
+                    (third-value (function-information
+                                  'robot
+                                  lexenv))))))))
+  (emotional-state . happy))