Skip to content
This repository
Browse code

Suppress warnings about possible slot name conflicts with slots from …

…SB-PCL.

When inheriting from STANDARD-CLASS and using common slot names, like
SLOTS or NAME, SBCL signals a style-warning about possible package
problems with slots with the same name from SB-PCL, which is unlikely
to ever cause a problem.
  • Loading branch information...
commit 9c401e48bdf6abb5ec6ff574ca8cafb82fe0ba8a 1 parent b9714d4
Stas Boukarev stassats authored

Showing 1 changed file with 27 additions and 18 deletions. Show diff stats Hide diff stats

  1. +27 18 src/pcl/std-class.lisp
45 src/pcl/std-class.lisp
@@ -957,6 +957,32 @@
957 957 (eq (class-of o) (class-of n)))
958 958 (return nil)))))))
959 959
  960 +(defun style-warn-about-duplicate-slots (class)
  961 + (do* ((slots (slot-value class 'slots) (cdr slots))
  962 + (dupes nil))
  963 + ((null slots)
  964 + (when dupes
  965 + (style-warn
  966 + "~@<slot names with the same SYMBOL-NAME but ~
  967 + different SYMBOL-PACKAGE (possible package problem) ~
  968 + for class ~S:~4I~@:_~<~@{~/sb-impl::print-symbol-with-prefix/~^~:@_~}~:>~@:>"
  969 + class dupes)))
  970 + (let* ((slot-name (slot-definition-name (car slots)))
  971 + (oslots (and (not (eq (symbol-package slot-name)
  972 + *pcl-package*))
  973 + (remove-if
  974 + (lambda (slot-name-2)
  975 + (or (eq (symbol-package slot-name-2)
  976 + *pcl-package*)
  977 + (string/= slot-name slot-name-2)))
  978 + (cdr slots)
  979 + :key #'slot-definition-name))))
  980 + (when oslots
  981 + (pushnew (cons slot-name
  982 + (mapcar #'slot-definition-name oslots))
  983 + dupes
  984 + :test #'string= :key #'car)))))
  985 +
960 986 (defun %update-slots (class eslotds)
961 987 (multiple-value-bind (instance-slots class-slots custom-slots)
962 988 (classify-slotds eslotds)
@@ -982,24 +1008,7 @@
982 1008 (wrapper-slot-table nwrapper) (make-slot-table class eslotds)
983 1009 (wrapper-length nwrapper) nslots
984 1010 (slot-value class 'wrapper) nwrapper)
985   - (do* ((slots (slot-value class 'slots) (cdr slots))
986   - (dupes nil))
987   - ((null slots)
988   - (when dupes
989   - (style-warn
990   - "~@<slot names with the same SYMBOL-NAME but ~
991   - different SYMBOL-PACKAGE (possible package problem) ~
992   - for class ~S:~4I~@:_~<~@{~/sb-impl::print-symbol-with-prefix/~^~:@_~}~:>~@:>"
993   - class dupes)))
994   - (let* ((slot (car slots))
995   - (oslots (remove (slot-definition-name slot) (cdr slots)
996   - :test #'string/=
997   - :key #'slot-definition-name)))
998   - (when oslots
999   - (pushnew (cons (slot-definition-name slot)
1000   - (mapcar #'slot-definition-name oslots))
1001   - dupes
1002   - :test #'string= :key #'car))))
  1011 + (style-warn-about-duplicate-slots class)
1003 1012 (setf (slot-value class 'finalized-p) t)
1004 1013 (unless (eq owrapper nwrapper)
1005 1014 (maybe-update-standard-slot-locations class)))))

0 comments on commit 9c401e4

Please sign in to comment.
Something went wrong with that request. Please try again.