--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ProjectChecker.st Wed Jan 11 19:20:41 2012 +0100
@@ -0,0 +1,273 @@
+"{ Package: 'stx:libbasic3' }"
+
+Object subclass:#ProjectChecker
+ instanceVariableNames:'package packageDef classes methods problems'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Support-Projects'
+!
+
+Object subclass:#Problem
+ instanceVariableNames:'label description severity data'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:ProjectChecker
+!
+
+!ProjectChecker class methodsFor:'documentation'!
+
+documentation
+"
+ A simple project checker that can search whole projects or individual
+ classes or methods for various problems. TBW...
+
+ NOTE: Not yet finished. This code is meant as a single central entry for all the
+ source code management tools like SCM Utilities, NewSystemBrowser ets. That code
+ will be refactored later once this tools prooves itself useful and mature enough.
+
+ [author:]
+ Jan Vrany <jan.vrany@fit.cvut.cz>
+
+ [instance variables:]
+
+ [class variables:]
+
+ [see also:]
+
+"
+!
+
+examples
+
+ "
+ ProjectChecker check: 'stx:libbasic'
+ "
+! !
+
+!ProjectChecker class methodsFor:'checking'!
+
+check: package
+
+ ^self new check: package
+
+ "Created: / 11-01-2012 / 16:46:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectChecker methodsFor:'accessing'!
+
+package
+ ^ package
+!
+
+package:packageId
+ package := packageId.
+! !
+
+!ProjectChecker methodsFor:'checking'!
+
+check
+
+ self
+ checkPackage;
+ checkClasses;
+ checkMethods
+
+ "Created: / 11-01-2012 / 16:47:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+check: package
+
+ self package: package.
+ self check.
+
+ "Created: / 11-01-2012 / 16:47:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectChecker methodsFor:'checks-individual'!
+
+checkClassListConsistency
+ "Checks whether all classes listed in #classNamesAndAttributes are present
+ and if all present classes are listed"
+
+ <check: #package>
+
+ |classesInImage classesInDescription missingPools onlyInImage 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.
+ ((packageDef compiled_classNamesForPlatform:(OperatingSystem platformName))
+ , (packageDef compiled_classNames_common)
+ , (packageDef autoloaded_classNames)) do:[:nm |
+ |cls|
+
+ cls := Smalltalk at:nm asSymbol.
+ cls isNil ifTrue:[
+ self problem: 'Missing class ', nm
+ description: 'A class is listed in project definition but not present in the system'
+ severity: #error
+ ] ifFalse:[
+ classesInDescription add:cls.
+ ].
+ ].
+
+ missingPools := Set new.
+ classesInDescription do:[:eachClass |
+ eachClass sharedPoolNames do:[:eachPoolName |
+ |pool|
+
+ pool := eachClass nameSpace classNamed:eachPoolName.
+ pool isNil ifTrue:[
+ eachClass nameSpace ~~ Smalltalk ifTrue:[
+ pool := Smalltalk classNamed:eachPoolName.
+ ]
+ ].
+ pool isNil ifTrue:[
+ self
+ problem:'Missing pool: ',eachPoolName
+ description: ('Class %1 uses a pool named %2 but it does not exists' bindWith: eachClass with: pool)
+ severity: #error data: eachClass.
+ missingPools add:eachPoolName.
+ ] ifFalse:[
+ pool isSharedPool ifFalse:[
+ self
+ problem:'Missing pool: ',eachPoolName
+ description: ('Class %1 uses a pool named %2 but it is not actually a shared pool.' bindWith: eachClass with: pool)
+ severity: #error data: eachClass.
+ missingPools add:eachPoolName.
+ ].
+ ].
+ ].
+ ].
+
+ classesInImage ~= classesInDescription ifTrue:[
+ onlyInImage := (classesInImage reject:[:cls | classesInDescription includes:cls]).
+ onlyInImage do:[:cls|
+ self problem: ('Class %1 not listed in project definition' bindWith: cls)
+ description: 'The class %1 not listed in project definition''s #classNamesAndAttributes, therefore it won''t be compiler nor autoladed next time you compile/load project.'
+ severity: #error data: cls.
+ ].
+ onlyInDescription := (classesInDescription reject:[:cls | classesInImage includes:cls]).
+ onlyInDescription do:[:cls|
+ self problem: ('Class %1 is listed in project definition but not present in the system' bindWith: cls)
+ description: 'The class %1 list in project definition''s but not present in the system. This leads to uncompilable package as build files may be incorrectly generated.'
+ severity: #error data: cls.
+ ].
+ ].
+
+ "Created: / 11-01-2012 / 17:14:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectChecker methodsFor:'checks-private'!
+
+checkClasses
+ "Not yet implemented"
+
+ "Created: / 11-01-2012 / 16:55:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+checkMethods
+ "Not yet implemented"
+
+ "Created: / 11-01-2012 / 16:55:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+checkPackage
+
+ packageDef := ProjectDefinition definitionClassForPackage: package.
+ packageDef isNil ifTrue:[
+ self problem: 'Project definition class for package %1 does not exist'
+ description: nil
+ severity: #error.
+ ^self
+ ].
+
+ self checksForScope: #package do:[:selector|
+ self perform: selector withOptionalArgument: package.
+ ]
+
+ "Created: / 11-01-2012 / 16:55:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+checksForScope: scope do: block
+ "Iterates over all checks for given scope and evaluates block with
+ check selector"
+ self class selectorsAndMethodsDo:[:sel :mth|
+ | annotation |
+ annotation := mth annotationAt:#check:.
+ (annotation notNil and:[(annotation argumentAt: 1) == scope]) ifTrue:[
+ block value: sel
+ ]
+ ]
+
+ "Created: / 11-01-2012 / 17:07:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectChecker methodsFor:'reporting'!
+
+problem: label description: description severity: severity
+ "Reports a problem"
+
+ ^self problem: label description: description severity: severity data: nil
+
+ "Created: / 11-01-2012 / 17:24:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+problem: label description: description severity: severity data: data
+ "Reports a problem"
+
+ problems isNil ifTrue:[problems := OrderedCollection new].
+ problems add:
+ (Problem new
+ label: label;
+ description: description;
+ severity: severity;
+ data: data)
+
+ "Created: / 11-01-2012 / 17:17:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectChecker::Problem methodsFor:'accessing'!
+
+data
+ ^ data
+!
+
+data:something
+ data := something.
+!
+
+description
+ ^ description
+!
+
+description:something
+ description := something.
+!
+
+label
+ ^ label
+!
+
+label:something
+ label := something.
+!
+
+severity
+ ^ severity
+!
+
+severity:something
+ severity := something.
+! !
+
+!ProjectChecker class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libbasic3/ProjectChecker.st,v 1.1 2012-01-11 18:20:41 vrany Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libbasic3/ProjectChecker.st,v 1.1 2012-01-11 18:20:41 vrany Exp $'
+! !