Support building without PSEUDO-ATOMIC on POSIX safepoints

[sbcl.git] / contrib / sb-cltl2 / tests.lisp

diff --git a/contrib/sb-cltl2/tests.lisp b/contrib/sb-cltl2/tests.lisp
index d710d17..c862c0d 100644 (file)
--- 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,268 @@
    :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))
+
+(deftest macroexpand-all.special-binding
+    (let ((form '(macrolet ((v (x &environment env)
+                             (sb-cltl2:variable-information x env)))
+                  (let* ((x :foo)
+                         (y (v x)))
+                    (declare (special x))
+                    (list y (v x))))))
+      (list (eval form)
+            (eval (sb-cltl2:macroexpand-all form))))
+  ((:special :special) (:special :special)))
+
+(deftest macroexpand-all.symbol-macro-shadowed
+    (let ((form '(macrolet ((v (x &environment env)
+                             (macroexpand x env)))
+                  (symbol-macrolet ((x :bad))
+                    (let* ((x :good)
+                           (y (v x)))
+                      y)))))
+      (list (eval form)
+            (eval (sb-cltl2:macroexpand-all form))))
+  (:good :good))