tests/style-warnings.impure.lisp

   1 ;;;; This file is for compiler tests which are not about correctness
   2 ;;;; of the compiler, but are "nice to have" features in a robust
   3 ;;;; implementation of a compiler, such as detection of various style
   4 ;;;; issues, with the nuanced meaning that it is SBCL's notion of poor style,
   5 ;;;; such as things that don't emit as efficient code as possible
   6 ;;;; because of <blah>.
   7
   8 ;;;; This software is part of the SBCL system. See the README file for
   9 ;;;; more information.
  10 ;;;;
  11 ;;;; While most of SBCL is derived from the CMU CL system, the test
  12 ;;;; files (like this one) were written from scratch after the fork
  13 ;;;; from CMU CL.
  14 ;;;;
  15 ;;;; This software is in the public domain and is provided with
  16 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  17 ;;;; more information.
  18
  19 ;; These tests don't work unless compiling
  20 #+interpreter (sb-ext:exit :code 104)
  21
  22 (defun f-with-macro (arg) (list arg))
  23 (defun f2-with-macro (a b) (list a b))
  24 (defun map-f-with-macro (l) (mapcar #'f-with-macro l))
  25 (defun use-f2-with-macro ()
  26   (list (f2-with-macro 1 2) (f2-with-macro 3 4)))
  27
  28 (locally
  29     ;; ignore that we don't know what F is
  30     (declare (muffle-conditions style-warning))
  31   (defun just-call-f (x) (declare (notinline f)) (f x)))
  32
  33 (defun g-with-macro (arg) (list arg))
  34 (defun map-g-with-macro (l)
  35   (declare (notinline g-with-macro))
  36   (mapcar #'g-with-macro l))
  37
  38 (declaim (notinline h-with-macro))
  39 (defun h-with-macro (arg) (list arg))
  40 (defun map-h-with-macro (l) (mapcar #'h-with-macro l))
  41
  42 (test-util:with-test (:name :compiler-macro-order-bug)
  43   ;; There is one explicit NOTINLINE, but we still get a warning.
  44   (assert-signal
  45    (define-compiler-macro f-with-macro (arg) `(list ,arg))
  46    sb-c:compiler-macro-application-missed-warning)
  47   ;; To exercise both cases of the ~:P directive in the warning message.
  48   (assert-signal
  49    (define-compiler-macro f2-with-macro (a b) `(list ,a ,b))
  50    sb-c:compiler-macro-application-missed-warning)
  51
  52   ;; There is a local notinline decl, so no warning about a compiler-macro.
  53   (assert-no-signal
  54     (define-compiler-macro g-with-macro (arg) `(list ,arg)))
  55   ;; There is a global notinline proclamation.
  56   (assert-no-signal
  57     (define-compiler-macro h-with-macro (arg) `(list ,arg))))
  58
  59 (defun g (x) (1- x))
  60 (defun h (x) (1+ x))
  61 (defun use-g (x) (g x))
  62 (defun use-h (x) (list (h x) (h x)))
  63 (with-test (:name :inline-failure-1)
  64   (assert-signal (declaim (inline g h))
  65                  sb-c:inlining-dependency-failure 2))
  66
  67 (declaim (inline fast-guy))
  68 (with-test (:name :inline-failure-2a)
  69   (assert-signal (compile nil '(lambda (x) (fast-guy x)))
  70                  sb-c:inlining-dependency-failure))
  71
  72 (defun zippy (y) y)
  73 (with-test (:name :inline-failure-2b)
  74   (assert-signal
  75    (eval '(defun baz (arg) (declare (inline zippy)) (zippy arg)))
  76    sb-c:inlining-dependency-failure))
  77
  78 (locally (declare (muffle-conditions style-warning))
  79   (defun foofy1 (x) (and (somestruct-p x) 'hi)))
  80
  81 (test-util:with-test (:name :structure-pred-inline-failure)
  82  (assert-signal (defstruct somestruct a b)
  83                 sb-c:inlining-dependency-failure))
  84
  85 (test-util:with-test (:name :redef-macro-same-file)
  86   (let* ((lisp "compiler-impure-tmp.lisp")
  87          (fasl (compile-file-pathname lisp)))
  88     (unwind-protect
  89          (let ((redef-count 0))
  90            (with-open-file (f lisp :direction :output)
  91              (dolist (form '((defmacro glork (x) `(car ,x))
  92                              (define-compiler-macro glorpy (x) `(+ ,x 1))
  93                              (defmacro glork (x) `(first ,x))
  94                              (define-compiler-macro glorpy (x) `(+ ,x 2))))
  95                (print form f)))
  96            (multiple-value-bind (fasl warn fail)
  97                (handler-bind ((sb-int:same-file-redefinition-warning
  98                                (lambda (c) c (incf redef-count))))
  99                  (let ((*error-output* (make-broadcast-stream)))
 100                    (compile-file lisp :print nil :verbose nil)))
 101              (declare (ignore fasl))
 102              (assert (and warn (not fail) (= redef-count 2)))))
 103       (ignore-errors (delete-file lisp))
 104       (ignore-errors (delete-file fasl)))))