mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
90fdcbf911
If the non-direct duplicate slot's name is not exported from any package, then it must be an internal implementation detail, and in principle the implementor of the new duplicately-named slot cannot know about that internal detail. (This implementation is subsequent to discussions on #sbcl, but the fact that something like this should be necessary is strongly suggested by the explicit handling of *PCL-PACKAGE* in the previous iteration of this warning.) There are still code patterns that will cause this warning to trigger when the user code is not at fault -- for example, when a slot is internally customized in a project with per-file packages, with its name exported from internal packages but not from any public API package, a distinction without any corresponding language support. However, the revision in ths commit will not warn in any new situations, and the warning is removed in the moderately common pattern of all-slot-names-internal with heavy use of mixins. Fixes lp#1943559
92 lines
2.8 KiB
Bash
92 lines
2.8 KiB
Bash
#!/bin/sh
|
|
|
|
# This software is part of the SBCL system. See the README file for
|
|
# more information.
|
|
#
|
|
# While most of SBCL is derived from the CMU CL system, the test
|
|
# files (like this one) were written from scratch after the fork
|
|
# from CMU CL.
|
|
#
|
|
# This software is in the public domain and is provided with
|
|
# absolutely no warranty. See the COPYING and CREDITS files for
|
|
# more information.
|
|
|
|
. ./expect.sh
|
|
|
|
use_test_subdirectory
|
|
|
|
tmpfilename="$TEST_FILESTEM.lisp"
|
|
|
|
# This should fail, but didn't until sbcl-0.6.12.7, with Martin
|
|
# Atzmueller's port of Pierre Mai's fixes.
|
|
cat > $tmpfilename <<EOF
|
|
(in-package :cl-user)
|
|
;; This definition has too many qualifiers, so loading the
|
|
;; DEFMETHOD should fail.
|
|
(defmethod zut progn :around ((x integer)) (print "integer"))
|
|
(zut 1)
|
|
EOF
|
|
expect_load_error $tmpfilename
|
|
|
|
# Even before sbcl-0.6.12.7, this would fail as it should. Let's
|
|
# make sure that it still does.
|
|
cat > $tmpfilename <<EOF
|
|
(in-package :cl-user)
|
|
(defgeneric zut (x) (:method-combination progn))
|
|
;; This definition is missing the PROGN qualifier, and so the
|
|
;; DEFMETHOD should fail.
|
|
(defmethod zut ((x integer)) (print "integer"))
|
|
(zut 1)
|
|
EOF
|
|
expect_load_error $tmpfilename
|
|
|
|
# Even before sbcl-0.6.12.7, this would fail as it should, but Martin
|
|
# Atzmueller's port of Pierre Mai's fixes caused it to generate more
|
|
# correct text in the error message. We can't check that in a regression
|
|
# test until AI gets a mite stronger, but at least we can check that
|
|
# the problem is still detected.
|
|
cat > $tmpfilename <<EOF
|
|
(in-package :cl-user)
|
|
(defgeneric zut (x) (:method-combination progn))
|
|
;; This definition has too many qualifiers, so loading the
|
|
;; DEFMETHOD should fail.
|
|
(defmethod zut progn :around ((x integer)) (print "integer"))
|
|
(zut 1)
|
|
EOF
|
|
expect_load_error $tmpfilename
|
|
|
|
# Until sbcl-0.7.6.21, PCL signalled spurious STYLE-WARNINGs on
|
|
# compilation of this form; the report (bug #191a.) and a patch
|
|
# suppressing these were provided by Alexey Dejenka in quick
|
|
# succession.
|
|
cat > $tmpfilename <<EOF
|
|
(in-package :cl-user)
|
|
(defclass another-class-with-slots ()
|
|
(a-new-slot-name))
|
|
(defun foo (x)
|
|
(values (setf (slot-value x 'a-new-slot-name) 2)
|
|
(slot-value x 'a-new-slot-name)))
|
|
EOF
|
|
expect_clean_compile $tmpfilename
|
|
|
|
# Test that slots with similar names don't trigger warnings if neither
|
|
# name is exported.
|
|
|
|
cat > $tmpfilename <<EOF
|
|
(defpackage "INT"
|
|
(:use "CL")
|
|
(:export "EX"))
|
|
(in-package "INT")
|
|
(defclass ex ()
|
|
((a-slot :initarg :a-slot)))
|
|
(in-package :cl-user)
|
|
(handler-bind ((warning (lambda (c) (error "caught warning: ~A" c))))
|
|
(defclass why (int:ex)
|
|
((a-slot :initarg :a-slot)))
|
|
(sb-mop:finalize-inheritance (find-class 'why)))
|
|
EOF
|
|
expect_clean_cload $tmpfilename
|
|
|
|
# success
|
|
exit $EXIT_TEST_WIN
|