--- a/ProjectChecker.st Mon Mar 12 14:23:22 2012 +0100
+++ b/ProjectChecker.st Wed Mar 14 17:25:24 2012 +0100
@@ -1,3 +1,14 @@
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
"{ Package: 'stx:libbasic3' }"
Object subclass:#ProjectChecker
@@ -7,15 +18,22 @@
category:'System-Support-Projects'
!
-Object subclass:#Problem
- instanceVariableNames:'label description severity data'
- classVariableNames:''
- poolDictionaries:''
- privateIn:ProjectChecker
+!ProjectChecker class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
!
-!ProjectChecker class methodsFor:'documentation'!
-
documentation
"
A simple project checker that can search whole projects or individual
@@ -23,7 +41,7 @@
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.
+ will be refactored later once this tool prooves itself useful and mature enough.
[author:]
Jan Vrany <jan.vrany@fit.cvut.cz>
@@ -41,6 +59,8 @@
"
ProjectChecker check: 'stx:libbasic'
+ ProjectChecker check: 'stx:libtool'
+ ProjectChecker check: 'stx:libbasic3'
"
! !
@@ -53,20 +73,53 @@
"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.4 2012-03-14 16:25:24 vrany Exp $'
+! !
+
!ProjectChecker methodsFor:'accessing'!
+classes: aCollection
+ classes := aCollection.
+
+ "Created: / 13-02-2012 / 17:06:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+methods
+ ^ methods
+!
+
+methods:something
+ methods := something.
+!
+
package
^ package
!
package:packageId
package := packageId.
+!
+
+problems
+ ^ problems ? #()
+
+ "Modified: / 23-02-2012 / 15:14:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectChecker methodsFor:'checking'!
check
+ packageDef := ProjectDefinition definitionClassForPackage: package.
+ packageDef isNil ifTrue:[
+ self addProblem:
+ (ProjectProblem newProjectDefinitionDoesNotExist package: package).
+ ^self
+ ].
+
self
checkPackage;
checkClasses;
@@ -89,7 +142,7 @@
"Checks whether all classes listed in #classNamesAndAttributes are present
and if all present classes are listed"
- |classesInImage classesInDescription missingPools onlyInImage onlyInDescription|
+ |classesInImage classesInDescription onlyInImage onlyInDescription|
"WARNING: Copy/paste of ProjectDefinition>>validateDescription"
classesInImage := Smalltalk allClasses select:[:cls | (cls package = self package) and:[cls isPrivate not]].
@@ -102,15 +155,13 @@
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
+ self addProblem:
+ (ProjectProblem newClassListedButDoesNotExist className: nm)
] ifFalse:[
classesInDescription add:cls.
].
].
- missingPools := Set new.
classesInDescription do:[:eachClass |
eachClass sharedPoolNames do:[:eachPoolName |
|pool|
@@ -122,18 +173,16 @@
]
].
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.
+ self addProblem:
+ (ProjectProblem newClassUsesPoolButItDoesNotExist
+ className: eachClass name;
+ poolName: 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.
+ self addProblem:
+ (ProjectProblem newClassUsesPoolButItIsNotASharedPool
+ className: eachClass name;
+ poolName: eachPoolName).
].
].
].
@@ -142,21 +191,35 @@
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.
+ self addProblem:
+ (ProjectProblem newClassNotListed className: cls name).
].
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.
+ self addProblem:
+ (ProjectProblem newClassListedButDoesNotExist className: cls name)
].
].
"Created: / 11-01-2012 / 17:14:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+checkClassesListedInProjectDefinition: classesToCheck
+
+ | classNamesListed |
+
+ classNamesListed := packageDef classNames.
+
+ classesToCheck do:[:class|
+ (class isPrivate not and:[(classNamesListed includes: class name) not]) ifTrue:[
+ self addProblem:
+ (ProjectProblem newClassNotListed className: class name).
+ ]
+ ].
+
+ "Created: / 13-02-2012 / 18:18:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
checkExtensionsListConsistency
"Checks whether all extensions listed in #extensionMethodNames are present
and if all extension methods are listed"
@@ -173,15 +236,15 @@
].
(extensionsListed \ extensionsPresent) do:[:clsAndSel|
- self problem: ('Missing %1>>%2 extension method' bindWith: clsAndSel first with: clsAndSel second)
- description: ('An extension method %1>>%2 is listed in #extensionMethodNames but not present in image' bindWith: clsAndSel first with: clsAndSel second)
- severity: #warning data: clsAndSel.
+ self addProblem:
+ (ProjectProblem newExtensionMethodListedButDoesNotExist
+ className: clsAndSel first selector: clsAndSel second).
].
(extensionsPresent \ extensionsListed) do:[:clsAndSel|
- self problem: ('%1>>%2 extension method not in list' bindWith: clsAndSel first with: clsAndSel second)
- description: ('An extension method %1>>%2 present in image but not listed in #extensionMethodNames' bindWith: clsAndSel first with: clsAndSel second)
- severity: #warning data: clsAndSel.
+ self addProblem:
+ (ProjectProblem newExtensionMethodNotListed
+ className: clsAndSel first selector: clsAndSel second).
].
"Created: / 12-01-2012 / 12:31:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -193,23 +256,58 @@
packageDef searchForExtensions do:[:mthd|
(packageDef preRequisites includes: mthd mclass package) ifFalse:[
- self problem: ('%3 required by extension method but not in prerequisites' bindWith: mthd mclass package)
- description: ('An extension method %1>>%2 extends class in package %3 but the package is not listed in package''s prerequisited. This leads into missing methods and strange bugs when application is compiled and run!!' bindWith: mthd class with: mthd selector with: mthd class package)
- severity: #error data: mthd
+"/ self problem: ('%3 required by extension method but not in prerequisites' bindWith: mthd mclass package)
+"/ description: ('An extension method %1>>%2 extends class in package %3 but the package is not listed in package''s prerequisited. This leads into missing methods and strange bugs when application is compiled and run!!' bindWith: mthd class with: mthd selector with: mthd class package)
+"/ severity: #error data: mthd
].
]
"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:[
+ 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>"
! !
!ProjectChecker methodsFor:'checks-private'!
checkClasses
- "Not yet implemented"
+
+ classes notNil ifTrue:[
+ self checkClasses: classes
+ ] ifFalse:[
+ self checkClasses: (Smalltalk allClasses select:[:cls | (cls package = self package)]).
+ ].
"Created: / 11-01-2012 / 16:55:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+checkClasses: classesToCheck
+
+ self checkClassesListedInProjectDefinition: classesToCheck.
+ self checkForMethodsInNoProject: classesToCheck.
+
+ "Created: / 13-02-2012 / 18:18:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
checkMethods
"Not yet implemented"
@@ -218,13 +316,6 @@
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 checkClassListConsistency.
self checkExtensionsListConsistency.
self checkExtensionsPrerequisites.
@@ -236,83 +327,20 @@
!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"
-
+addProblem: aProjectProblem
+ aProjectProblem package: self package.
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.
-!
+ problems add: aProjectProblem
-description
- ^ description
-!
-
-description:something
- description := something.
-!
-
-label
- ^ label
-!
-
-label:something
- label := something.
-!
-
-severity
- ^ severity
-!
-
-severity:something
- severity := something.
-! !
-
-!ProjectChecker::Problem methodsFor:'printing & storing'!
-
-printOn:aStream
- "append a printed representation if the receiver to the argument, aStream"
-
- super printOn:aStream.
- aStream nextPut:$(.
- severity printOn:aStream.
- aStream nextPut:$:; space.
- label printOn:aStream.
- aStream nextPut:$).
-
- "Modified: / 12-01-2012 / 13:09:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 23-02-2012 / 13:10:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectChecker class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/ProjectChecker.st,v 1.3 2012-01-12 13:12:35 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ProjectChecker.st,v 1.4 2012-03-14 16:25:24 vrany Exp $'
!
-version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/ProjectChecker.st,v 1.3 2012-01-12 13:12:35 vrany Exp $'
+version_SVN
+ ^ '§Id: ProjectChecker.st 1886 2012-02-23 15:15:11Z vranyj1 §'
! !