"

 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

	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'!

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.

"

!

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 tool 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 check: 'stx:libtool'

        ProjectChecker check: 'stx:libbasic3'

    "

! !

!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'!

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

! !

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

!

checkExtensionsListConsistency

    "Checks whether all extensions listed in #extensionMethodNames are present

    and if all extension methods are listed"

    | extensionsListed extensionsPresent |

    extensionsListed := OrderedCollection new.

    packageDef extensionMethodNames pairWiseDo:[:cls :sel|

        extensionsListed add: (Array with: cls with: sel)

    ].

    extensionsPresent := OrderedCollection new.

    packageDef searchForExtensions do:[:each|

        extensionsPresent add: (Array with: each mclass name with: each selector)

    ].

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

    ].

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

    ].

    "Created: / 12-01-2012 / 12:31:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

checkExtensionsPrerequisites

    "Checks whether packages of all extensions method classes are listed

     in package prerequisites"

    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

         ].

    ]

    "Created: / 12-01-2012 / 12:41:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!ProjectChecker methodsFor:'checks-private'!

checkClasses

    "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

    self checkClassListConsistency.

    self checkExtensionsListConsistency.

    self checkExtensionsPrerequisites.

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

! !

!ProjectChecker class methodsFor:'documentation'!

version

!

version_CVS

    ^ '§Header: /cvs/stx/stx/libbasic3/ProjectChecker.st,v 1.3 2012/01/12 13:12:35 vrany Exp §'

!

version_SVN

! !