- ProjectProblem jv
authorJan Vrany <jan.vrany@fit.cvut.cz>
Thu, 26 Jul 2012 11:05:27 +0100
branchjv
changeset 3064 5aaeb66c9663
parent 3063 5334204e354f
child 3065 c60f15e53fce
- ProjectProblem class definition added:7 methods changed: #linkToClass:selector: - stx_libbasic3 changed: #version_SVN - ProjectChecker class definition added: #forPackage: changed: #check #checkMethodSTCCompilability: #documentation #problems
Make.proto
ProjectChecker.st
ProjectProblem.st
bc.mak
libbasic3.rc
stx_libbasic3.st
--- a/Make.proto	Wed Jul 25 09:46:08 2012 +0100
+++ b/Make.proto	Thu Jul 26 11:05:27 2012 +0100
@@ -165,7 +165,7 @@
 $(OUTDIR)MethodChangeNotificationParameter.$(O) MethodChangeNotificationParameter.$(H): MethodChangeNotificationParameter.st $(INCLUDE_TOP)/stx/libbasic3/ChangeNotificationParameter.$(H) $(INCLUDE_TOP)/stx/libbasic/Array.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)NameSpaceCreationChange.$(O) NameSpaceCreationChange.$(H): NameSpaceCreationChange.st $(INCLUDE_TOP)/stx/libbasic3/Change.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)OtherChange.$(O) OtherChange.$(H): OtherChange.st $(INCLUDE_TOP)/stx/libbasic3/Change.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PerforceSourceCodeManager.$(O) PerforceSourceCodeManager.$(H): PerforceSourceCodeManager.st $(INCLUDE_TOP)/stx/libbasic3/AbstractSourceCodeManager.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic3/VersionInfo.$(H) $(STCHDR)
+$(OUTDIR)PerforceSourceCodeManager.$(O) PerforceSourceCodeManager.$(H): PerforceSourceCodeManager.st $(INCLUDE_TOP)/stx/libbasic3/AbstractSourceCodeManager.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProceedableError.$(H) $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic3/VersionInfo.$(H) $(STCHDR)
 $(OUTDIR)SVNVersionInfo.$(O) SVNVersionInfo.$(H): SVNVersionInfo.st $(INCLUDE_TOP)/stx/libbasic3/VersionInfo.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)StoreSourceCodeManager.$(O) StoreSourceCodeManager.$(H): StoreSourceCodeManager.st $(INCLUDE_TOP)/stx/libbasic3/AbstractSourceCodeManager.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)ClassCategoryChange.$(O) ClassCategoryChange.$(H): ClassCategoryChange.st $(INCLUDE_TOP)/stx/libbasic3/ClassChange.$(H) $(INCLUDE_TOP)/stx/libbasic3/Change.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
--- a/ProjectChecker.st	Wed Jul 25 09:46:08 2012 +0100
+++ b/ProjectChecker.st	Thu Jul 26 11:05:27 2012 +0100
@@ -12,7 +12,7 @@
 "{ Package: 'stx:libbasic3' }"
 
 Object subclass:#ProjectChecker
-	instanceVariableNames:'package packageDef classes methods problems'
+	instanceVariableNames:'package packageDef classes methods problems phase'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'System-Support-Projects'
@@ -37,7 +37,10 @@
 documentation
 "
     A simple project checker that can search whole projects or individual
-    classes or methods for various problems. TBW...
+    classes or methods for various problems that may cause build problems such
+    as:
+        - inconsistent/messed up project definition class
+        - method code problems
 
     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
@@ -51,6 +54,7 @@
     [class variables:]
 
     [see also:]
+        Tools::ProjectCheckerBrowser
 
 "
 !
@@ -64,6 +68,16 @@
     "
 ! !
 
+!ProjectChecker class methodsFor:'instance creation'!
+
+forPackage: packageId
+    ^self new
+        package: packageId;
+        yourself.
+
+    "Created: / 25-07-2012 / 18:00:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !ProjectChecker class methodsFor:'checking'!
 
 check: package
