"{ 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"

    |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 checkClassListConsistency.

    "add more here..."

    "Created: / 11-01-2012 / 16:55:32 / 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

!

version_CVS

! !