selector check w.r.t. subclassResponsibility
authorpenk
Thu, 01 Apr 2004 15:19:59 +0200
changeset 1507 bd29313cd901
parent 1506 57797ad0802c
child 1508 da9642ca353a
selector check w.r.t. subclassResponsibility
Parser.st
--- a/Parser.st	Tue Mar 30 21:48:07 2004 +0200
+++ b/Parser.st	Thu Apr 01 15:19:59 2004 +0200
@@ -2165,13 +2165,13 @@
     ^ nil.
 !
 
-checkSelector:selector inClass:cls
+checkSelector:selector for:receiver inClass:cls
     "check wether a method with selector exists in class cls and
      that the method is not obsolete.
      If cls is nil, check all classes for the selector.
      Return an error string on error or nil on success"
 
-    |err mthd implementor implementors|
+    |err mthd implementor implementors allowed|
 
     cls isNil ifTrue:[
         SystemBrowser isNil ifTrue:[
@@ -2210,9 +2210,23 @@
     ] ifFalse:[
         (mthd sends:#shouldNotImplement) ifTrue:[
             err := 'is not (should not be) implemented'
-        ] ifFalse:[(cls ~~ classToCompileFor and:[mthd sends:#subclassResponsibility]) ifTrue:[
-            "methods in abstract classes may send messages to abstract methods in the same class"
-            err := 'is subclassResponsibility'
+        ] ifFalse:[(mthd sends:#subclassResponsibility) ifTrue:[
+            allowed := cls == classToCompileFor.      "methods in abstract classes may send messages to abstract methods in the same class"
+            allowed ifFalse:[
+                "methods in abstract classes may send messages to abstract methods in meta class"
+                (cls == classToCompileFor class) ifTrue:[
+                    allowed := receiver isMessage and:[receiver selector = 'class']    
+                ].
+            ].
+            allowed ifTrue:[
+                (cls subclasses contains:[:cls | (cls implements:selector) not]) ifTrue:[
+                    "if not all subclasses implement the selector - this is a possible bug"
+                    allowed := false
+                ].
+            ].
+            allowed ifFalse:[
+                err := 'is subclassResponsibility'
+            ].
         ] ifFalse:[mthd isObsolete ifTrue:[
             err := 'is deprecated'.
         ]]].
@@ -2908,7 +2922,7 @@
             selClass := self typeOfNode:receiver.
             selClass notNil ifTrue:[
                 "this could be performed if selClass isNil, but it is too slow"
-                err := self checkSelector:selectorSymbol inClass:selClass.
+                err := self checkSelector:selectorSymbol for:receiver inClass:selClass.
             ].
 
             (receiver isConstant or:[receiver isBlock]) ifTrue:[
@@ -2950,7 +2964,7 @@
                     classToCompileFor allSubclassesDo:[:eachSubclass |
                         subErr isNil ifTrue:[
                             selClass := eachSubclass.
-                            subErr := self checkSelector:selectorSymbol inClass:selClass.     
+                            subErr := self checkSelector:selectorSymbol for:receiver inClass:selClass.     
                         ].
                     ].   
                     subErr notNil ifTrue:[
@@ -2967,13 +2981,13 @@
                 err notNil ifTrue:[
                     classToCompileFor isMeta ifTrue:[
                         err := err, ' for the classes class'.
-                        (self checkSelector:selectorSymbol inClass:classToCompileFor) isNil ifTrue:[
+                        (self checkSelector:selectorSymbol for:receiver inClass:classToCompileFor) isNil ifTrue:[
                             err := err, '...\\...but its implemented for the class itself. You probably do not want the #class message here.'.
                             err := err withCRs.
                         ].
                     ] ifFalse:[
                         err := err, ' for my class'.
-                        (self checkSelector:selectorSymbol inClass:classToCompileFor) isNil ifTrue:[
+                        (self checkSelector:selectorSymbol for:receiver inClass:classToCompileFor) isNil ifTrue:[
                             err := err, '...\\...but its implemented for instances. You may want to remove the #class message.'.
                             err := err withCRs.
                         ].
@@ -7454,7 +7468,7 @@
 !Parser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.417 2004-03-19 13:20:32 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.418 2004-04-01 13:19:59 penk Exp $'
 ! !
 
 Parser initialize!