@@ -106,7 +120,7 @@
 !
 
 problems
-    ^ problems ? #()
+    ^ problems
 
     "Modified: / 23-02-2012 / 15:14:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
@@ -115,6 +129,7 @@
 
 check
 
+    problems := OrderedCollection new.
     packageDef := ProjectDefinition definitionClassForPackage: package.
     packageDef isNil ifTrue:[
         self addProblem: 
@@ -334,9 +349,13 @@
     "Checks is the method can be compiled by STC (since STC won't compile
      everything bytecode compiler/jit compiler does, sigh"
 
-    "To be implemented"
+    | issue |
 
-    | issue |
+    "No need to check the method if the class is autoloaded"
+    (packageDef autoloaded_classNames includes: method mclass theNonMetaclass name) ifTrue:[
+        ^ self
+    ].
+    
     issue := ProjectProblem newMethodCompilabilityIssue.
     issue method: method.
     self checkMethodSTCCompilability1: method into: issue.
@@ -461,9 +480,9 @@
 !ProjectChecker class methodsFor:'documentation'!
 
 version
-    ^ '$Id: ProjectChecker.st 1914 2012-04-11 16:07:51Z vranyj1 $'
+    ^ '$Id: ProjectChecker.st 1938 2012-07-26 10:05:27Z vranyj1 $'
 !
 
 version_SVN
-    ^ '$Id: ProjectChecker.st 1914 2012-04-11 16:07:51Z vranyj1 $'
+    ^ '$Id: ProjectChecker.st 1938 2012-07-26 10:05:27Z vranyj1 $'
 ! !
--- a/ProjectProblem.st	Wed Jul 25 09:46:08 2012 +0100
+++ b/ProjectProblem.st	Thu Jul 26 11:05:27 2012 +0100
@@ -12,7 +12,7 @@
 "{ Package: 'stx:libbasic3' }"
 
 Object subclass:#ProjectProblem
-	instanceVariableNames:'package'
+	instanceVariableNames:'package fixes'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'System-Support-Projects'
@@ -53,8 +53,8 @@
 	privateIn:ProjectProblem
 !
 
-ProjectProblem subclass:#MethodProblem
-	instanceVariableNames:'className selector'
+ProjectProblem::ClassProblem subclass:#MethodProblem
+	instanceVariableNames:'selector'
 	classVariableNames:''
 	poolDictionaries:''
 	privateIn:ProjectProblem
@@ -220,16 +220,6 @@
 
 !ProjectProblem methodsFor:'accessing'!
 
-actions
-    "Return (possibly empty) list of actions that
-     the user may take to fix/investigate the problem.
-     Returned value should be list of pairs (label, action block)"
-
-    ^#()
-
-    "Created: / 23-02-2012 / 13:08:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
 description
     "Return a (HTML) describing the problem."
 
@@ -238,12 +228,49 @@
     "Created: / 23-02-2012 / 13:04:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
-descriptionAndActions
-    "Return a (HTML) describing the problem plus possible actions."
+descriptionAndFixes
+    "Return a (HTML) describing the problem plus possible fixes."
+
+    self initializeFixes.
+    fixes isEmpty ifTrue:[ ^ self description ].
+
+    ^String streamContents:[:html |
+        html nextPutAll: self description.
 
-    ^self description
+        html nextPutAll: '<br><br>'.
+        fixes size == 1 ifTrue:[
+            html nextPutLine: 'Possible fix:'.
+        ] ifFalse:[
+            html nextPutLine: 'Possible fixes:'.
+        ].
+        html nextPutLine:'<ul>'.
+        fixes withIndexDo:[:fix :index|
+            html 
+                nextPutAll:'<li><a action="doit: self application doFix: ';
+                nextPutAll: index printString;
+                nextPutAll:'">';
+                nextPutAll: fix first;
+                nextPutAll:'</a></li>'.
+        ].
+        html nextPutLine:'</ul>'.
+    ].
 
-    "Created: / 23-02-2012 / 14:32:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Created: / 26-07-2012 / 09:46:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+fixes
+    "Return (possibly empty) list of actions that
+     the user may take to fix/investigate the problem.
+     Returned value should be list of pairs (label, action block).
+     To be overriden in subclasses.
+
+     The list should be an array of pairs ( fix label , fix block ).
+     Fix block should return true, if the fix was successful,
+     false otherwise"
+
+     ^#()
+
+    "Created: / 26-07-2012 / 09:46:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 label
@@ -278,6 +305,28 @@
     "Created: / 23-02-2012 / 13:09:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
+!ProjectProblem methodsFor:'fixing'!
+
+doFix: index
+    self initializeFixes.
+    ^(fixes at: index) second value
+
+    "Created: / 26-07-2012 / 10:07:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectProblem methodsFor:'initialization'!
+
+initializeFixes
+
+    fixes isNil ifTrue:[
+        fixes := self fixes
+    ].
+
+    "/ super initialize.   -- commented since inherited method does nothing
+
+    "Created: / 26-07-2012 / 09:54:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !ProjectProblem methodsFor:'printing & storing'!
 
 displayString
@@ -315,18 +364,30 @@
 !
 
 linkToClass: classOrclassName selector: selector
+    ^self linkToClass: classOrclassName selector:  selector omitClassName: false
+
+    "Created: / 23-02-2012 / 13:45:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+linkToClass: classOrclassName selector: selector omitClassName: omitClassName
 
     | className |
     className := classOrclassName isBehavior
                     ifTrue: [classOrclassName name]
                     ifFalse:[classOrclassName].
+    ^omitClassName ifTrue:[
+        '<A INFO="Click to browse method" ACTION="doit: UserPreferences current systemBrowserClass openInClass:%1 selector: %2"><CODE>#%3</CODE></A>'
+            bindWith: className
+                with: selector storeString
+                with: selector
+    ] ifFalse:[
+        '<A INFO="Click to browse method" ACTION="doit: UserPreferences current systemBrowserClass openInClass:%1 selector: %2"><CODE>%1>>%3</CODE></A>'
+            bindWith: className
+                with: selector storeString
+                with: selector
+    ]
 
-    ^'<A INFO="Click to browse method" ACTION="doit: UserPreferences current systemBrowserClass openInClass:%1 selector: %2"><CODE>%1>>%3</CODE></A>'
-        bindWith: className
-            with: selector storeString
-            with: selector
-
-    "Created: / 23-02-2012 / 13:45:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Created: / 26-07-2012 / 10:26:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !ProjectProblem::ClassProblem methodsFor:'accessing'!
@@ -337,6 +398,22 @@
 
 className:something
     className := something.
+!
+
+klass
+    "Return the class which is subject of the problem"
+    
+    | class |
+
+    (className endsWith: ' class') ifTrue:[
+        class := Smalltalk at: (className copyTo: className size - 6) asSymbol.
+        class := class theMetaclass.
+    ] ifFalse:[
+        class := Smalltalk at: className  asSymbol
+    ].
+    ^class
+
+    "Created: / 26-07-2012 / 10:21:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !ProjectProblem::ClassNotListed methodsFor:'accessing'!
@@ -345,15 +422,50 @@
     "Return a (HTML) describing the problem."
 
     ^
-'Class %1 is not listed in project definition. Such class won''t be compiled
+'Class %1 is not listed in project definition (%2) Such class won''t be compiled
 and - if some other class dependents on it - whole package will fail to compile
-at all. 
+at all.'
+bindWith: (self linkToClass: className)
+    with: (self linkToClass: self packageDefinitionClass class selector: #classNamesAndAttributes omitClassName: true)
+
+    "Modified: / 26-07-2012 / 10:27:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+doIncludeInProject
+    "Include subject class in project definition. Return false if
+     fix fails, true otherwise"
+    | def cls |
+    def := self packageDefinitionClass.
+    def isNil ifTrue:[ ^ false ].
+    cls := self klass.
+    cls isNil ifTrue:[ ^ false ].
+    def includeClasses:(Array with: cls) usingCompiler: nil.
+    ^true
 
-Either add it into %2 or remove it completely.'
-bindWith: (self linkToClass: className)
-    with: (self linkToClass: self packageDefinitionClass class selector: #classNamesAndAttributes)
+    "Created: / 26-07-2012 / 10:41:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
 
-    "Modified: / 23-02-2012 / 14:35:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+doIncludeInProjectAsAutoloaded
+    "Include subject class in project definition. Return false if
+     fix fails, true otherwise"
+    | def cls |
+    def := self packageDefinitionClass.
+    def isNil ifTrue:[ ^ false ].
+    cls := self klass.
+    cls isNil ifTrue:[ ^ false ].
+    def makeClassesAutoloaded:(Array with: cls) usingCompiler: nil.
+    ^true
+
+    "Created: / 26-07-2012 / 10:41:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+fixes
+
+    ^Array 
+        with: (Array with: 'Include in project' with: [ self doIncludeInProject ])
+        with: (Array with: 'Include in project as autoloaded' with: [ self doIncludeInProjectAsAutoloaded ])
+
+    "Created: / 26-07-2012 / 10:41:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 label
@@ -457,14 +569,6 @@
 
 !ProjectProblem::MethodProblem methodsFor:'accessing'!
 
-className
-    ^ className
-!
-
-className:something
-    className := something.
-!
-
 className:something selector: sel
     className := something.
     selector :=  sel
@@ -472,6 +576,16 @@
     "Created: / 23-02-2012 / 14:17:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
+method
+    | class |
+
+    class := self klass.
+    class isNil ifTrue:[ ^ self ].
+    ^class compiledMethodAt: selector
+
+    "Created: / 26-07-2012 / 10:09:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 method: method
 
     self className: method mclass name selector: method selector
@@ -747,6 +861,25 @@
     "Modified: / 23-02-2012 / 14:21:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
+fixes
+
+    ^Array with:
+        (Array  with: 'Move method to package ', package 
+                with: [ 
+                    | m |
+
+                    m := self method.
+                    m notNil ifTrue:[
+                        m package: package.
+                        true
+                    ] ifFalse:[
+                        false
+                    ]
+                ])
+
+    "Created: / 26-07-2012 / 09:53:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 label
     "Return the label (possibly instance if a Text) shortly describing the problem"
 
@@ -870,5 +1003,5 @@
 !ProjectProblem class methodsFor:'documentation'!
 
 version_SVN
-    ^ '$Id: ProjectProblem.st 1916 2012-04-12 17:19:04Z vranyj1 $'
+    ^ '$Id: ProjectProblem.st 1938 2012-07-26 10:05:27Z vranyj1 $'
 ! !
--- a/bc.mak	Wed Jul 25 09:46:08 2012 +0100
+++ b/bc.mak	Thu Jul 26 11:05:27 2012 +0100
@@ -107,7 +107,7 @@
 $(OUTDIR)MethodChangeNotificationParameter.$(O) MethodChangeNotificationParameter.$(H): MethodChangeNotificationParameter.st $(INCLUDE_TOP)\stx\libbasic3\ChangeNotificationParameter.$(H) $(INCLUDE_TOP)\stx\libbasic\Array.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)NameSpaceCreationChange.$(O) NameSpaceCreationChange.$(H): NameSpaceCreationChange.st $(INCLUDE_TOP)\stx\libbasic3\Change.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)OtherChange.$(O) OtherChange.$(H): OtherChange.st $(INCLUDE_TOP)\stx\libbasic3\Change.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PerforceSourceCodeManager.$(O) PerforceSourceCodeManager.$(H): PerforceSourceCodeManager.st $(INCLUDE_TOP)\stx\libbasic3\AbstractSourceCodeManager.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic3\VersionInfo.$(H) $(STCHDR)
+$(OUTDIR)PerforceSourceCodeManager.$(O) PerforceSourceCodeManager.$(H): PerforceSourceCodeManager.st $(INCLUDE_TOP)\stx\libbasic3\AbstractSourceCodeManager.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProceedableError.$(H) $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic3\VersionInfo.$(H) $(STCHDR)
 $(OUTDIR)SVNVersionInfo.$(O) SVNVersionInfo.$(H): SVNVersionInfo.st $(INCLUDE_TOP)\stx\libbasic3\VersionInfo.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)StoreSourceCodeManager.$(O) StoreSourceCodeManager.$(H): StoreSourceCodeManager.st $(INCLUDE_TOP)\stx\libbasic3\AbstractSourceCodeManager.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)ClassCategoryChange.$(O) ClassCategoryChange.$(H): ClassCategoryChange.st $(INCLUDE_TOP)\stx\libbasic3\ClassChange.$(H) $(INCLUDE_TOP)\stx\libbasic3\Change.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
