tests/expect.sh

   1 # file to be sourced by scripts wanting to test the compiler
   2
   3 . ./subr.sh
   4
   5 # Check that compiling and loading the file $1 generates an error
   6 # at load time; also that just loading it directly (into the
   7 # interpreter) generates an error.
   8 expect_load_error ()
   9 {
  10     # Test compiling and loading.
  11     run_sbcl <<EOF
  12         (compile-file "$1")
  13         ;;; But loading the file should fail.
  14         (multiple-value-bind (value0 value1) (ignore-errors (load *))
  15             (assert (null value0))
  16             (format t "VALUE1=~S (~A)~%" value1 value1)
  17             (assert (typep value1 'error)))
  18         (sb-ext:quit :unix-status $EXIT_LISP_WIN)
  19 EOF
  20     check_status_maybe_lose compile-and-load $?
  21
  22     # Test loading into the interpreter.
  23     run_sbcl <<EOF
  24         (multiple-value-bind (value0 value1) (ignore-errors (load "$1"))
  25             (assert (null value0))
  26             (format t "VALUE1=~S (~A)~%" value1 value1)
  27             (assert (typep value1 'error)))
  28         (sb-ext:quit :unix-status $EXIT_LISP_WIN)
  29 EOF
  30     check_status_maybe_lose load-into-interpreter $?
  31 }
  32
  33 expect_clean_cload ()
  34 {
  35     expect_clean_compile $1
  36     run_sbcl <<EOF
  37         (multiple-value-bind (value0 value1)
  38             (ignore-errors (load (compile-file-pathname "$1")))
  39           (assert value0)
  40           (assert (null value1)))
  41         (sb-ext:quit :unix-status $EXIT_LISP_WIN)
  42 EOF
  43     check_status_maybe_lose load-compiled $?
  44 }
  45
  46 # Test that a file compiles cleanly, with no ERRORs, WARNINGs or
  47 # STYLE-WARNINGs.
  48 expect_clean_compile ()
  49 {
  50     run_sbcl <<EOF
  51         (multiple-value-bind (pathname warnings-p failure-p)
  52             (compile-file "$1")
  53           (declare (ignore pathname))
  54           (assert (not warnings-p))
  55           (assert (not failure-p))
  56           (sb-ext:quit :unix-status $EXIT_LISP_WIN))
  57 EOF
  58     check_status_maybe_lose clean-compile $?
  59 }
  60
  61 expect_warned_compile ()
  62 {
  63     run_sbcl <<EOF
  64         (multiple-value-bind (pathname warnings-p failure-p)
  65             (compile-file "$1")
  66           (declare (ignore pathname))
  67           (assert warnings-p)
  68           (assert (not failure-p))
  69           (sb-ext:quit :unix-status $EXIT_LISP_WIN))
  70 EOF
  71     check_status_maybe_lose warn-compile $?
  72 }
  73
  74 expect_failed_compile ()
  75 {
  76     run_sbcl <<EOF
  77         (multiple-value-bind (pathname warnings-p failure-p)
  78             (compile-file "$1")
  79           (declare (ignore pathname warnings-p))
  80           (assert failure-p)
  81           (sb-ext:quit :unix-status $EXIT_LISP_WIN))
  82 EOF
  83     check_status_maybe_lose fail-compile $?
  84 }
  85
  86 expect_aborted_compile ()
  87 {
  88     run_sbcl <<EOF
  89         (let* ((lisp "$1")
  90                (fasl (compile-file-pathname lisp)))
  91           (multiple-value-bind (pathname warnings-p failure-p)
  92               (compile-file "$1" :print t)
  93             (assert (not pathname))
  94             (assert failure-p)
  95             (assert warnings-p)
  96             (assert (not (probe-file fasl))))
  97           (sb-ext:quit :unix-status $EXIT_LISP_WIN))
  98 EOF
  99     check_status_maybe_lose abort-compile $?
 100 }
 101
 102 fail_on_condition_during_compile ()
 103 {
 104     run_sbcl <<EOF
 105         (handler-bind (($1 #'error))
 106           (compile-file "$2")
 107           (sb-ext:quit :unix-status $EXIT_LISP_WIN))
 108 EOF
 109     check_status_maybe_lose "fail-on-condition_$1" $?
 110 }
 111
 112 expect_condition_during_compile ()
 113 {
 114     run_sbcl <<EOF
 115         (handler-bind (($1 (lambda (c)
 116                              (declare (ignore c))
 117                              (sb-ext:quit :unix-status $EXIT_LISP_WIN))))
 118           (compile-file "$2"))
 119 EOF
 120     check_status_maybe_lose "expect-condition_$1" $?
 121 }
 122