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 . ./expect.sh
  15
  16 use_test_subdirectory
  17
  18 tmpfilename="$TEST_FILESTEM.lisp"
  19
  20 # This should fail, but didn't until sbcl-0.6.12.7, with Martin
  21 # Atzmueller's port of Pierre Mai's fixes.
  22 cat > $tmpfilename <<EOF
  23     (in-package :cl-user)
  24     ;; This definition has too many qualifiers, so loading the
  25     ;; DEFMETHOD should fail.
  26     (defmethod zut progn :around ((x integer)) (print "integer"))
  27     (zut 1)
  28 EOF
  29 expect_load_error $tmpfilename
  30
  31 # Even before sbcl-0.6.12.7, this would fail as it should. Let's
  32 # make sure that it still does.
  33 cat > $tmpfilename <<EOF
  34     (in-package :cl-user)
  35     (defgeneric zut (x) (:method-combination progn))
  36     ;; This definition is missing the PROGN qualifier, and so the
  37     ;; DEFMETHOD should fail.
  38     (defmethod zut ((x integer)) (print "integer"))
  39     (zut 1)
  40 EOF
  41 expect_load_error $tmpfilename
  42
  43 # Even before sbcl-0.6.12.7, this would fail as it should, but Martin
  44 # Atzmueller's port of Pierre Mai's fixes caused it to generate more
  45 # correct text in the error message. We can't check that in a regression
  46 # test until AI gets a mite stronger, but at least we can check that
  47 # the problem is still detected.
  48 cat > $tmpfilename <<EOF
  49     (in-package :cl-user)
  50     (defgeneric zut (x) (:method-combination progn))
  51     ;; This definition has too many qualifiers, so loading the
  52     ;; DEFMETHOD should fail.
  53     (defmethod zut progn :around ((x integer)) (print "integer"))
  54     (zut 1)
  55 EOF
  56 expect_load_error $tmpfilename
  57
  58 # Until sbcl-0.7.6.21, PCL signalled spurious STYLE-WARNINGs on
  59 # compilation of this form; the report (bug #191a.) and a patch
  60 # suppressing these were provided by Alexey Dejenka in quick
  61 # succession.
  62 cat > $tmpfilename <<EOF
  63     (in-package :cl-user)
  64     (defclass another-class-with-slots ()
  65       (a-new-slot-name))
  66     (defun foo (x)
  67       (values (setf (slot-value x 'a-new-slot-name) 2)
  68               (slot-value x 'a-new-slot-name)))
  69 EOF
  70 expect_clean_compile $tmpfilename
  71
  72 # success
  73 exit $EXIT_TEST_WIN