--- a/libbasic3.rc	Wed Jul 25 09:46:08 2012 +0100
+++ b/libbasic3.rc	Thu Jul 26 11:05:27 2012 +0100
@@ -3,8 +3,8 @@
 // automagically generated from the projectDefinition: stx_libbasic3.
 //
 VS_VERSION_INFO VERSIONINFO
-  FILEVERSION     6,2,1911,1911
-  PRODUCTVERSION  6,2,1,1
+  FILEVERSION     6,2,0,1
+  PRODUCTVERSION  6,2,2,1
 #if (__BORLANDC__)
   FILEFLAGSMASK   VS_FF_DEBUG | VS_FF_PRERELEASE
   FILEFLAGS       VS_FF_PRERELEASE | VS_FF_SPECIALBUILD
@@ -20,12 +20,12 @@
     BEGIN
       VALUE "CompanyName", "eXept Software AG\0"
       VALUE "FileDescription", "Smalltalk/X Additional Developer Basic Classes (LIB)\0"
-      VALUE "FileVersion", "6.2.1911.1911\0"
+      VALUE "FileVersion", "6.2.0.1\0"
       VALUE "InternalName", "stx:libbasic3\0"
-      VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2011\nCopyright eXept Software AG 1998-2011\0"
+      VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2012\nCopyright eXept Software AG 1998-2012\0"
       VALUE "ProductName", "Smalltalk/X\0"
