tests/fopcompiler.impure.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; While most of SBCL is derived from the CMU CL system, the test
   5 ;;;; files (like this one) were written from scratch after the fork
   6 ;;;; from CMU CL.
   7 ;;;;
   8 ;;;; This software is in the public domain and is provided with
   9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  10 ;;;; more information.
  11
  12 ;;; These tests don't need to be processed by the compiler before
  13 ;;; being executed.
  14
  15 (defvar *tmp-filename* "fopcompile-test.tmp")
  16
  17 ;; Ensure we can get a style-warning about undefined functions from FOPCOMPILE.
  18 (with-test (:name :fopcompiler-undefined-warning)
  19   (let ((form '(defvar *foo* (i-do-not-exist))))
  20     ;; Assert that the test case is handled by the fopcompiler.
  21     (let ((sb-c::*lexenv* (sb-kernel:make-null-lexenv)))
  22       (assert (sb-c::fopcompilable-p form)))
  23     ;; Make sure some wiseacre didn't defconstant *FOO*
  24     (assert (eq (sb-int:info :variable :kind '*foo*) :unknown))
  25     ;; ... or define the I-DO-NOT-EXIST function.
  26     (assert (eq (sb-int:info :function :where-from 'i-do-not-exist) :assumed))
  27     (with-open-file (stream *tmp-filename*
  28                             :direction :output :if-exists :supersede)
  29       (prin1 form stream))
  30     (multiple-value-bind (output warningp errorp)
  31         (compile-file *tmp-filename*)
  32       (when output
  33         (delete-file output))
  34       (assert (and warningp (not errorp))))))
  35
  36 (ignore-errors (delete-file *tmp-filename*))