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 (defun f-with-macro (arg) (list arg))
  20 (defun f2-with-macro (a b) (list a b))
  21 (defun map-f-with-macro (l) (mapcar #'f-with-macro l))
  22 (defun use-f2-with-macro ()
  23   (list (f2-with-macro 1 2) (f2-with-macro 3 4)))
  24
  25 (locally
  26     ;; ignore that we don't know what F is
  27     (declare (muffle-conditions style-warning))
  28   (defun just-call-f (x) (declare (notinline f)) (f x)))
  29
  30 (defun g-with-macro (arg) (list arg))
  31 (defun map-g-with-macro (l)
  32   (declare (notinline g-with-macro))
  33   (mapcar #'g-with-macro l))
  34
  35 (declaim (notinline h-with-macro))
  36 (defun h-with-macro (arg) (list arg))
  37 (defun map-h-with-macro (l) (mapcar #'h-with-macro l))
  38
  39 (test-util:with-test (:name :compiler-macro-order-bug)
  40   ;; There is one explicit NOTINLINE, but we still get a warning.
  41   (assert-signal
  42    (define-compiler-macro f-with-macro (arg) `(list ,arg))
  43    sb-c:compiler-macro-application-missed-warning)
  44   ;; To exercise both cases of the ~:P directive in the warning message.
  45   (assert-signal
  46    (define-compiler-macro f2-with-macro (a b) `(list ,a ,b))
  47    sb-c:compiler-macro-application-missed-warning)
  48
  49   ;; There is a local notinline decl, so no warning about a compiler-macro.
  50   (assert-no-signal
  51     (define-compiler-macro g-with-macro (arg) `(list ,arg)))
  52   ;; There is a global notinline proclamation.
  53   (assert-no-signal
  54     (define-compiler-macro h-with-macro (arg) `(list ,arg))))
  55
  56 (defun g (x) (1- x))
  57 (defun h (x) (1+ x))
  58 (defun use-g (x) (g x))
  59 (defun use-h (x) (list (h x) (h x)))
  60 (with-test (:name :inline-failure-1)
  61   (assert-signal (declaim (inline g h))
  62                  sb-c:inlining-dependency-failure 2))
  63
  64 (declaim (inline fast-guy))
  65 (with-test (:name :inline-failure-2a)
  66   (assert-signal (compile nil '(lambda (x) (fast-guy x)))
  67                  sb-c:inlining-dependency-failure))
  68
  69 (defun zippy (y) y)
  70 (with-test (:name :inline-failure-2b)
  71   (assert-signal
  72    (eval '(defun baz (arg) (declare (inline zippy)) (zippy arg)))
  73    sb-c:inlining-dependency-failure))
  74
  75 (locally (declare (muffle-conditions style-warning))
  76   (defun foofy1 (x) (and (somestruct-p x) 'hi)))
  77
  78 (test-util:with-test (:name :structure-pred-inline-failure)
  79  (assert-signal (defstruct somestruct a b)
  80                 sb-c:inlining-dependency-failure))
  81
  82 (test-util:with-test (:name :redef-macro-same-file)
  83   (let* ((lisp "compiler-impure-tmp.lisp")
  84          (fasl (compile-file-pathname lisp)))
  85     (unwind-protect
  86          (let ((redef-count 0))
  87            (with-open-file (f lisp :direction :output)
  88              (dolist (form '((defmacro glork (x) `(car ,x))
  89                              (define-compiler-macro glorpy (x) `(+ ,x 1))
  90                              (defmacro glork (x) `(first ,x))
  91                              (define-compiler-macro glorpy (x) `(+ ,x 2))))
  92                (print form f)))
  93            (multiple-value-bind (fasl warn fail)
  94                (handler-bind ((sb-int:same-file-redefinition-warning
  95                                (lambda (c) c (incf redef-count))))
  96                  (let ((*error-output* (make-broadcast-stream)))
  97                    (compile-file lisp :print nil :verbose nil)))
  98              (declare (ignore fasl))
  99              (assert (and warn (not fail) (= redef-count 2)))))
 100       (ignore-errors (delete-file lisp))
 101       (ignore-errors (delete-file fasl)))))