-      VALUE "ProductVersion", "6.2.1.1\0"
-      VALUE "ProductDate", "Fri, 18 May 2012 18:01:36 GMT\0"
+      VALUE "ProductVersion", "6.2.2.1\0"
+      VALUE "ProductDate", "Thu, 26 Jul 2012 10:10:06 GMT\0"
     END
 
   END
--- a/stx_libbasic3.st	Wed Jul 25 09:46:08 2012 +0100
+++ b/stx_libbasic3.st	Thu Jul 26 11:05:27 2012 +0100
@@ -11,7 +11,7 @@
 "
 "{ Package: 'stx:libbasic3' }"
 
-LibraryDefinition subclass:#'stx_libbasic3'
+LibraryDefinition subclass:#stx_libbasic3
 	instanceVariableNames:''
 	classVariableNames:''
 	poolDictionaries:''
@@ -229,13 +229,13 @@
     "Return a SVN revision number of myself.
      This number is updated after a commit"
 
-    ^ "$SVN-Revision:"'1922            '"$"
+    ^ "$SVN-Revision:"'1937            '"$"
 ! !
 
 !stx_libbasic3 class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/stx_libbasic3.st,v 1.70 2012/07/18 17:12:40 cg Exp $'
+    ^ '$Id: stx_libbasic3.st 1938 2012-07-26 10:05:27Z vranyj1 $'
 !
 
 version_CVS
@@ -243,5 +243,5 @@
 !
 
 version_SVN
-    ^ '$ Id: stx_libbasic3.st 1867 2011-06-08 21:57:08Z vranyj1  $'
+    ^ '$Id:: stx_libbasic3.st 1938 2012-07-26 10:05:27Z vranyj1                                                                     $'
 ! !