--- a/ProjectChecker.st Wed Sep 12 00:14:40 2012 +0200
+++ b/ProjectChecker.st Thu Sep 13 19:19:19 2012 +0200
@@ -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 |
@@ -244,7 +329,14 @@
].
extensionsPresent := OrderedCollection new.
packageDef searchForExtensions do:[:each|
- extensionsPresent add: (Array with: each mclass name with: each selector)
+ "JV@2012-09-07: Do not take Java methods into an account, they
+ should not be listed in extensionMethodNames.
+ They are loaded lazily by JavaClassReader and if listed here,
+ they would cause an error if the package is loaded from source.
+ Sort of a HACK, indeed"
+ each mclass isJavaClass ifFalse:[
+ extensionsPresent add: (Array with: each mclass name with: each selector)
+ ].
].
(extensionsListed \ extensionsPresent) do:[:clsAndSel|
@@ -277,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 :-)"
@@ -409,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>"
!
@@ -462,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
@@ -475,13 +561,9 @@
!ProjectChecker class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/ProjectChecker.st,v 1.6 2012-07-26 11:59:15 vrany Exp $'
-!
-
-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 1938 2012-07-26 10:05:27Z vranyj1 §'
+ ^ '§Id: ProjectChecker.st 1960 2012-09-07 10:45:07Z vranyj1 §'
! !