"

 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

	classVariableNames:''

	poolDictionaries:''

	category:'System-Support-Projects'

!

!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

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

    "Modified: / 11-04-2012 / 16:00:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

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;

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

                (ProjectProblem newClassListedButDoesNotExist className: nm)

        ] ifFalse:[

            classesInDescription add:cls.

        ].

    ].

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

                    (ProjectProblem newClassUsesPoolButItDoesNotExist

                        className: eachClass name;

                        poolName: eachPoolName).

            ] ifFalse:[

                pool isSharedPool ifFalse:[

                    self addProblem: 

                        (ProjectProblem newClassUsesPoolButItIsNotASharedPool

                            className: eachClass name;

                            poolName: eachPoolName).                

                ].

            ].

        ].

    ].

    classesInImage ~= classesInDescription ifTrue:[

        onlyInImage := (classesInImage reject:[:cls | classesInDescription includes:cls]).

        onlyInImage do:[:cls|

            self addProblem: 

                (ProjectProblem newClassNotListed className: cls name).

        ].

        onlyInDescription := (classesInDescription reject:[:cls | classesInImage includes:cls]).

        onlyInDescription do:[: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"

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

            (ProjectProblem newExtensionMethodListedButDoesNotExist

                className: clsAndSel first selector: clsAndSel second).                            

    ].

    (extensionsPresent \ extensionsListed) do:[: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>"

!

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

!

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

    "To be implemented"

    "Created: / 11-04-2012 / 12:38:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

checkMethodSTCCompilability1: method into: problem

    "Checks is the method can be compiled by STC based on Parser error/warnings"

    | lang |

    lang := method programmingLanguage.

    lang isSmalltalk ifFalse:[ ^ self ].

    lang compilerClass new

        compile:method source

        forClass:method mclass

        inCategory:'others'

        notifying:problem

        install:false

        skipIfSame:false

        silent:false

        foldConstants:true

        ifFail:[ ]

    "Created: / 11-04-2012 / 15:31:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

checkMethodSTCCompilability2: method into: problem

    "Checks is the method can be compiled by STC based on selected lint rules"

    "Not yet implemented"

    "Created: / 11-04-2012 / 15:54:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

checkMethodSTCCompilability: method

    "Checks is the method can be compiled by STC (since STC won't compile

     everything bytecode compiler/jit compiler does, sigh"

    issue := ProjectProblem newMethodCompilabilityIssue.

    issue method: method.

    self checkMethodSTCCompilability1: method into: issue.

    self checkMethodSTCCompilability2: method into: issue.

    issue hasIssue ifTrue:[

        self addProblem: issue

    ]

    "Created: / 11-04-2012 / 12:37:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

checkMethodSourceCode: method

    "Checks, whether method's source code is both

     available and parseable. Return true if the code

     is syntactically corret, false otherwise"

    | source |

    [    

        source := method source.

    ] on: Error do:[

        self addProblem:

            (ProjectProblem newMethodSourceNotAvailable method: method).

        ^false

    ].

    [

        (Parser parseMethod: method source) == #Error ifTrue:[

            self addProblem:

                (ProjectProblem newMethodSourceCorrupted method: method).

            ^false.

        ]

    ] on: Error do:[

        self addProblem:

            (ProjectProblem newMethodSourceCorrupted method: method).

        ^false.

    ].

    ^true

    "Created: / 11-04-2012 / 12:29:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!ProjectChecker methodsFor:'checks-private'!

checkClasses

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

!

checkMethod: method

    (self checkMethodSourceCode: method) ifTrue:[

        "/OK, method's source is OK, perform further checks

        self checkMethodSTCCompilability: method.

        self checkMethodCodingStyle: method.

    ]

    "Created: / 11-04-2012 / 12:27:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

checkMethods

    methods notEmptyOrNil ifTrue:[

        self checkMethods: methods.

        ^self.

    ].

    self checkMethods:

        (Iterator on:[:whatToDo|

            (classes notNil ifTrue:[classes] ifFalse:[Smalltalk allClasses]) do:[:cls|

                cls theNonMetaclass withAllPrivateClassesDo:[:each |

                    each instAndClassSelectorsAndMethodsDo:[:s :m | m package = package ifTrue:[whatToDo value:m]]

                ].

            ]

        ])

    "Created: / 11-01-2012 / 16:55:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

checkMethods: methodsToCheck

    methodsToCheck do:[:m|self checkMethod: m].

    "Created: / 11-04-2012 / 12:16:58 / 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'!

addProblem: aProjectProblem

    aProjectProblem package: self package.

    problems isNil ifTrue:[problems := OrderedCollection new].

    problems add: aProjectProblem

    "Created: / 23-02-2012 / 13:10:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!ProjectChecker class methodsFor:'documentation'!

version

!

version_SVN

! !