ProjectChecker.st
branchjv
changeset 3084 0288b25613a9
parent 3081 712525843aef
child 3085 01e9d0823966
--- a/ProjectChecker.st	Mon Sep 10 11:34:08 2012 +0100
+++ b/ProjectChecker.st	Fri Sep 14 13:40:31 2012 +0100
@@ -76,6 +76,12 @@
         yourself.
 
     "Created: / 25-07-2012 / 18:00:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+new
+    "return an initialized instance"
+
+    ^ self basicNew initialize.
 ! !
 
 !ProjectChecker class methodsFor:'checking'!
@@ -87,6 +93,12 @@
     "Created: / 11-01-2012 / 16:46:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
+!ProjectChecker class methodsFor:'others'!
+
+version_CVS
+    ^ '$Header: /cvs/stx/stx/libbasic3/ProjectChecker.st,v 1.7 2012/09/13 17:19:19 vrany Exp $'
+! !
+
 !ProjectChecker methodsFor:'accessing'!
 
 classes: aCollection
@@ -123,7 +135,7 @@
 
 check
 
-    problems := OrderedCollection new.
+    problems removeAll.
     packageDef := ProjectDefinition definitionClassForPackage: package.
     packageDef isNil ifTrue:[
         self addProblem: 
@@ -153,12 +165,12 @@
     "Checks whether all classes listed in #classNamesAndAttributes are present
     and if all present classes are listed"
 
-    |classesInImage classesInDescription onlyInDescription|
+    |classesInImage classesInDescription classesInDescriptionChecked onlyInDescription|
     "WARNING: Copy/paste of ProjectDefinition>>validateDescription"
 
     classesInImage := Smalltalk allClasses select:[:cls | (cls package = self package) and:[cls isPrivate not]].
     "/ classesInDescription := self classes asIdentitySet.
-    classesInDescription := IdentitySet new.
+    classesInDescription := OrderedCollection new.
     ((packageDef compiled_classNamesForPlatform:(OperatingSystem platformName))
     , (packageDef compiled_classNames_common)
     , (packageDef autoloaded_classNames)) do:[:nm |
@@ -173,7 +185,14 @@
         ].
     ].
 
+    classesInDescriptionChecked := OrderedCollection new.
     classesInDescription do:[:eachClass |
+        (classesInDescriptionChecked includes: eachClass) ifTrue:[
+                    self addProblem: 
+                        (ProjectProblem newClassListedMultipleTimes
+                            className: eachClass name)
+        ].
+
         eachClass sharedPoolNames do:[:eachPoolName |
             |pool|
 
@@ -197,6 +216,27 @@
                 ].
             ].
         ].
