tests/clos.test.sh

   1 #!/bin/sh
   2
   3 # This software is part of the SBCL system. See the README file for
   4 # more information.
   5 #
   6 # While most of SBCL is derived from the CMU CL system, the test
   7 # files (like this one) were written from scratch after the fork
   8 # from CMU CL.
   9 #
  10 # This software is in the public domain and is provided with
  11 # absolutely no warranty. See the COPYING and CREDITS files for
  12 # more information.
  13
  14 # Check that compiling and loading the file $1 generates an error
  15 # at load time; also that just loading it directly (into the
  16 # interpreter) generates an error.
  17 expect_load_error ()
  18 {
  19     # Test compiling and loading.
  20     $SBCL <<EOF
  21         (compile-file "$1")
  22         ;;; But loading the file should fail.
  23         (multiple-value-bind (value0 value1) (ignore-errors (load *))
  24             (assert (null value0))
  25             (format t "VALUE1=~S (~A)~%" value1 value1)
  26             (assert (typep value1 'error)))
  27         (sb-ext:quit :unix-status 52)
  28 EOF
  29     if [ $? != 52 ]; then
  30         echo compile-and-load $1 test failed: $?
  31         exit 1
  32     fi
  33
  34     # Test loading into the interpreter.
  35     $SBCL <<EOF
  36         (multiple-value-bind (value0 value1) (ignore-errors (load "$1"))
  37             (assert (null value0))
  38             (format t "VALUE1=~S (~A)~%" value1 value1)
  39             (assert (typep value1 'error)))
  40         (sb-ext:quit :unix-status 52)
  41 EOF
  42     if [ $? != 52 ]; then
  43         echo load-into-interpreter $1 test failed: $?
  44         exit 1
  45     fi
  46 }
  47
  48 # Test that a file compiles cleanly, with no ERRORs, WARNINGs or
  49 # STYLE-WARNINGs.
  50 #
  51 # Maybe this wants to be in a compiler.test.sh script?  This function
  52 # was originally written to test APD's patch for slot readers and
  53 # writers not being known to the compiler. -- CSR, 2002-08-14
  54 expect_clean_compile ()
  55 {
  56     $SBCL <<EOF
  57         (multiple-value-bind (pathname warnings-p failure-p)
  58             (compile-file "$1")
  59           (declare (ignore pathname))
  60           (assert (not warnings-p))
  61           (assert (not failure-p))
  62           (sb-ext:quit :unix-status 52))
  63 EOF
  64     if [ $? != 52 ]; then
  65         echo clean-compile $1 test failed: $?
  66         exit 1
  67     fi
  68 }
  69
  70 base_tmpfilename="clos-test-$$-tmp"
  71 tmpfilename="$base_tmpfilename.lisp"
  72 compiled_tmpfilename="$base_tmpfilename.fasl"
  73
  74 # This should fail, but didn't until sbcl-0.6.12.7, with Martin
  75 # Atzmueller's port of Pierre Mai's fixes.
  76 cat > $tmpfilename <<EOF
  77     (in-package :cl-user)
  78     ;; This definition has too many qualifiers, so loading the
  79     ;; DEFMETHOD should fail.
  80     (defmethod zut progn :around ((x integer)) (print "integer"))
  81 EOF
  82 expect_load_error $tmpfilename
  83
  84 # Even before sbcl-0.6.12.7, this would fail as it should. Let's
  85 # make sure that it still does.
  86 cat > $tmpfilename <<EOF
  87     (in-package :cl-user)
  88     (defgeneric zut (x) (:method-combination progn))
  89     ;; This definition is missing the PROGN qualifier, and so the
  90     ;; DEFMETHOD should fail.
  91     (defmethod zut ((x integer)) (print "integer"))
  92 EOF
  93 expect_load_error $tmpfilename
  94
  95 # Even before sbcl-0.6.12.7, this would fail as it should, but Martin
  96 # Atzmueller's port of Pierre Mai's fixes caused it to generate more
  97 # correct text in the error message. We can't check that in a regression
  98 # test until AI gets a mite stronger, but at least we can check that
  99 # the problem is still detected.
 100 cat > $tmpfilename <<EOF
 101     (in-package :cl-user)
 102     (defgeneric zut (x) (:method-combination progn))
 103     ;; This definition has too many qualifiers, so loading the
 104     ;; DEFMETHOD should fail.
 105     (defmethod zut progn :around ((x integer)) (print "integer"))
 106 EOF
 107 expect_load_error $tmpfilename
 108
 109 # Until sbcl-0.7.6.21, PCL signalled spurious STYLE-WARNINGs on
 110 # compilation of this form; the report (bug #191a.) and a patch
 111 # suppressing these were provided by Alexey Dejenka in quick
 112 # succession.
 113 cat > $tmpfilename <<EOF
 114     (in-package :cl-user)
 115     (defclass another-class-with-slots ()
 116       (a-new-slot-name))
 117     (defun foo (x)
 118       (values (setf (slot-value x 'a-new-slot-name) 2)
 119               (slot-value x 'a-new-slot-name)))
 120 EOF
 121 expect_clean_compile $tmpfilename
 122
 123 rm $tmpfilename
 124 rm $compiled_tmpfilename
 125
 126 # success
 127 exit 104