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   ;; To exercise both cases of the ~:P directive in the warning message.
  44   (assert-signal
  45    (define-compiler-macro f2-with-macro (a b) `(list ,a ,b)))
  46
  47   ;; There is a local notinline decl, so no warning about a compiler-macro.
  48   (assert-no-signal
  49     (define-compiler-macro g-with-macro (arg) `(list ,arg)))
  50   ;; There is a global notinline proclamation.
  51   (assert-no-signal
  52     (define-compiler-macro h-with-macro (arg) `(list ,arg))))
  53
  54 (defun g (x) (1- x))
  55 (defun h (x) (1+ x))
  56 (defun use-g (x) (g x))
  57 (defun use-h (x) (list (h x) (h x)))
  58 (with-test (:name :inline-failure-1)
  59   (assert-signal (declaim (inline g h))
  60                  sb-c:inlining-dependency-failure))
  61
  62 (declaim (inline fast-guy))
  63 (with-test (:name :inline-failure-2a)
  64   (assert-signal (compile nil '(lambda (x) (fast-guy x)))
  65                  sb-c:inlining-dependency-failure))
  66
  67 (defun zippy (y) y)
  68 (with-test (:name :inline-failure-2b)
  69   (defun baz (arg) (declare (inline zippy)) (zippy arg)))
  70
  71 (locally (declare (muffle-conditions style-warning))
  72   (defun foofy1 (x) (and (somestruct-p x) 'hi)))
  73
  74 (test-util:with-test (:name :structure-pred-inline-failure)
  75  (assert-signal (defstruct somestruct a b)
  76                 sb-c:inlining-dependency-failure))
  77
  78 (test-util:with-test (:name :redef-macro-same-file)
  79   (let* ((lisp "compiler-impure-tmp.lisp")
  80          (fasl (compile-file-pathname lisp)))
  81     (unwind-protect
  82          (let ((redef-count 0))
  83            (with-open-file (f lisp :direction :output)
  84              (dolist (form '((defmacro glork (x) `(car ,x))
  85                              (define-compiler-macro glorpy (x) `(+ ,x 1))
  86                              (defmacro glork (x) `(first ,x))
  87                              (define-compiler-macro glorpy (x) `(+ ,x 2))))
  88                (print form f)))
  89            (multiple-value-bind (fasl warn fail)
  90                (handler-bind ((sb-int:same-file-redefinition-warning
  91                                (lambda (c) c (incf redef-count))))
  92                  (let ((*error-output* (make-broadcast-stream)))
  93                    (compile-file lisp :print nil :verbose nil)))
  94              (declare (ignore fasl))
  95              (assert (and warn (not fail) (= redef-count 2)))))
  96       (ignore-errors (delete-file lisp))
  97       (ignore-errors (delete-file fasl)))))