+
+        eachClass superclass package == eachClass package ifTrue:[
+            (classesInDescriptionChecked includes: eachClass superclass) ifFalse:[
+                self addProblem:
+                    (ProjectProblem newClassListedBeforeItsSuperclass
+                        className: eachClass name;
+                        superClassName: eachClass superclass name)
+            ].
+        ].
+        eachClass sharedPools do:[:eachPool|
+            eachPool package == eachClass package ifTrue:[
+                (classesInDescriptionChecked includes: eachPool) ifFalse:[
+                    self addProblem:
+                        (ProjectProblem newClassListedBeforeItsPool
+                            className: eachClass name;
+                            poolName: eachPool name)
+                ].
+            ].
+        ].
+
+        classesInDescriptionChecked add: eachClass.
     ].
 
     classesInImage ~= classesInDescription ifTrue:[
@@ -216,6 +256,51 @@
     "Created: / 11-01-2012 / 17:14:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
+checkClassesForMethodsInNoProject:classesToCheck 
+    | checker |
+
+    checker := [:cls | 
+        cls 
+            selectorsAndMethodsDo:[:sel :mth | 
+                (mth package isNil or:[ mth package == PackageId noProjectID ]) ifTrue:[
+                    "Sigh, special hack for Expecco"
+                    ((cls name = 'Expecco::AbstractApplication class' and:[ sel = 'flags' ]) or:[
+                     (cls name = 'Expecco::Browser class' and:[ sel = 'flags' ])]) ifFalse:[
+                        self addProblem:(ProjectProblem newMethodInNoPackage className:cls name
+                                    selector:sel).
+                    ]
+                ]
+            ]
+    ].
+    classesToCheck do:[:class | 
+        checker value:class theMetaclass.
+        checker value:class theNonMetaclass.
+    ]
+
+    "Created: / 13-02-2012 / 18:18:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+checkClassesForNonQualifiedSharedPools: classesToCheck 
+
+    classesToCheck do:[:cls|
+        cls sharedPoolNames do:[:poolName|
+            (Smalltalk at: poolName asSymbol) isNil ifTrue:[
+                | ns |
+
+                ns := cls nameSpace.
+                (ns ~~ Smalltalk and:[(ns at: poolName asSymbol) notNil]) ifTrue:[
+                    self addProblem:
+                        (ProjectProblem newClassUsesPoolButItIsNotASharedPool
+                                className: cls name;
+                                poolName: poolName)
+                ]
+            ]
+        ]
+    ].
+
+    "Created: / 13-09-2012 / 16:34:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 checkClassesListedInProjectDefinition: classesToCheck
 
     | classNamesListed |
@@ -284,31 +369,6 @@
     "Created: / 12-01-2012 / 12:41:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
-checkForMethodsInNoProject: classesToCheck
-    | checker |
-
-    checker := [:cls|
-        cls selectorsAndMethodsDo:[:sel :mth|
-            (mth package isNil or:[mth package == PackageId noProjectID]) ifTrue:[
-                "Sigh, special hack for Expecco"
-                (cls name = 'Expecco::AbstractApplication class' and:[sel = 'flags']) ifFalse:[
-                    self addProblem: 
-                        (ProjectProblem newMethodInNoPackage
-                            className: cls name selector: sel).                            
-                ]
-            ]
-        ]
-    ].
-
-    classesToCheck do:[:class|
-        checker value: class theMetaclass.
-        checker value: class theNonMetaclass.
-
-    ]
-
-    "Created: / 13-02-2012 / 18:18:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
 checkMethodCodingStyle: method
     "Checks for various coding style violations such as 'self halt' or
      improper indentation :-)"
@@ -416,7 +476,8 @@
 checkClasses: classesToCheck
 
     self checkClassesListedInProjectDefinition: classesToCheck.
-    self checkForMethodsInNoProject: classesToCheck.
+    self checkClassesForMethodsInNoProject:classesToCheck.
+    self checkClassesForNonQualifiedSharedPools:classesToCheck.
 
     "Created: / 13-02-2012 / 18:18:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
@@ -469,6 +530,24 @@
     "Created: / 11-01-2012 / 16:55:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
+!ProjectChecker methodsFor:'initialization'!
+
+initialize
+    "Invoked when a new instance is created."
+
+    "/ please change as required (and remove this comment)
+    "/ package := nil.
+    "/ packageDef := nil.
+    "/ classes := nil.
+    "/ methods := nil.
+    problems := List new.
+    "/ phase := nil.
+
+    "/ super initialize.   -- commented since inherited method does nothing
+
+    "Modified: / 13-09-2012 / 17:24:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !ProjectChecker methodsFor:'reporting'!
 
 addProblem: aProjectProblem
@@ -482,13 +561,9 @@
 !ProjectChecker class methodsFor:'documentation'!
 
 version
-    ^ '$Id: ProjectChecker.st 1960 2012-09-07 10:45:07Z vranyj1 $'
-!
-
-version_CVS
-    ^ '§Header: /cvs/stx/stx/libbasic3/ProjectChecker.st,v 1.6 2012/07/26 11:59:15 vrany Exp §'
+    ^ '$Header: /cvs/stx/stx/libbasic3/ProjectChecker.st,v 1.7 2012/09/13 17:19:19 vrany Exp $'
 !
 
 version_SVN
-    ^ '$Id: ProjectChecker.st 1960 2012-09-07 10:45:07Z vranyj1 $'
+    ^ '§Id: ProjectChecker.st 1960 2012-09-07 10:45:07Z vranyj1 §'
 ! !