From 0f4ac3a8dc1448af61b7110b9830d3b43c2925c4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 7 Apr 2008 20:44:43 -0500
Subject: [PATCH] Slot shadow warnings
---
core/classes/tuple/tuple-tests.factor | 9 +++++++++
core/classes/tuple/tuple.factor | 6 +++---
core/parser/parser.factor | 29 +++++++++++++++++++--------
3 files changed, 33 insertions(+), 11 deletions(-)
diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor
index 729997d3b2..2575570d2f 100755
--- a/core/classes/tuple/tuple-tests.factor
+++ b/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
diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 608fb8cf6c..aa8ef6cdb7 100755
--- a/core/classes/tuple/tuple.factor
+++ b/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 ;
diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index 6d091fd1c0..6c09e08f84 100755
--- a/core/parser/parser.factor
+++ b/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 ;