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
   9 # In bash,
  10 #
  11 #   function callee() { cat }
  12 #   function caller() { callee bar <<EOF \n $1 \n EOF \n }
  13 #   caller foo
  14 #
  15 # will print "foo".  In certain versions of sh, however, it will print
  16 # "bar" instead.  Hence variables f and c in the following code.
  17
  18 expect_load_error ()
  19 {
  20     # Test compiling and loading.
  21     f="$1"
  22     run_sbcl <<EOF
  23         (compile-file "$f")
  24         ;;; But loading the file should fail.
  25         (multiple-value-bind (value0 value1) (ignore-errors (load *))
  26             (assert (null value0))
  27             (format t "VALUE1=~S (~A)~%" value1 value1)
  28             (assert (typep value1 'error)))
  29         (sb-ext:exit :code $EXIT_LISP_WIN)
  30 EOF
  31     check_status_maybe_lose compile-and-load $?
  32
  33     # Test loading into the interpreter.
  34     f="$1"
  35     run_sbcl <<EOF
  36         (multiple-value-bind (value0 value1) (ignore-errors (load "$f"))
  37             (assert (null value0))
  38             (format t "VALUE1=~S (~A)~%" value1 value1)
  39             (assert (typep value1 'error)))
  40         (sb-ext:exit :code $EXIT_LISP_WIN)
  41 EOF
  42     check_status_maybe_lose load-into-interpreter $?
  43 }
  44
  45 expect_clean_cload ()
  46 {
  47     expect_clean_compile $1
  48     f="$1"
  49     run_sbcl <<EOF
  50         (multiple-value-bind (value0 value1)
  51             (ignore-errors (load (compile-file-pathname "$f")))
  52           (assert value0)
  53           (assert (null value1)))
  54         (sb-ext:exit :code $EXIT_LISP_WIN)
  55 EOF
  56     check_status_maybe_lose load-compiled $?
  57 }
  58
  59 # Test that a file compiles cleanly, with no ERRORs, WARNINGs or
  60 # STYLE-WARNINGs.
  61 expect_clean_compile ()
  62 {
  63     f="$1"
  64     run_sbcl <<EOF
  65         (multiple-value-bind (pathname warnings-p failure-p)
  66             (compile-file "$f")
  67           (declare (ignore pathname))
  68           (assert (not warnings-p))
  69           (assert (not failure-p))
  70           (sb-ext:exit :code $EXIT_LISP_WIN))
  71 EOF
  72     check_status_maybe_lose clean-compile $?
  73 }
  74
  75 expect_warned_compile ()
  76 {
  77     f="$1"
  78     run_sbcl <<EOF
  79         (multiple-value-bind (pathname warnings-p failure-p)
  80             (compile-file "$f")
  81           (declare (ignore pathname))
  82           (assert warnings-p)
  83           (assert (not failure-p))
  84           (sb-ext:exit :code $EXIT_LISP_WIN))
  85 EOF
  86     check_status_maybe_lose warn-compile $?
  87 }
  88
  89 expect_failed_compile ()
  90 {
  91     f="$1"
  92     run_sbcl <<EOF
  93         (multiple-value-bind (pathname warnings-p failure-p)
  94             (compile-file "$f")
  95           (declare (ignore pathname warnings-p))
  96           (assert failure-p)
  97           (sb-ext:exit :code $EXIT_LISP_WIN))
  98 EOF
  99     check_status_maybe_lose fail-compile $?
 100 }
 101
 102 expect_aborted_compile ()
 103 {
 104     f="$1"
 105     run_sbcl <<EOF
 106         (let* ((lisp "$f")
 107                (fasl (compile-file-pathname lisp)))
 108           (multiple-value-bind (pathname warnings-p failure-p)
 109               (compile-file "$f" :print t)
 110             (assert (not pathname))
 111             (assert failure-p)
 112             (assert warnings-p)
 113             (assert (not (probe-file fasl))))
 114           (sb-ext:exit :code $EXIT_LISP_WIN))
 115 EOF
 116     check_status_maybe_lose abort-compile $?
 117 }
 118
 119 fail_on_condition_during_compile ()
 120 {
 121     c="$1"
 122     f="$2"
 123     run_sbcl <<EOF
 124         (handler-bind (($c #'error))
 125           (compile-file "$f")
 126           (sb-ext:exit :code $EXIT_LISP_WIN))
 127 EOF
 128     check_status_maybe_lose "fail-on-condition_$1" $?
 129 }
 130
 131 expect_condition_during_compile ()
 132 {
 133     c="$1"
 134     f="$2"
 135     run_sbcl <<EOF
 136         (handler-bind (($c (lambda (c)
 137                              (declare (ignore c))
 138                              (sb-ext:exit :code $EXIT_LISP_WIN))))
 139           (compile-file "$f"))
 140 EOF
 141     check_status_maybe_lose "expect-condition_$1" $?
 142 }
 143