Slot shadow warnings

core/classes/tuple/tuple-tests.factor

@@ -529,3 +529,12 @@ TUPLE: another-forget-accessors-test ;
 ] unit-test
 
 [ t ] [ \ another-forget-accessors-test class? ] unit-test
+
+! Shadowing test
+[ f ] [
+    t parser-notes? [
+        [
+            "IN: classes.tuple.tests TUPLE: shadow-1 a b ; TUPLE: shadow-2 < shadow-1 a b ;" eval
+        ] with-string-writer empty?
+    ] with-variable
+] unit-test

core/classes/tuple/tuple.factor

@@ -55,6 +55,9 @@ PRIVATE>
     "slot-names" word-prop
     [ dup array? [ second ] when ] map ;
 
+: all-slot-names ( class -- slots )
+    superclasses [ slot-names ] map concat \ class prefix ;
+
 <PRIVATE
 
 : tuple= ( tuple1 tuple2 -- ? )
@@ -119,9 +122,6 @@ PRIVATE>
 : define-tuple-layout ( class -- )
     dup make-tuple-layout "layout" set-word-prop ;
 
-: all-slot-names ( class -- slots )
-    superclasses [ slot-names ] map concat \ class prefix ;
-
 : compute-slot-permutation ( class old-slot-names -- permutation )
     >r all-slot-names r> [ index ] curry map ;
 

core/parser/parser.factor

@@ -1,12 +1,11 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays definitions generic assocs kernel math
-namespaces prettyprint sequences strings vectors words
-quotations inspector io.styles io combinators sorting
-splitting math.parser effects continuations debugger 
-io.files io.streams.string vocabs io.encodings.utf8
-source-files classes hashtables compiler.errors compiler.units
-accessors ;
+USING: arrays definitions generic assocs kernel math namespaces
+prettyprint sequences strings vectors words quotations inspector
+io.styles io combinators sorting splitting math.parser effects
+continuations debugger io.files io.streams.string vocabs
+io.encodings.utf8 source-files classes classes.tuple hashtables
+compiler.errors compiler.units accessors ;
 IN: parser
 
 TUPLE: lexer text line line-text line-length column ;
@@ -285,13 +284,27 @@ M: no-word-error summary
 : CREATE-METHOD ( -- method )
     scan-word bootstrap-word scan-word create-method-in ;
 
+: shadowed-slots ( superclass slots -- shadowed )
+    >r all-slot-names r> seq-intersect ;
+
+: check-slot-shadowing ( class superclass slots -- )
+    shadowed-slots [
+        [
+            "Definition of slot ``" %
+            %
+            "'' in class ``" %
+            word-name %
+            "'' shadows a superclass slot" %
+        ] "" make note.
+    ] with each ;
+
 : parse-tuple-definition ( -- class superclass slots )
     CREATE-CLASS
     scan {
         { ";" [ tuple f ] }
         { "<" [ scan-word ";" parse-tokens ] }
         [ >r tuple ";" parse-tokens r> prefix ]
-    } case ;
+    } case 3dup check-slot-shadowing ;
 
 ERROR: staging-violation word ;