tests/constantp.pure.lisp

   1 (in-package :cl-user)
   2
   3 (with-test (:name :constantp-conservatively-nil)
   4   (assert (not (constantp '(if))))
   5   (assert (not (constantp '(if . 1))))
   6   (assert (not (constantp '(if 1))))
   7   (assert (not (constantp '(if 1 . 2))))
   8   (assert (not (constantp '(if 1 2 . 3))))
   9   (assert (not (constantp '(if 1 2 3 4)))))
  10
  11 (with-test (:name (:bogus-block constantp))
  12   (assert
  13    (nth-value 1
  14               (checked-compile `(lambda (&optional (x (block 1 10))) x)
  15                                :allow-failure t)))
  16   (assert (not (constantp '(block 1 10)))))
  17
  18 (with-test (:name :progv)
  19   (assert
  20    (not (constantp '(progv '(*s*) nil *s*))))
  21   (assert
  22    (not (constantp '(progv 10 '(10) 10))))
  23   (assert
  24    (not (constantp '(progv '(10) 10 10))))
  25   (assert
  26    (not (constantp '(progv '(10) '(10) 10))))
  27   (assert
  28    (not (constantp '(progv '(10 . 20) '(10) 10))))
  29   (assert
  30    (not (constantp '(progv '(10) '(10 . 30) 10))))
  31   (assert
  32    (not (constantp '(progv '(/) '(10) /))))
  33   (assert
  34    (not (constantp '(progv '(pi) '(10) 10))))
  35   (assert
  36    (not (constantp '(progv '(sb-c::**world-lock**) '(10) 10)))))
  37
  38 (with-test (:name :the)
  39   (assert
  40    (not (constantp '(the (satisfies eval) 10))))
  41   (assert
  42    (not (constantp '(the (array abc) #()))))
  43   (assert
  44    (not (constantp '(the (cons (satisfies error)) '("a"))))))
  45
  46 (with-test (:name :bad-macros)
  47   (assert
  48    (nth-value 1
  49               (checked-compile
  50               `(lambda () (coerce 'integer (restart-bind foo)))
  51                :allow-failure t))))