tests/bad-code.pure.lisp

   1 (enable-test-parallelism)
   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.closure)
  93   (assert
  94    (nth-value 1
  95               (checked-compile
  96                `(lambda (a b)
  97                   (flet ((%f1 () b))
  98                     (apply #'%f1 a 2 (list 0))))
  99                :allow-warnings t))))
 100
 101 (with-test (:name (map :values-type))
 102   (assert
 103    (nth-value 1
 104               (checked-compile
 105                `(lambda ()
 106                   (map '* #'+ #(1) #(2)))
 107                :allow-warnings t))))
 108
 109
 110 (with-test (:name :bad-type-specifier)
 111   (assert
 112    (nth-value 1
 113               (checked-compile
 114                `(lambda ()
 115                   (make-array 10 :element-type '((x))))
 116                :allow-warnings t))))
 117
 118 (with-test (:name (make-array :bad-dimensions))
 119   (assert
 120    (nth-value 1
 121               (checked-compile
 122                `(lambda ()
 123                   (make-array '(x)))
 124                :allow-warnings t)))
 125   (assert
 126    (nth-value 1
 127               (checked-compile
 128                `(lambda ()
 129                   (make-array '(-10)))
 130                :allow-warnings t))))
 131
 132 (with-test (:name (make-array :bad-dimensions.2))
 133   (assert
 134    (nth-value 1
 135               (checked-compile
 136                `(lambda ()
 137                   (make-array '(0 . 2)))
 138                :allow-warnings t))))
 139
 140 (with-test (:name (make-array :bad-dimensions.3))
 141   (assert
 142    (nth-value 1
 143               (checked-compile
 144                `(lambda ()
 145                   (make-array '(0 . 2)
 146                               :element-type 'fixnum
 147                               :adjustable t))
 148                :allow-warnings t))))
 149
 150 (with-test (:name (make-array :bad-dimensions.4))
 151   (assert
 152    (nth-value 1
 153               (checked-compile
 154                `(lambda ()
 155                   (make-array (list 'x)))
 156                :allow-warnings t))))
 157
 158 (with-test (:name (make-array :initial-contents :bad-macro))
 159   (assert
 160    (nth-value 1
 161               (checked-compile
 162                `(lambda ()
 163                   (make-array '(10) :initial-contents (do)))
 164                :allow-failure t))))
 165
 166 (with-test (:name (make-array :dimensions :bad-macro))
 167   (assert
 168    (nth-value 1
 169               (checked-compile
 170                `(lambda ()
 171                   (make-array (do)))
 172                :allow-failure t))))
 173
 174 (with-test (:name (make-array :dimensions :bad-propagated-value))
 175   (assert
 176    (nth-value 1
 177               (checked-compile
 178                `(lambda ()
 179                   (let ((x '(("foo"))))
 180                     (make-array (list x) :fill-pointer 0)))
 181                :allow-warnings t))))
 182
 183 (with-test (:name (make-array :dimensions :unraveling-list))
 184   (assert
 185    (nth-value 1
 186               (checked-compile
 187                `(lambda (x)
 188                   (make-array (list (list 10)) :adjustable x))
 189                :allow-warnings t))))
 190
 191 (with-test (:name :&rest-ref-bad-n)
 192   (assert
 193    (nth-value 1
 194               (checked-compile
 195                `(lambda (&rest a) (lambda () (nth nil a)))
 196                :allow-warnings t))))
 197
 198 (with-test (:name :bad-type-specifier-handling)
 199   (multiple-value-bind (fun failure warnings)
 200       (checked-compile
 201        `(lambda (v) (typep v '(unsigned-byte 8 x (error ~s v))))
 202        :allow-warnings t)
 203     (declare (ignore fun))
 204     (assert failure)
 205     (mapcar #'princ-to-string warnings)))
 206
 207 (with-test (:name :ldb-transform-macroexpand)
 208   (assert
 209    (nth-value 1
 210               (checked-compile
 211                `(lambda () (ldb (do) 0))
 212                :allow-failure t))))
 213
 214 (with-test (:name :bad-values-ftype)
 215   (assert
 216    (nth-value 1
 217               (checked-compile
 218                `(lambda () (declare (values 0)))
 219                :allow-warnings t))))
 220
 221 (with-test (:name :bad-progv)
 222   (assert
 223    (nth-value 1
 224               (checked-compile
 225                `(lambda (x) (progv x 1))
 226                :allow-warnings t)))
 227   (assert
 228    (nth-value 1
 229               (checked-compile
 230                `(lambda (x) (progv 1 x))
 231                :allow-warnings t))))
 232
 233 (with-test (:name :coerce-to-nil)
 234   (assert
 235    (nth-value 1
 236               (checked-compile
 237                '(lambda () (coerce (list t) nil))
 238                :allow-warnings t))))
 239
 240 (with-test (:name :unknown-vector-type-conflict)
 241   (assert
 242    (nth-value 1
 243               (checked-compile
 244                '(lambda () (the (vector nonsense-type) nil))
 245                :allow-warnings t
 246                :allow-style-warnings t))))
 247
 248 (with-test (:name :subseq-unknown-vector-type)
 249   (assert
 250    (nth-value 1
 251               (checked-compile
 252                '(lambda () (subseq (the (vector nonsense-type) :x) 0 1))
 253                :allow-warnings t
 254                :allow-style-warnings t))))
 255 (with-test (:name :derive-node-type-unknown-type)
 256   (assert
 257    (nth-value 3
 258               (checked-compile
 259                '(lambda (x)
 260                  (let ((k (make-array 8 :element-type '(unsigned-byte 8))))
 261                    (setf (aref k 0) (the unknown-type (the integer x)))
 262                    (setf k (subseq "y" 0))))
 263                :allow-warnings t
 264                :allow-style-warnings t))))
 265
 266 (with-test (:name :highly-nested-type-error)
 267   (assert (nth-value 1
 268                      (checked-compile
 269                       `(lambda ()
 270                          (macrolet ((macro ()
 271                                       `((lambda (x)
 272                                           (declare (number x))
 273                                           ',@ (loop for cons = (list 1) then (list cons)
 274                                                     repeat 10000
 275                                                     finally (return cons)))
 276                                         t)))
 277                            (macro)))
 278                       :allow-warnings t))))
 279
 280 (with-test (:name :complex-member-type)
 281   (assert (= (length (nth-value 2
 282                                 (checked-compile
 283                                  `(lambda (x)
 284                                     (typep x '(complex (eql t))))
 285                                  :allow-warnings t)))
 286              1)))
 287
 288 (with-test (:name :bad-optionals)
 289   (assert (nth-value 1
 290                      (checked-compile
 291                       '(lambda (z)
 292                         (lambda (&optional (a nil x))
 293                           (declare (type integer x))
 294                           z))
 295                       :allow-warnings t))))
 296
 297 (with-test (:name :recursive-delete-lambda)
 298   (assert (nth-value 1
 299                      (checked-compile
 300                       '(lambda ()
 301                         (flet ((%f ()
 302                                  (lambda ())))
 303                           (%f :a)
 304                           (%f :b)))
 305                       :allow-warnings t)))
 306   (assert (nth-value 1
 307                      (checked-compile
 308                       '(lambda ()
 309                         (flet ((%f ()
 310                                  (lambda (&optional m) m)))
 311                           (%f :a)
 312                           (%f :b)))
 313                       :allow-warnings t))))
 314
 315 (with-test (:name :complex-number)
 316   (checked-compile-and-assert
 317    ()
 318    '(lambda (x)
 319      (typep 1 x))
 320    (('(complex number)) (condition 'error))))
 321
 322 (with-test (:name :aref-type-mismatch)
 323   (assert (nth-value 1
 324                      (checked-compile
 325                       `(lambda (x)
 326                          (svref x *break-on-signals*))
 327                       :allow-warnings t))))
 328
 329 (with-test (:name :unknown-keys-propagation-error-checking.1)
 330   (assert (nth-value 1
 331                      (checked-compile
 332                       `(lambda (x)
 333                          (let ((a :tests))
 334                            (find 1 x a #'eql)))
 335                       :allow-warnings t))))
 336
 337 (with-test (:name :unknown-keys-propagation-error-checking.2)
 338   (assert (nth-value 1
 339                      (checked-compile
 340                       `(lambda ()
 341                          (apply 'find '(3 (1 2 3) :bad t)))
 342                       :allow-warnings t))))
 343
 344
 345 (with-test (:name :sequence-lvar-dimensions-dotted-list)
 346   (assert (nth-value 1
 347                      (checked-compile
 348                       '(lambda () (position 0 '(1 2 0 5 . 5)))
 349                       :allow-warnings t))))
 350
 351 (with-test (:name :source-form-context-dotted-list)
 352   (assert (nth-value 1
 353                      (checked-compile
 354                       '(lambda (y) `(defines ,@ (and x) . ,y))
 355                       :allow-warnings t))))
 356
 357 (with-test (:name :typep-transform-dotted-list)
 358   (assert (nth-value 1
 359                      (checked-compile
 360                       '(lambda (x) (typep x (quote . z)))
 361                       :allow-failure t))))
 362
 363 (with-test (:name :member-transform-dotted-list)
 364   (assert (nth-value 1
 365                      (checked-compile
 366                       '(lambda (x) (member x '(a . b)))
 367                       :allow-warnings t))))
 368
 369 (with-test (:name :encode-universal-time)
 370   (assert (nth-value 3
 371                      (checked-compile
 372                       '(lambda () (encode-universal-time 0 0 0 1 1 1900 -1))
 373                       :allow-style-warnings t))))
 374
 375 (with-test (:name :search-transform-bad-index)
 376   (checked-compile
 377    '(lambda (a)
 378      (search '(0 1 0 2) a :start1 4 :end1 5))))
 379
 380 (with-test (:name :bound-mismatch-union-types)
 381   (assert (nth-value 1
 382                      (checked-compile
 383                       '(lambda (x)
 384                         (declare ((or (simple-string 10) (simple-string 15)) x))
 385                         (aref x 100))
 386                       :allow-warnings t))))
 387
 388 (with-test (:name :uses-with-bad-types)
 389   (assert (nth-value 3
 390                      (checked-compile
 391                       '(lambda (x)
 392                         (the integer (if x 10)))
 393                       :allow-style-warnings t))))
 394
 395 (with-test (:name :constant-modification-local-function)
 396   (assert (= (length (nth-value 2
 397                                 (checked-compile
 398                                  '(lambda ()
 399                                    (flet ((z (a)
 400                                             (setf (aref a 0) 10)))
 401                                      (z #(10))
 402                                      (z #(a))))
 403                                  :allow-warnings t)))
 404              2)))
 405
 406 (with-test (:name :improper-list)
 407   (assert (nth-value 1
 408                      (checked-compile
 409                       '(lambda (x) (concatenate 'string x '(#\a . #\b)))
 410                       :allow-warnings t)))
 411   (assert (nth-value 1
 412                      (checked-compile
 413                       '(lambda (x) (concatenate 'list x '(1 2 . 3)))
 414                       :allow-warnings t)))
 415   (assert (nth-value 1
 416                      (checked-compile
 417                       '(lambda (x) (concatenate 'vector x '(1 2 . 3)))
 418                       :allow-warnings t))))
 419
 420 (with-test (:name :improper-list.2)
 421   (assert (nth-value 1
 422                      (checked-compile
 423                       '(lambda ()
 424                         (member-if #'(lambda (x) (evenp x)) '(1 2 3 . 4)))
 425                       :allow-warnings t)))
 426   (assert (nth-value 1
 427                      (checked-compile
 428                       '(lambda (x)
 429                         (search '(a . b) x))
 430                       :allow-warnings t))))
 431
 432 (with-test (:name :improper-list.3)
 433   (assert (nth-value 1
 434                      (checked-compile
 435                       '(lambda ()
 436                           (let ((x '(1 2 . 3)))
 437                             (position c x)))
 438                       :allow-warnings t))))
 439
 440 (with-test (:name :call-nil)
 441   (checked-compile-and-assert
 442       ()
 443       `(lambda ()
 444          (funcall nil))
 445     (() (condition 'undefined-function)))
 446   (checked-compile-and-assert
 447       ()
 448       `(lambda (x)
 449          (if x
 450              10
 451              (funcall x)))
 452     ((nil) (condition 'undefined-function))))
 453
 454 (with-test (:name (:valid-callable-argument :toplevel-xep))
 455   (assert (nth-value 2 (checked-compile `(lambda (l) (find-if (lambda ()) l))
 456                                         :allow-warnings t))))
 457
 458 (with-test (:name (:valid-callable-argument :handler-bind))
 459   (assert (nth-value 2 (checked-compile
 460                         `(lambda (l) (handler-bind ((error (lambda ()))) (funcall l)))
 461                         :allow-warnings t))))
 462
 463 (with-test (:name (:valid-callable-argument :closure))
 464   (assert (nth-value 2 (checked-compile
 465                         `(lambda (l) (the (function (t)) (lambda () l)))
 466                         :allow-warnings t))))
 467
 468 (with-test (:name :bad-macros)
 469   (assert
 470    (nth-value 1
 471               (checked-compile
 472                `(lambda () (coerce 'integer (restart-bind foo)))
 473                :allow-failure t))))
 474
 475 (with-test (:name :bad-funcall-macros)
 476   (assert
 477    (nth-value 1
 478               (checked-compile
 479               `(lambda () (funcall (lambda)))
 480                :allow-failure t))))
 481
 482 (with-test (:name :inlining-bad-code)
 483   (assert
 484    (nth-value 2
 485               (checked-compile
 486                `(lambda (x &rest args)
 487                   (unless
 488                       (if (eq x :tud)
 489                           (zerop (first args))
 490                           (every #'identity args (every #'identity args)))
 491                     args))
 492                :allow-style-warnings t
 493                :allow-warnings t))))
 494
 495 (with-test (:name :keyword-type-checking)
 496   (assert
 497    (nth-value 2
 498               (checked-compile
 499                `(lambda (x)
 500                   (make-array 10 (list x) x))
 501                :allow-warnings t))))
 502
 503 (with-test (:name :unused-local-functions)
 504   (labels ((find-note (x)
 505              (loop for note in (nth-value 4 (checked-compile x))
 506                    thereis (and (typep note 'sb-ext:code-deletion-note)
 507                                 (eql (search "deleting unused function"
 508                                              (princ-to-string note))
 509                                      0))))
 510            (check (f)
 511              (assert (find-note `(lambda () (flet (,f)))))
 512              (assert (not (find-note `(lambda (x)
 513                                         (flet (,f)
 514                                           (and x (not x) (f)))))))))
 515     (check '(f ()))
 516     (check '(f (&key)))
 517     (check '(f (&key k) k))
 518     (check '(f (&rest args) args))
 519     (check '(f (&optional o) o))
 520     (check '(f (&optional)))))
 521
 522 (with-test (:name :calling-ignored-local)
 523   (assert
 524    (nth-value 3
 525               (checked-compile
 526                `(lambda ()
 527                   (flet ((f ()))
 528                     (declare (ignore #'f))
 529                     (f)))
 530                :allow-style-warnings t))))
 531
 532 (with-test (:name :inappropriate-declare)
 533   (assert
 534    (nth-value 5
 535               (checked-compile
 536                `(lambda (x y) (print-unreadable-object (x y) (declare (optimize))))
 537                :allow-failure t)))
 538   (assert
 539    (nth-value 5
 540               (checked-compile
 541                `(lambda () (restart-bind () (declare (optimize)) 42))
 542                :allow-failure t)))
 543   (assert
 544    (nth-value 5
 545               (checked-compile
 546                `(lambda () (prog1 10 (declare (optimize))))
 547                :allow-failure t))))
 548
 549 (with-test (:name :reduce-initial-value)
 550   (assert
 551    (nth-value 2
 552               (checked-compile
 553                `(lambda ()
 554                   (reduce (lambda (x y)
 555                             (declare (fixnum x))
 556                             (+ x (char-code y)))
 557                           "abc"))
 558                :allow-warnings t)))
 559   (assert
 560    (nth-value 2
 561               (checked-compile
 562                `(lambda ()
 563                   (reduce (lambda (x y)
 564                             (declare (fixnum x))
 565                             (+ x (char-code y)))
 566                           "abc"
 567                           :initial-value #\a))
 568                :allow-warnings t)))
 569   (checked-compile-and-assert
 570       ()
 571       `(lambda (s)
 572          (declare (string s))
 573          (reduce (lambda (x y)
 574                    (declare (fixnum x))
 575                    (+ x (char-code y)))
 576                  s
 577                  :initial-value 0))
 578     (("abc") 294)))
 579
 580 (with-test (:name :reduce-initial-value-from-end)
 581   (checked-compile-and-assert
 582    ()
 583    `(lambda (s)
 584       (reduce #'funcall s :from-end t :initial-value '(1)))
 585    (('(car)) 1))
 586   (checked-compile-and-assert
 587    ()
 588    `(lambda (s e)
 589       (reduce #'funcall s :from-end e :initial-value '(1)))
 590    (('(car) t) 1))
 591   (checked-compile-and-assert
 592    ()
 593    `(lambda (e)
 594       (reduce #'funcall #*1 :from-end e :initial-value 1 :key (lambda (x) x 'list)))
 595    ((t) '(1) :test #'equal))
 596   (checked-compile-and-assert
 597    ()
 598    `(lambda ()
 599       (reduce #'funcall #*1 :from-end t :initial-value 1 :key (lambda (x) x 'list)))
 600    (() '(1) :test #'equal))
 601   (checked-compile-and-assert
 602    ()
 603    `(lambda (f l)
 604       (reduce (the (function ((unsigned-byte 16) (unsigned-byte 8))) f) l
 605               :initial-value 300))
 606    ((#'+ '(1 2 3)) 306)))
 607
 608 (with-test (:name :get-defined-fun-lambda-list-error)
 609   (assert (nth-value 1 (checked-compile '(lambda () (defun x 10)) :allow-failure t))))
 610
 611 (with-test (:name :dolist-mismatch)
 612   (assert (nth-value 2
 613                      (checked-compile '(lambda (x)
 614                                         (dolist (x (the integer x))))
 615                                       :allow-warnings 'sb-int:type-warning))))
 616
 617 (with-test (:name :loop-list-mismatch)
 618   (assert (nth-value 2
 619                      (checked-compile '(lambda (x)
 620                                         (loop for y in (the integer x)))
 621                                       :allow-warnings 'sb-int:type-warning)))
 622   (assert (nth-value 2
 623                      (checked-compile '(lambda (x)
 624                                         (loop for y on (the integer x)))
 625                                       :allow-warnings 'sb-int:type-warning))))
 626
 627 (with-test (:name :mapcar-list-mismatch)
 628   (assert (nth-value 2
 629                      (checked-compile '(lambda (z)
 630                                         (mapl #'car  (the integer z)))
 631                                       :allow-warnings 'sb-int:type-warning)))
 632   (assert (nth-value 2
 633                      (checked-compile '(lambda (f z x)
 634                                         (mapcar f  (the integer z) (the integer x)))
 635                                       :allow-warnings 'sb-int:type-warning))))
 636
 637 (with-test (:name :aref-too-many-subscripts)
 638   (assert (nth-value 2
 639                      (checked-compile `(lambda (a) (aref a ,@(loop repeat array-rank-limit collect 0)))
 640                                       :allow-warnings 'warning))))
 641
 642 (with-test (:name :defclass-bad-type)
 643   (assert (nth-value 2
 644                      (checked-compile
 645                       `(lambda () (defclass ,(gensym) () ((s :type (2)))))
 646                       :allow-warnings 'warning))))
 647
 648 (with-test (:name :macro-as-a-function)
 649   (assert (nth-value 2
 650                      (checked-compile
 651                       `(lambda (x) (find-if 'and x))
 652                       :allow-warnings 'warning)))
 653   (assert (nth-value 2
 654                      (checked-compile
 655                       `(lambda (x) (funcall 'if x))
 656                       :allow-warnings 'warning)))
 657   (assert (nth-value 2
 658                      (checked-compile
 659                       `(lambda (x) (mapcar 'and x))
 660                       :allow-warnings 'warning))))
 661
 662 (with-test (:name :replace-type-mismatch)
 663   (assert (nth-value 2
 664                      (checked-compile
 665                       `(lambda (x y)
 666                          (declare (bit-vector x)
 667                                   (string y))
 668                          (replace x y :start1 10))
 669                       :allow-warnings 'warning))))
 670
 671 (with-test (:name :substitute-type-mismatch)
 672   (assert (nth-value 2
 673                      (checked-compile
 674                       `(lambda (x)
 675                          (declare (string x))
 676                          (substitute 10 #\a x))
 677                       :allow-warnings 'warning))))
 678
 679 (with-test (:name :make-array-initial-contents-type-mismatch)
 680   (assert (nth-value 2
 681                      (checked-compile
 682                       `(lambda (n c)
 683                          (make-array n :element-type 'bit :initial-contents (the string c)))
 684                       :allow-warnings 'warning))))
 685
 686 (with-test (:name :make-array-initial-contents-constant-type-mismatch)
 687   (assert (nth-value 2
 688                      (checked-compile
 689                       `(lambda (n)
 690                          (make-array n :element-type 'bit :initial-contents '(a b c)))
 691                       :allow-warnings 'warning))))
 692
 693
 694 (with-test (:name :replace-constant-type-mismatch)
 695   (assert (nth-value 2
 696                      (checked-compile
 697                       `(lambda (x)
 698                          (declare (string x))
 699                          (replace x '(1 2 3)))
 700                       :allow-warnings 'warning))))
 701
 702 (with-test (:name :fill-type-mismatch)
 703   (assert (nth-value 2
 704                      (checked-compile
 705                       `(lambda (x)
 706                          (declare (string x))
 707                          (fill x 1))
 708                       :allow-warnings 'warning))))
 709
 710 (with-test (:name :vector-push-type-mismatch)
 711   (assert (nth-value 2
 712                      (checked-compile
 713                       `(lambda (x)
 714                          (declare (string x))
 715                          (vector-push 1 x))
 716                       :allow-warnings 'warning)))
 717   (assert (nth-value 2
 718                      (checked-compile
 719                       `(lambda (x)
 720                          (declare (string x))
 721                          (vector-push-extend 1 x))
 722                       :allow-warnings 'warning))))
 723
 724 (with-test (:name :defmethod-malformed-let*)
 725   (assert (nth-value 5
 726                      (checked-compile
 727                       `(lambda ()
 728                          (cl:defmethod ,(gensym) ()
 729                            (let* ((a 1 2))
 730                              a)))
 731                       :allow-failure t))))
 732
 733 (with-test (:name :position-derive-empty-type)
 734   (multiple-value-bind (fun failure warning)
 735       (checked-compile
 736        `(lambda (s)
 737           (position #\a (the simple-string s) :start 4 :end 2))
 738        :allow-warnings t)
 739     (declare (ignore failure))
 740     (assert warning)
 741     (assert-error (funcall fun "abcdef") sb-kernel:bounding-indices-bad-error)))
 742
 743 (with-test (:name :cast-movement-empty-types)
 744   (assert (nth-value 2
 745                      (checked-compile
 746                       `(lambda ()
 747                          (loop for x to 2
 748                                sum (the cons (signum x))))
 749                       :allow-warnings 'warning))))
 750
 751 (with-test (:name :dead-code-after-ir1-conversion)
 752   (assert (nth-value 5
 753                      (checked-compile
 754                       `(lambda (r v)
 755                          (labels ((scan (ch l)
 756                                     (finish l)
 757                                     (let ((d (digit-char-p ch r)))
 758                                       (labels ((fix (x i l)
 759                                                  (if (null l)
 760                                                      (scan 1
 761                                                            (cons (cons x i) nil))
 762                                                      (if i
 763                                                          (fix (+ (* 2 (aref v i)) x) (1+ i) nil)
 764                                                          (scan 1
 765                                                                (cons (cons x i) l))))))
 766                                         (fix d 0 l))))
 767                                   (finish (nil)))))
 768                       :allow-failure t))))
 769
 770 (with-test (:name :muffle-unknown-type)
 771   (assert (nth-value 3
 772                      (checked-compile
 773                       `(lambda () (declare (sb-ext:muffle-conditions foo)) nil)
 774                       :allow-style-warnings t))))