tests/bad-code.pure.lisp

   1 (in-package :cl-user)
   2
   3 (with-test (:name (make-array :bad-initial-contents))
   4   (assert
   5    (nth-value 1
   6               (checked-compile
   7                `(lambda () (make-array '(1) :initial-contents 'foo))
   8                :allow-warnings t))))
   9
  10 (with-test (:name (make-string-output-stream :bad-element-type))
  11   (assert
  12    (nth-value 1
  13               (checked-compile
  14                `(lambda ()
  15                   (make-string-output-stream :element-type '((x))))
  16                :allow-warnings t))))
  17
  18 (with-test (:name (coerce :bad-type-specifier))
  19   (assert
  20    (nth-value 1
  21               (checked-compile
  22                `(lambda () (coerce (list 2) 1))
  23                :allow-warnings t))))
  24
  25 (with-test (:name :zombie-entry-point-reference)
  26   (assert
  27    (nth-value 1
  28               (checked-compile
  29                `(lambda () (labels ((%f ())) (%f #'%f)))
  30                :allow-warnings t))))
  31 (with-test (:name :ir1-optimize-combination-dead-node)
  32   (assert
  33    (nth-value 1
  34               (checked-compile
  35                `(lambda ()
  36                   (flet ((%f2 (x) x))
  37                     (list (%f2 1)
  38                           (multiple-value-call #'%f2 (values)))))
  39                :allow-warnings t))))
  40
  41 (with-test (:name (:bogus-block &key))
  42   (assert
  43    (nth-value 1
  44               (checked-compile `(lambda (&key (x (block 1 10))) x)
  45                                :allow-failure t))))
  46
  47 (with-test (:name :type-error-reporting)
  48   (assert
  49    (nth-value 1
  50               (checked-compile `(lambda ()
  51                                   (lambda ()
  52                                     (let ((v3 0))
  53                                       (cdr (1- (block b5 (if nil v3 0)))))))
  54                                :allow-warnings t))))
  55
  56 (with-test (:name :dx-on-deleted-nodes)
  57   (assert
  58    (nth-value 1
  59               (checked-compile `(lambda ()
  60                                   (restart-bind ((1 3))))
  61                                :allow-warnings t))))
  62
  63 (with-test (:name :transform-call-dfo-consistency)
  64   (assert
  65    (nth-value 1
  66               (checked-compile
  67                `(lambda ()
  68                   (flet ((%f (&optional x) x))
  69                     (%f)
  70                     ;; Two of the %f calls are erroneous, with an extra argument
  71                     (flet ((%f6 (&key (k (%f (%f -1 (%f -2 -3))))) 0))
  72                       5)))
  73                :allow-warnings t))))
  74
  75 (with-test (:name :&aux-check-variable-names)
  76   (assert
  77    (nth-value 1
  78               (checked-compile
  79                `(lambda (&aux (nil 10))
  80                   nil)
  81                :allow-failure t))))
  82
  83 (with-test (:name :mv-call-too-many-values)
  84   (assert
  85    (nth-value 1
  86               (checked-compile
  87                `(lambda (a)
  88                   (flet ((%f1 (x) x))
  89                     (apply #'%f1 a 2 (list 0))))
  90                :allow-warnings t))))
  91
  92 (with-test (:name :mv-call-too-many-values)
  93   (assert
  94    (nth-value 1
  95               (checked-compile
  96                `(lambda ()
  97                   (make-array (list 'x)))
  98                :allow-warnings t))))
  99
 100 (with-test (:name (map :values-type))
 101   (assert
 102    (nth-value 1
 103               (checked-compile
 104                `(lambda ()
 105                   (map '* #'+ #(1) #(2)))
 106                :allow-warnings t))))
 107
 108
 109 (with-test (:name :bad-type-specifier)
 110   (assert
 111    (nth-value 1
 112               (checked-compile
 113                `(lambda ()
 114                   (make-array 10 :element-type '((x))))
 115                :allow-warnings t))))
 116
 117 (with-test (:name (make-array :bad-dimensions))
 118   (assert
 119    (nth-value 1
 120               (checked-compile
 121                `(lambda ()
 122                   (make-array '(x)))
 123                :allow-warnings t)))
 124   (assert
 125    (nth-value 1
 126               (checked-compile
 127                `(lambda ()
 128                   (make-array '(-10)))
 129                :allow-warnings t))))
 130
 131 (with-test (:name (make-array :bad-dimensions.2))
 132   (assert
 133    (nth-value 1
 134               (checked-compile
 135                `(lambda ()
 136                   (make-array '(0 . 2)))
 137                :allow-warnings t))))
 138
 139 (with-test (:name (make-array :bad-dimensions.3))
 140   (assert
 141    (nth-value 1
 142               (checked-compile
 143                `(lambda ()
 144                   (make-array '(0 . 2)
 145                               :element-type 'fixnum
 146                               :adjustable t))
 147                :allow-warnings t))))
 148
 149 (with-test (:name (make-array :initial-contents :bad-macro))
 150   (assert
 151    (nth-value 1
 152               (checked-compile
 153                `(lambda ()
 154                   (make-array '(10) :initial-contents (do)))
 155                :allow-failure t))))
 156
 157 (with-test (:name (make-array :dimensions :bad-macro))
 158   (assert
 159    (nth-value 1
 160               (checked-compile
 161                `(lambda ()
 162                   (make-array (do)))
 163                :allow-failure t))))
 164
 165 (with-test (:name :&rest-ref-bad-n)
 166   (assert
 167    (nth-value 1
 168               (checked-compile
 169                `(lambda (&rest a) (lambda () (nth nil a)))
 170                :allow-warnings t))))
 171
 172 (with-test (:name :bad-type-specifier-handling)
 173   (multiple-value-bind (fun failure warnings)
 174       (checked-compile
 175        `(lambda (v) (typep v '(unsigned-byte 8 x (error ~s v))))
 176        :allow-warnings t)
 177     (declare (ignore fun))
 178     (assert failure)
 179     (mapcar #'princ-to-string warnings)))
 180
 181 (with-test (:name :ldb-transform-macroexpand)
 182   (assert
 183    (nth-value 1
 184               (checked-compile
 185                `(lambda () (ldb (do) 0))
 186                :allow-failure t))))
 187
 188 (with-test (:name :bad-values-ftype)
 189   (assert
 190    (nth-value 1
 191               (checked-compile
 192                `(lambda () (declare (values 0)))
 193                :allow-warnings t))))
 194
 195 (with-test (:name :bad-progv)
 196   (assert
 197    (nth-value 1
 198               (checked-compile
 199                `(lambda (x) (progv x 1))
 200                :allow-warnings t)))
 201   (assert
 202    (nth-value 1
 203               (checked-compile
 204                `(lambda (x) (progv 1 x))
 205                :allow-warnings t))))
 206
 207 (with-test (:name :coerce-to-nil)
 208   (assert
 209    (nth-value 1
 210               (checked-compile
 211                '(lambda () (coerce (list t) nil))
 212                :allow-warnings t))))
 213
 214 (with-test (:name :unknown-vector-type-conflict)
 215   (assert
 216    (nth-value 1
 217               (checked-compile
 218                '(lambda () (the (vector nonsense-type) nil))
 219                :allow-warnings t
 220                :allow-style-warnings t))))
 221
 222 (with-test (:name :subseq-unknown-vector-type)
 223   (assert
 224    (nth-value 1
 225               (checked-compile
 226                '(lambda () (subseq (the (vector nonsense-type) :x) 0 1))
 227                :allow-warnings t
 228                :allow-style-warnings t))))
 229 (with-test (:name :derive-node-type-unknown-type)
 230   (assert
 231    (nth-value 3
 232               (checked-compile
 233                '(lambda (x)
 234                  (let ((k (make-array 8 :element-type '(unsigned-byte 8))))
 235                    (setf (aref k 0) (the unknown-type (the integer x)))
 236                    (setf k (subseq "y" 0))))
 237                :allow-warnings t
 238                :allow-style-warnings t))))
 239
 240 (with-test (:name :highly-nested-type-error)
 241   (assert (nth-value 1
 242                      (checked-compile
 243                       `(lambda ()
 244                          (macrolet ((macro ()
 245                                       `((lambda (x)
 246                                           (declare (number x))
 247                                           ',@ (loop repeat 10000
 248                                                     for cons = (list 1) then (list cons)
 249                                                     finally (return cons)))
 250                                         t)))
 251                            (macro)))
 252                       :allow-warnings t))))
 253
 254 (with-test (:name :complex-member-type)
 255   (assert (= (length (nth-value 2
 256                                 (checked-compile
 257                                  `(lambda (x)
 258                                     (typep x '(complex (eql t))))
 259                                  :allow-warnings t)))
 260              1)))
 261
 262 (with-test (:name :bad-optionals)
 263   (assert (nth-value 1
 264                      (checked-compile
 265                       '(lambda (z)
 266                         (lambda (&optional (a nil x))
 267                           (declare (type integer x))
 268                           z))
 269                       :allow-warnings t))))
 270
 271 (with-test (:name :recursive-delete-lambda)
 272   (assert (nth-value 1
 273                      (checked-compile
 274                       '(lambda ()
 275                         (flet ((%f ()
 276                                  (lambda ())))
 277                           (%f :a)
 278                           (%f :b)))
 279                       :allow-warnings t)))
 280   (assert (nth-value 1
 281                      (checked-compile
 282                       '(lambda ()
 283                         (flet ((%f ()
 284                                  (lambda (&optional m) m)))
 285                           (%f :a)
 286                           (%f :b)))
 287                       :allow-warnings t))))