--- a/Change.st Fri Mar 29 19:43:35 2013 +0000
+++ b/Change.st Mon Apr 01 14:07:13 2013 +0100
@@ -50,7 +50,7 @@
!Change class methodsFor:'others'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/Change.st,v 1.63 2013-03-26 12:13:16 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/Change.st,v 1.64 2013-03-30 14:12:02 cg Exp $'
! !
@@ -177,6 +177,14 @@
"Modified (format): / 25-07-2012 / 17:37:23 / cg"
!
+mcDefinition
+ ^ mcDefinition
+!
+
+mcDefinition:something
+ mcDefinition := something.
+!
+
nameSpaceOverride:ns
"Created: / 20-03-2012 / 17:18:17 / cg"
@@ -359,7 +367,6 @@
! !
-
!Change methodsFor:'queries'!
isForGeneratedSubject
@@ -558,7 +565,7 @@
!Change class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/Change.st,v 1.63 2013-03-26 12:13:16 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/Change.st,v 1.64 2013-03-30 14:12:02 cg Exp $'
!
version_HG
--- a/ChangeSet.st Fri Mar 29 19:43:35 2013 +0000
+++ b/ChangeSet.st Mon Apr 01 14:07:13 2013 +0100
@@ -104,6 +104,7 @@
"
! !
+
!ChangeSet class methodsFor:'instance creation'!
forExistingClass:aClass
@@ -649,6 +650,7 @@
"
! !
+
!ChangeSet class methodsFor:'Compatibility-ST80'!
patches
@@ -675,6 +677,7 @@
! !
+
!ChangeSet class methodsFor:'instance creation-private'!
changesFromStream:aStream do:aBlock
@@ -747,14 +750,17 @@
parser := Parser for:chunk.
"/ parser parseForCode.
-
- tree := parser
+ Parser parseErrorSignal handle:[:ex |
+ Transcript showCR:'ChangeSet: error while reading: ',ex description.
+ tree := #Error.
+ ] do:[
+ tree := parser
parseExpressionWithSelf:nil
notifying:nil
ignoreErrors:true
ignoreWarnings:true
inNameSpace:nameSpace.
-
+ ].
tree notNil ifTrue:[
tree == #Error ifTrue:[
"/Hmm....it could be package-definition chunk in extensions container...
@@ -826,6 +832,7 @@
"Modified: / 30-01-2013 / 10:30:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ChangeSet class methodsFor:'queries'!
current
@@ -843,6 +850,7 @@
"
! !
+
!ChangeSet class methodsFor:'utilities'!
decodedStreamFor:aStream
@@ -850,6 +858,7 @@
^ EncodedStream decodedStreamFor:aStream
! !
+
!ChangeSet methodsFor:'Compatibility-ST80'!
changeClass:aClass
@@ -941,6 +950,7 @@
"Created: / 6.2.2000 / 20:45:10 / cg"
! !
+
!ChangeSet methodsFor:'accessing'!
name
@@ -953,6 +963,7 @@
"Modified (format): / 28-07-2012 / 09:34:52 / cg"
! !
+
!ChangeSet methodsFor:'change & update'!
changed:anAspectSymbol with:aParameter
@@ -965,6 +976,7 @@
super changed:anAspectSymbol with:aParameter
! !
+
!ChangeSet methodsFor:'changes management'!
addClassCommentChangeFor:aClass
@@ -1207,6 +1219,7 @@
"Modified: / 14.11.2001 / 13:36:06 / cg"
! !
+
!ChangeSet methodsFor:'fileOut'!
fileOutAs: aStringOrFilename
@@ -1278,6 +1291,8 @@
].
!
+
+
removeAll:aCollection
aCollection notEmpty ifTrue:[
super removeAll:aCollection.
@@ -1290,6 +1305,7 @@
changedClasses := nil
! !
+
!ChangeSet methodsFor:'queries'!
changedPackages
@@ -1577,6 +1593,7 @@
"Created: / 08-09-2011 / 04:38:32 / cg"
! !
+
!ChangeSet methodsFor:'utilities'!
apply
@@ -2157,7 +2174,7 @@
formatSymbolOrNil isNil ifTrue:[
self do:[:eachChange |
eachChange isMethodCodeChange ifTrue:[
- aStream nextPutAll:'!!',(eachChange className),' methodsFor: '.
+ aStream nextPutAll:'!!'; nextPutAll:(eachChange className); nextPutAll:' methodsFor: '.
aStream nextPutAll:(eachChange methodCategory storeString).
aStream nextPutLine:'!!'.
aStream cr.
@@ -2190,6 +2207,7 @@
"Modified (comment): / 31-07-2012 / 13:38:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ChangeSet::ChangeFileReader methodsFor:'accessing'!
changeAction:aBlock
@@ -2206,6 +2224,7 @@
inputStream := aStream.
! !
+
!ChangeSet::ChangeFileReader methodsFor:'helpers'!
addChange:change
@@ -2299,6 +2318,7 @@
^ receiver name
! !
+
!ChangeSet::ChangeFileReader methodsFor:'reading'!
changesFromParseTree:aTree lineNumber:initialLineNumberOrNil position:initialPositionOrNil
@@ -2339,6 +2359,7 @@
"Created: / 24-01-2012 / 17:28:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ChangeSet::ChangeFileReader methodsFor:'reading-private'!
handleCategoriesForChange
@@ -3128,6 +3149,7 @@
"Created: / 02-04-2012 / 19:08:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ChangeSet::ClassSourceWriter methodsFor:'private'!
analyze
@@ -3268,6 +3290,7 @@
"Created: / 15-03-2012 / 19:45:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ChangeSet::ClassSourceWriter methodsFor:'source writing'!
fileOut:aChangeSet on:outStreamArg withTimeStamp:stampIt withInitialize:initIt withDefinition:withDefinition methodFilter:methodFilter encoder:encoderOrNil
@@ -3721,6 +3744,7 @@
"Created: / 15-03-2012 / 19:01:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ChangeSet::ClassSourceWriter::ClassInfo class methodsFor:'documentation'!
copyright
@@ -3741,6 +3765,7 @@
^ 'Id:: ChangeSet.st 1981 2012-11-30 17:20:01Z vranyj1 '
! !
+
!ChangeSet::ClassSourceWriter::ClassInfo class methodsFor:'instance creation'!
new
@@ -3749,6 +3774,7 @@
^ self basicNew initialize.
! !
+
!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'accessing'!
categories
@@ -3868,6 +3894,7 @@
superclass := something.
! !
+
!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'adding'!
addChange: change
@@ -3917,6 +3944,7 @@
"Created: / 15-03-2012 / 19:12:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'enumerating'!
methodsDo: aBlock
@@ -3926,6 +3954,7 @@
"Created: / 19-03-2012 / 18:14:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'initialization'!
initialize
@@ -3942,6 +3971,7 @@
"Modified: / 15-03-2012 / 19:12:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'printing & storing'!
printClassNameOn:aStream
@@ -3969,6 +3999,7 @@
"Modified: / 19-03-2012 / 19:43:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'queries'!
includesSelector: selector
@@ -3995,6 +4026,7 @@
"Created: / 15-03-2012 / 19:41:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ChangeSet::DiffSet class methodsFor:'documentation'!
documentation
@@ -4004,6 +4036,7 @@
"
! !
+
!ChangeSet::DiffSet methodsFor:'accessing'!
changed
@@ -4085,6 +4118,7 @@
same := something.
! !
+
!ChangeSet::DiffSet methodsFor:'merging'!
addDiffSet:anotherDiffset
@@ -4108,6 +4142,7 @@
"Modified: / 19-03-2012 / 21:36:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!ChangeSet::DiffSet methodsFor:'misc'!
removeAllVersionMethods
@@ -4125,6 +4160,7 @@
].
! !
+
!ChangeSet::DiffSet methodsFor:'queries'!
changedClasses
@@ -4155,6 +4191,7 @@
"Created: / 12-10-2006 / 23:12:27 / cg"
! !
+
!ChangeSet::DolphinPACFileReader methodsFor:'reading-private'!
handleCategoriesForClass
@@ -4272,6 +4309,7 @@
"Modified: / 15.12.1999 / 00:29:06 / cg"
! !
+
!ChangeSet::SIFChangeFileReader methodsFor:'reading-private'!
handleAnnotation
@@ -4408,14 +4446,15 @@
"Modified: / 15.12.1999 / 00:29:06 / cg"
! !
+
!ChangeSet class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/ChangeSet.st,v 1.210 2012/11/06 01:41:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ChangeSet.st,v 1.217 2013-03-31 20:08:50 cg Exp $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic3/ChangeSet.st,v 1.210 2012/11/06 01:41:21 cg Exp '
+ ^ '$Header: /cvs/stx/stx/libbasic3/ChangeSet.st,v 1.217 2013-03-31 20:08:50 cg Exp $'
!
version_HG
@@ -4424,6 +4463,6 @@
!
version_SVN
- ^ 'Id: ChangeSet.st 1981 2012-11-30 17:20:01Z vranyj1 '
+ ^ '§Id: ChangeSet.st 1945 2012-07-31 11:53:41Z vranyj1 §'
! !
--- a/ClassDefinitionChange.st Fri Mar 29 19:43:35 2013 +0000
+++ b/ClassDefinitionChange.st Mon Apr 01 14:07:13 2013 +0100
@@ -51,7 +51,7 @@
!ClassDefinitionChange class methodsFor:'others'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/ClassDefinitionChange.st,v 1.75 2013-03-27 18:18:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ClassDefinitionChange.st,v 1.76 2013-03-30 01:54:34 cg Exp $'
! !
@@ -151,6 +151,16 @@
"Modified: / 24-01-2012 / 22:13:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+imageSource
+ "return the source for the in-image version of the method"
+
+ | cls |
+
+ cls := self changeClass.
+ cls isNil ifTrue:[ ^ nil ].
+ ^ cls definitionWithoutPackage
+!
+
instanceVariableNames
^ instanceVariableNames
!
@@ -193,6 +203,7 @@
otherParameters := Dictionary new addAll:otherParametersArg; yourself.
superClassName := otherParameters at:#superclass: ifAbsent:nil.
+ self assert:(superClassName notNil).
superClassName notNil ifTrue:[
superClassName := superClassName pathString.
].
@@ -263,16 +274,17 @@
|nm|
nm := superClassName.
- nm notNil ifTrue:[
- (nm includes:$.) ifTrue:[
- ^ nm copyReplaceAll:$. withAll:'::'.
- ]
+ nm isNil ifTrue:[^ 'nil'].
+ "/ convert VW namespace syntax
+ (nm includes:$.) ifTrue:[
+ ^ nm copyReplaceAll:$. withAll:'::'.
].
^ nm
!
-superClassName:something
- superClassName := something.
+superClassName:aString
+ superClassName := aString.
+ self assert:(aString notNil).
self invalidateSource.
!
@@ -344,14 +356,7 @@
thingy as the receiver (i.e. same method, same definition etc.)."
changeB isClassDefinitionChange ifFalse:[^ false].
-
- className ~= changeB className ifTrue:[^ false].
- ^ true
-
-
-
-
-
+ ^ className = changeB className
!
sameAs:changeB
@@ -789,6 +794,7 @@
superClassName := parseTree receiver name.
+ self assert:(superClassName notNil).
].
"Created: / 11-10-2006 / 14:10:02 / cg"
@@ -809,7 +815,7 @@
!ClassDefinitionChange class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/ClassDefinitionChange.st,v 1.75 2013-03-27 18:18:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ClassDefinitionChange.st,v 1.76 2013-03-30 01:54:34 cg Exp $'
!
version_HG
--- a/MessageTracer.st Fri Mar 29 19:43:35 2013 +0000
+++ b/MessageTracer.st Mon Apr 01 14:07:13 2013 +0100
@@ -3050,37 +3050,39 @@
!
printUpdateEntryFull:aContext level:lvl on:aStream
- |con|
+ |con sndr|
con := aContext.
- [con notNil
- and:[con selector ~~ #'changed:with:']
- ] whileTrue:[
- con := con sender.
- ].
- "/ con is #'changed:with:'
+"/ [
+"/ con notNil and:[con selector ~~ #'changed:with:']
+"/ ] whileTrue:[
+"/ con := con sender.
+"/ ].
+ con := con findNextContextWithSelector:#'changed:with:' or:nil or:nil.
+
con isNil ifTrue:[
- ^ self printEntryFull:aContext level:lvl on:aStream.
+ ^ self printEntryFull:aContext level:lvl on:aStream.
].
- (con sender notNil
- and:[ con sender selector == #'changed:']) ifTrue:[
- con := con sender.
+ "/ con is #'changed:with:'
+ ((sndr := con sender) notNil
+ and:[ sndr selector == #'changed:']) ifTrue:[
+ con := sndr.
].
- (con sender notNil
- and:[ con sender selector == #'changed']) ifTrue:[
- con := con sender.
+ ((sndr := con sender) notNil
+ and:[ sndr selector == #'changed']) ifTrue:[
+ con := sndr.
].
- (con sender notNil) ifTrue:[
- con := con sender.
+ ((sndr := con sender) notNil) ifTrue:[
+ con := sndr.
].
aStream spaces:lvl; nextPutAll:'enter '.
self
- printFull:aContext
- on:aStream
- withSenderContext:con
+ printFull:aContext
+ on:aStream
+ withSenderContext:con
!
traceEntryFull:aContext on:aStream
@@ -3340,7 +3342,7 @@
!MessageTracer class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.118 2013-03-22 11:46:13 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.120 2013-03-31 21:15:50 cg Exp $'
!
version_HG
--- a/MethodChange.st Fri Mar 29 19:43:35 2013 +0000
+++ b/MethodChange.st Mon Apr 01 14:07:13 2013 +0100
@@ -297,7 +297,7 @@
ifFalse:[
"/ ask for a replacement class
replacementClassName := Dialog
- request:('Cannot apply change for missing class: %1\\Use replacement class (or press cancel)' bindWith:className) withCRs
+ requestClassName:('Cannot apply change for missing class: %1\\Use replacement class (or press cancel)' bindWith:className) withCRs
initialAnswer:suggestion.
replacementClassName isNil ifTrue:[ AbortSignal raise ].
@@ -511,11 +511,11 @@
!MethodChange class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/MethodChange.st,v 1.69 2013-03-26 12:13:47 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/MethodChange.st,v 1.70 2013-03-28 12:23:42 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/MethodChange.st,v 1.69 2013-03-26 12:13:47 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/MethodChange.st,v 1.70 2013-03-28 12:23:42 cg Exp $'
!
version_HG
--- a/ProjectChecker.st Fri Mar 29 19:43:35 2013 +0000
+++ b/ProjectChecker.st Mon Apr 01 14:07:13 2013 +0100
@@ -94,12 +94,6 @@
"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.14 2013-03-27 16:48:30 cg Exp $'
-! !
-
!ProjectChecker methodsFor:'accessing'!
checkExtensionsOnly:aBoolean
@@ -351,9 +345,25 @@
].
(extensionsListed \ extensionsPresent) do:[:clsAndSel|
- self addProblem:
- (ProjectProblem newExtensionMethodListedButDoesNotExist
- className: clsAndSel first selector: clsAndSel second).
+ |cls clsName selector|
+
+ clsName := clsAndSel first.
+ selector := clsAndSel second.
+ (cls := Smalltalk classNamed: clsName) isNil ifTrue:[
+ self addProblem:
+ (ProjectProblem newExtensionMethodsClassDoesNotExist
+ className: clsName selector: selector).
+ ] ifFalse:[
+ (cls compiledMethodAt:selector) isNil ifTrue:[
+ self addProblem:
+ (ProjectProblem newExtensionMethodListedButDoesNotExist
+ className: clsName selector: selector).
+ ] ifFalse:[
+ self addProblem:
+ (ProjectProblem newExtensionMethodListedButInDifferentPackage
+ className: clsName selector: selector).
+ ]
+ ]
].
(extensionsPresent \ extensionsListed) do:[:clsAndSel|
@@ -393,28 +403,38 @@
"Created: / 11-04-2012 / 12:38:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-checkMethodSTCCompilability1: method into: problem
+checkMethodSTCCompilability1: method into: problemIssue
"Checks is the method can be compiled by STC based on Parser error/warnings"
- | lang |
+ | lang compiler |
+
lang := method programmingLanguage.
lang isSmalltalk ifFalse:[ ^ self ].
- lang compilerClass new
+ compiler := lang compilerClass new.
+ compiler
compile:method source
forClass:method mclass
inCategory:'others'
- notifying:problem
+ notifying:problemIssue
install:false
skipIfSame:false
silent:false
foldConstants:true
- ifFail:[ ]
+ ifFail:[ ].
+
+ compiler usedGlobals do:[:nm |
+ (nm startsWith:Smalltalk undeclaredPrefix) ifTrue:[
+ problemIssue
+ addWarning:'Contains unresolved reference to: ',(nm copyFrom:(Smalltalk undeclaredPrefix size + 1))
+ from:0 to:0
+ ]
+ ].
"Created: / 11-04-2012 / 15:31:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-checkMethodSTCCompilability2: method into: problem
+checkMethodSTCCompilability2: method into: problemIssue
"Checks is the method can be compiled by STC based on selected lint rules"
"Not yet implemented"
@@ -588,7 +608,11 @@
!ProjectChecker class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/ProjectChecker.st,v 1.14 2013-03-27 16:48:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ProjectChecker.st,v 1.16 2013-03-30 16:01:17 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libbasic3/ProjectChecker.st,v 1.16 2013-03-30 16:01:17 cg Exp $'
!
version_HG
--- a/ProjectProblem.st Fri Mar 29 19:43:35 2013 +0000
+++ b/ProjectProblem.st Mon Apr 01 14:07:13 2013 +0100
@@ -25,35 +25,35 @@
privateIn:ProjectProblem
!
-ProjectProblem::ClassProblem subclass:#ClassListedBeforeItsSuperclass
- instanceVariableNames:'superClassName'
+ProjectProblem::ClassProblem subclass:#InconsistentProjectDefinition
+ instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
-ProjectProblem::ClassProblem subclass:#ClassListedButDoesNotExist
+ProjectProblem::InconsistentProjectDefinition subclass:#ClassListedButDoesNotExist
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
-ProjectProblem::ClassProblem subclass:#ClassListedMultipleTimes
+ProjectProblem::InconsistentProjectDefinition subclass:#ClassListedMultipleTimes
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
-ProjectProblem::ClassProblem subclass:#ClassNotListed
+ProjectProblem::InconsistentProjectDefinition subclass:#ClassNotListed
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
-ProjectProblem::ClassProblem subclass:#ClassListedBeforeItsPool
+ProjectProblem::InconsistentProjectDefinition subclass:#ClassListedBeforeItsPool
instanceVariableNames:'poolName'
classVariableNames:''
poolDictionaries:''
@@ -95,6 +95,13 @@
privateIn:ProjectProblem
!
+ProjectProblem::MethodProblem subclass:#ExtensionMethodListedButInDifferentPackage
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:ProjectProblem
+!
+
ProjectProblem::MethodProblem subclass:#ExtensionMethodNotListed
instanceVariableNames:''
classVariableNames:''
@@ -102,13 +109,20 @@
privateIn:ProjectProblem
!
-ProjectProblem::MethodProblem subclass:#ExtensionMethodToAPrivateClass
+ProjectProblem::MethodProblem subclass:#ExtensionMethodsClassDoesNotExist
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
+ProjectProblem::InconsistentProjectDefinition subclass:#ClassListedBeforeItsSuperclass
+ instanceVariableNames:'superClassName'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:ProjectProblem
+!
+
ProjectProblem::MethodProblem subclass:#MethodCompilabilityIssue
instanceVariableNames:'errors warnings'
classVariableNames:''
@@ -246,6 +260,11 @@
"Created: / 23-02-2012 / 14:26:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+newExtensionMethodListedButInDifferentPackage
+
+ ^ExtensionMethodListedButInDifferentPackage new
+!
+
newExtensionMethodNotListed
^ExtensionMethodNotListed new
@@ -253,11 +272,9 @@
"Created: / 23-02-2012 / 14:27:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-newExtensionMethodToAPrivateClass
+newExtensionMethodsClassDoesNotExist
- ^ExtensionMethodToAPrivateClass new
-
- "Created: / 11-03-2013 / 13:01:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ ^ExtensionMethodsClassDoesNotExist new
!
newMethodCompilabilityIssue
@@ -267,12 +284,6 @@
"Created: / 11-04-2012 / 15:34:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-newMethodExtensionToAPrivateClass
- self shouldImplement
-
- "Created: / 11-03-2013 / 13:00:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
newMethodInNoPackage
^MethodInNoPackage new
@@ -314,28 +325,35 @@
descriptionAndFixes
"Return a (HTML) describing the problem plus possible fixes."
- self initializeFixes.
- fixes isEmpty ifTrue:[ ^ self description ].
+ |descriptionText fixes|
+
+ (self alreadyFixed) ifTrue:[^ 'Already fixed.'].
+
+ descriptionText := self description.
+
+ "/ don't use cached fixes (after a fix, the problem may return an empty fix list)
+ fixes := self fixes.
+ fixes isEmpty ifTrue:[ ^ descriptionText ].
^String streamContents:[:html |
- html nextPutAll: self description.
+ html nextPutAll: descriptionText.
- 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>'.
+ 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: / 26-07-2012 / 09:46:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -390,9 +408,13 @@
!ProjectProblem methodsFor:'fixing'!
+alreadyFixed
+ ^ false
+!
+
doFix: index
self initializeFixes.
- ^(fixes at: index) second value
+ ^ (fixes at: index) second value
"Created: / 26-07-2012 / 10:07:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
@@ -413,7 +435,11 @@
!ProjectProblem methodsFor:'printing & storing'!
displayString
- ^self label
+ |lbl|
+
+ lbl := self label.
+ self alreadyFixed ifTrue:[^ lbl string allItalic].
+ ^ lbl
"Created: / 14-02-2012 / 17:02:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -486,73 +512,51 @@
klass
"Return the class which is subject of the problem"
- | class |
+"/ | class |
+"/
+"/ (className endsWith: ' class') ifTrue:[
+"/ class := Smalltalk at: (className copyTo: className size - 6) asSymbol.
+"/ class := class theMetaclass.
+"/ ] ifFalse:[
+"/ class := Smalltalk at: className asSymbol
+"/ ].
+"/ ^class
- (className endsWith: ' class') ifTrue:[
- class := Smalltalk at: (className copyTo: className size - 6) asSymbol.
- class := class theMetaclass.
- ] ifFalse:[
- class := Smalltalk at: className asSymbol
- ].
- ^class
+ "/ the above is exactly:
+ ^ Smalltalk classNamed:className
"Created: / 26-07-2012 / 10:21:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!ProjectProblem::ClassListedBeforeItsSuperclass methodsFor:'accessing'!
-
-description
- "Return a (HTML) describing the problem."
+!ProjectProblem::InconsistentProjectDefinition methodsFor:'fixes'!
- ^
-'Class %2 is listed in project definition (%1) before its superclass. Such class will fail to
-compile (if the package is being stc-compiled) and load (if the package is being loaded from
-source). Make sure class (%3) is listed before (%2).
+fixes
-'
-bindWith: (self linkToClass: self packageDefinitionClass class selector: #classNamesAndAttributes omitClassName: true)
- with: (self linkToClass: className)
- with: (self linkToClass: superClassName)
-
- "Modified: / 13-09-2012 / 18:29:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ ^Array
+ with: (Array with: 'Regenerate specs in ProjectDefinitions' with: [ self regenerateProjectDefinition ])
!
-label
- "Return the label (possibly instance if a Text) shortly describing the problem"
-
- ^'Class %1 listed in project definition before its superclass' bindWith: className
+regenerateProjectDefinition
+ |defClass|
- "Modified: / 13-09-2012 / 17:36:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-superClassName
- ^ superClassName
-!
-
-superClassName:something
- superClassName := something.
+ defClass := self packageDefinitionClass.
+ Class packageQuerySignal
+ answer:defClass package
+ do:[
+ defClass theNonMetaclass
+ forEachContentsMethodsCodeToCompileDo:
+ [:code :category |
+ Compiler
+ compile:code
+ forClass:defClass theMetaclass
+ inCategory:category.
+ ]
+ ignoreOldDefinition:false
+ ].
! !
!ProjectProblem::ClassListedButDoesNotExist methodsFor:'accessing'!
-description
- "Return a (HTML) describing the problem."
- ^
-'A class (<code>%1</code>) is listed in project definition class but
-it is not present in the system.
-
-You should either create it or remove it from %2.'
- bindWith: className with: (self linkToClass: self packageDefinitionClass class selector: #classNamesAndAttributes)
-
- "Modified: / 28-02-2012 / 22:23:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-label
- ^'Missing class ', className
-
- "Modified: / 23-02-2012 / 13:20:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
severity
"Return a severity - one of #error, #warning, #info"
@@ -561,7 +565,27 @@
"Created: / 11-04-2012 / 12:48:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!ProjectProblem::ClassListedMultipleTimes methodsFor:'accessing'!
+!ProjectProblem::ClassListedButDoesNotExist methodsFor:'accessing-description'!
+
+description
+ "Return a (HTML) describing the problem."
+ ^
+'A class (<code>%1</code>) is listed in the project definition but
+not present in the system.
+
+You should either create it or remove it from %2.'
+ bindWith: className with: (self linkToClass: self packageDefinitionClass class selector: #classNamesAndAttributes)
+
+ "Modified: / 28-02-2012 / 22:23:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+label
+ ^'Missing class: ', className allBold
+
+ "Modified: / 23-02-2012 / 13:20:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectProblem::ClassListedMultipleTimes methodsFor:'accessing-description'!
description
"Return a (HTML) describing the problem."
@@ -570,11 +594,11 @@
'A class %1 is listed more than once in %2.
Such package will fail to compile, as linker will complain
-about multiple definitions of same symbols. Make sure each
+about multiple definitions of the same symbols. Make sure each
class is listed only once.
'
bindWith: (self linkToClass: className)
- with: (self linkToClass: self packageDefinitionClass class selector: #extensionMethodNames)
+ with: (self linkToClass: self packageDefinitionClass class selector: #extensionMethodNames)
"Modified: / 13-09-2012 / 17:40:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -582,19 +606,19 @@
label
"Return the label (possibly instance if a Text) shortly describing the problem"
- ^'Missing pool (%1)' bindWith: className
+ ^'Class %1 listed multiple times in project definition "%2"' bindWith: className allBold with:self packageDefinitionClass
"Modified: / 23-02-2012 / 13:34:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!ProjectProblem::ClassNotListed methodsFor:'accessing'!
+!ProjectProblem::ClassNotListed methodsFor:'accessing-description'!
description
"Return a (HTML) describing the problem."
^
-'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
+'Class %1 is not listed in project definition (%2).
+<br>The class won''t be compiled and - if some other class dependents on it - the whole package will fail to compile
at all.'
bindWith: (self linkToClass: className)
with: (self linkToClass: self packageDefinitionClass class selector: #classNamesAndAttributes omitClassName: true)
@@ -602,31 +626,46 @@
"Modified: / 26-07-2012 / 10:27:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+label
+ "Return the label (possibly instance if a Text) shortly describing the problem"
+
+ ^'Class %1 not listed in project definition "%2"' bindWith: className allBold with:self packageDefinitionClass
+
+ "Modified: / 23-02-2012 / 13:55:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectProblem::ClassNotListed methodsFor:'fixing'!
+
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.
- UserNotification notify: ('Class added. Do not forgot to check in build support files!!' bindWith: className).
- ^true
- "Created: / 26-07-2012 / 10:41:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ ^ self doIncludeInProjectAsAutoloaded:false
!
doIncludeInProjectAsAutoloaded
"Include subject class in project definition. Return false if
fix fails, true otherwise"
+
+ ^ self doIncludeInProjectAsAutoloaded:true
+!
+
+doIncludeInProjectAsAutoloaded:asAutoloaded
+ "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.
- UserNotification notify: ('Class added. Do not forgot to check in build support files!!' bindWith: className).
+ asAutoloaded ifTrue:[
+ def makeClassesAutoloaded:(Array with: cls) usingCompiler: nil.
+ ] ifFalse:[
+ def includeClasses:(Array with: cls) usingCompiler: nil.
+ ].
+ UserNotification notify: ('Class added. Do not forget to check in build support files!!' bindWith: className).
^true
"Created: / 26-07-2012 / 10:41:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -639,25 +678,28 @@
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
- "Return the label (possibly instance if a Text) shortly describing the problem"
-
- ^'Class %1 not listed in project definition' bindWith: className
-
- "Modified: / 23-02-2012 / 13:55:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::ClassListedBeforeItsPool methodsFor:'accessing'!
+poolName
+ ^ poolName
+!
+
+poolName:something
+ poolName := something.
+! !
+
+!ProjectProblem::ClassListedBeforeItsPool methodsFor:'accessing-description'!
+
description
"Return a (HTML) describing the problem."
^
-'Class %2 is listed in project definition (%1) before one of its pools (%3). Such class will fail to
-compile (if the package is being stc-compiled) and load (if the package is being loaded from
-source). Make sure class (%3) is listed before (%2).
+'Class %2 is listed in project definition (%1) before one of its pools (%3).
+<br>Such class will fail to compile (if the package is being stc-compiled)
+and load (if the package is being loaded from source).
+<br>Make sure class (%3) is listed before (%2).
'
bindWith: (self linkToClass: self packageDefinitionClass class selector: #classNamesAndAttributes omitClassName: true)
@@ -670,17 +712,9 @@
label
"Return the label (possibly instance if a Text) shortly describing the problem"
- ^'Class %1 listed in project definition before one of its pool' bindWith: className
+ ^'Class %1 listed in project definition "%2" before one of its pools' bindWith: className allBold with:self packageDefinitionClass
"Modified: / 13-09-2012 / 17:36:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-poolName
- ^ poolName
-!
-
-poolName:something
- poolName := something.
! !
!ProjectProblem::ClassUsesPoolProblem methodsFor:'accessing'!
@@ -693,16 +727,16 @@
poolName := something.
! !
-!ProjectProblem::ClassUsesPoolButItIsNotASharedPool methodsFor:'accessing'!
+!ProjectProblem::ClassUsesPoolButItIsNotASharedPool methodsFor:'accessing-description'!
description
"Return a (HTML) describing the problem."
^
-'A class %1 uses pool %2 but it does not exists.
+'A class %1 uses pool %2 but it does not exist.
-The pool should be removed from class definition otherwise
-the package won''t compile due missing class.'
+The pool should be removed from the class definition;
+otherwise the package won''t compile due to a missing class.'
bindWith: (self linkToClass: className)
with: (self linkToClass: poolName)
@@ -712,24 +746,24 @@
label
"Return the label (possibly instance if a Text) shortly describing the problem"
- ^'Used pool is not a SharedPool (%1)' bindWith: className
+ ^'Used pool %1 is not a SharedPool' bindWith: className allBold
"Modified: / 23-02-2012 / 13:40:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!ProjectProblem::ClassUsesPoolInNamespaceButNamespaceIsNotDefined methodsFor:'accessing'!
+!ProjectProblem::ClassUsesPoolInNamespaceButNamespaceIsNotDefined methodsFor:'accessing-description'!
description
"Return a (HTML) describing the problem."
^
-'A class %1 uses pool %2 from same namespace as the class itself but
-the namespace is not explicitly written in shared pools definition.
+'A class %1 uses pool %2 from same namespace as the class,
+but the namespace is not explicitly named in the shared pools definition.
Due to a bug in stc, such code will fail to compile. A pool definition
-must contain fully qualified class name including namespace.'
+must contain a fully qualified class name including namespace.'
bindWith: (self linkToClass: className)
- with: (self linkToClass: poolName)
+ with: (self linkToClass: poolName)
"Modified: / 13-09-2012 / 16:32:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -737,21 +771,21 @@
label
"Return the label (possibly instance if a Text) shortly describing the problem"
- ^ 'Missing namespace definition in shared pools definition' bindWith: className
+ ^ 'Missing namespace prefix in shared pools definition of %1' bindWith: className allBold
"Modified: / 13-09-2012 / 16:28:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!ProjectProblem::ClassUsesPoolButItDoesNotExist methodsFor:'accessing'!
+!ProjectProblem::ClassUsesPoolButItDoesNotExist methodsFor:'accessing-description'!
description
"Return a (HTML) describing the problem."
^
-'A class %1 uses pool %2 but it does not exists.
+'A class %1 uses pool %2 but it does not exist.
-The pool should be removed from class definition otherwise
-the package won''t compile due to a missing class.'
+The pool should be removed from the class definition;
+otherwise the package won''t compile due to a missing class.'
bindWith: (self linkToClass: className) with: poolName
"Modified: / 13-09-2012 / 16:24:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -760,7 +794,7 @@
label
"Return the label (possibly instance if a Text) shortly describing the problem"
- ^'Missing pool (%1)' bindWith: className
+ ^'Missing pool: ' , className allBold
"Modified: / 23-02-2012 / 13:34:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
@@ -778,7 +812,7 @@
| class |
class := self klass.
- class isNil ifTrue:[ ^ self ].
+ class isNil ifTrue:[ ^ nil ].
^class compiledMethodAt: selector
"Created: / 26-07-2012 / 10:09:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -808,15 +842,113 @@
"Created: / 23-02-2012 / 14:21:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!ProjectProblem::ExtensionMethodNotListed methodsFor:'accessing'!
+!ProjectProblem::ExtensionMethodListedButInDifferentPackage methodsFor:'accessing-description'!
description
"Return a (HTML) describing the problem."
-^'Method %1 is not listed in %2. Although it does not hurt,
-it should be listed'
+ |mthd text|
+
+ (mthd := self method) isNil ifTrue:[ ^ 'Method removed.' ].
+
+ mthd package = mthd mclass package ifTrue:[
+ text :=
+'Method %1 listed in %3 but is in its classes package (%4).
+Maybe the method used to be an extension but is now a proper part of the class.
+
+It is recommended to remove the method name from the extensions list (%3).'
+ ] ifFalse:[
+ text :=
+'Method %1 listed in %3 but is in a different package (%4).
+The package will compile but may fail to (auto)load from sources.
+
+It is recommended to either remove the method name from the extensions list (%3)
+or move the method it to the correct package.'
+ ].
+ ^ text
+ bindWith: (self linkToClass: (Smalltalk classNamed: className) selector: selector) "className"
+ with: selector
+ with: (self linkToClass: self packageDefinitionClass class selector: #extensionMethodNames)
+ with: mthd package
+
+ "Modified: / 23-02-2012 / 15:18:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+label
+ "Return the label (possibly instance if a Text) shortly describing the problem"
+
+ |mthd text|
+
+ text := 'Extension method %1 >> %2 listed but in different package'.
+
+ (mthd := self method) notNil ifTrue:[
+ mthd package = mthd mclass package ifTrue:[
+ text := 'Extension method %1 >> %2 listed but in classes package'
+ ]
+ ].
+ ^ text
+ bindWith: className allBold
+ with: selector allBold
+
+ "Modified: / 23-02-2012 / 14:22:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectProblem::ExtensionMethodListedButInDifferentPackage methodsFor:'fixes'!
+
+alreadyFixed
+ |mthd|
+
+ (self packageDefinitionClass extensionMethods includes:self method) ifFalse:[^ true].
+ ^ ((mthd := self method) notNil
+ and:[ mthd package = package ])
+!
+
+doMoveMethodToProject
+ self method package:package
+!
+
+doRemoveMethodFromExtensionsList
+ "update the extension method info in the project definition.
+ Return false if fix fails, true otherwise"
+
+ | def mthd |
+
+ def := self packageDefinitionClass.
+ def isNil ifTrue:[ ^ false ].
+ mthd := self method.
+ mthd isNil ifTrue:[ ^ false ].
+
+ def excludeMethods:(Array with:mthd) usingCompiler:nil.
+ UserNotification notify: ('ProjectDefinition updated. Do not forget to check it in!!').
+ ^true
+!
+
+fixes
+ |mthd|
+
+ (mthd := self method) isNil ifTrue:[ ^ #() ].
+
+"/ mthd package = mthd mclass package ifTrue:[
+"/ ^Array
+"/ with: (Array with: 'Remove from the extensionMethodNames list' with: [ self doRemoveMethodFromExtensionsList ])
+"/ ].
+"/
+ ^Array
+ with: (Array with: 'Remove from the extensionMethodNames list' with: [ self doRemoveMethodFromExtensionsList ])
+ with: (Array with: 'Move method into package' with: [ self doMoveMethodToProject ])
+
+ "Created: / 26-07-2012 / 10:41:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectProblem::ExtensionMethodNotListed methodsFor:'accessing-description'!
+
+description
+ "Return a (HTML) describing the problem."
+
+^'Method %1 is not listed in %2.
+<br>It should either be listed in the project definition, or moved to the owning classes package'
bindWith: (self linkToMethod)
- with: (self linkToClass: self packageDefinitionClass class selector: #extensionMethodNames)
+ with: (self linkToClass: self packageDefinitionClass class selector: #extensionMethodNames)
"Modified: / 23-02-2012 / 14:34:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -824,35 +956,125 @@
label
"Return the label (possibly instance if a Text) shortly describing the problem"
- ^'Extension method %1>>%2 not listed' bindWith: className with: selector
+ ^'Extension method %1 >> %2 not listed in project definition "%3"' bindWith: className allBold with: selector allBold with:self packageDefinitionClass
"Modified: / 23-02-2012 / 14:22:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!ProjectProblem::ExtensionMethodToAPrivateClass methodsFor:'accessing'!
+!ProjectProblem::ExtensionMethodNotListed methodsFor:'fixing'!
+
+alreadyFixed
+ ^ (self packageDefinitionClass extensionMethods includes:self method)
+!
+
+doMoveToClassesPackage
+ "move the extension method to the owning classes package.
+ Return false if fix fails, true otherwise"
+
+ | cls mthd |
+
+ cls := self klass.
+ cls isNil ifTrue:[ ^ false ].
+ mthd := cls compiledMethodAt:selector.
+ mthd package:(cls package).
+ UserNotification notify: ('Do not forget to check in the method''s package (or class) ("%1")!!' bindWith:cls package).
+ ^true
+!
+
+doUpdateExtensionMethodsInProject
+ "update the extension method info in the project definition.
+ Return false if fix fails, true otherwise"
+
+ | def mthd |
+
+ def := self packageDefinitionClass.
+ def isNil ifTrue:[ ^ false ].
+ mthd := self method.
+ mthd isNil ifTrue:[ ^ false ].
+
+ def includeMethods:(Array with:mthd) usingCompiler:nil.
+ UserNotification notify: ('ProjectDefinition updated. Do not forget to check it in!!').
+ ^true
+!
+
+fixes
+ ^Array
+ with: (Array with: 'Update project definition' with: [ self doUpdateExtensionMethodsInProject ])
+ with: (Array with: 'Move to classes package' with: [ self doMoveToClassesPackage ])
+! !
+
+!ProjectProblem::ExtensionMethodsClassDoesNotExist methodsFor:'accessing-description'!
description
"Return a (HTML) describing the problem."
-^'Method %1 extends a private class (%2), which is forbidden and won''t compile
-using stc. You have to either move the method to the class''s package or rewrite
-your code without using this extension.'
- bindWith: (self linkToMethod)
- with: (self linkToClass: self method mclass)
+^'Method %1 >> %2 listed in %3 but class does not exist.
+The package will compile but may fail to (auto)load from sources.
- "Created: / 12-03-2013 / 10:28:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+It is recommended to remove the method from the list (%3).'
+ bindWith: className
+ with: selector
+ with: (self linkToClass: self packageDefinitionClass class selector: #extensionMethodNames)
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
- ^'Extension method %1>>%2 extends a private class' bindWith: className with: selector
+ ^'Extension method %1 >> %2 listed but class not existing'
+ bindWith: className allBold
+ with: selector allBold
+
+ "Modified: / 23-02-2012 / 14:22:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectProblem::ClassListedBeforeItsSuperclass methodsFor:'accessing'!
+
+superClassName
+ ^ superClassName
+!
+
+superClassName:something
+ superClassName := something.
+! !
+
+!ProjectProblem::ClassListedBeforeItsSuperclass methodsFor:'accessing-description'!
+
+description
+ "Return a (HTML) describing the problem."
- "Created: / 12-03-2013 / 10:28:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ ^
+'Class %2 is listed in project definition (%1) before its superclass %3.
+<br>The package can be stc-compiled
+(because the generated makefile compiles in correct order)
+but the class may fail to load from source.
+<br>Make sure %3 is listed before %2.
+
+'
+bindWith: (self linkToClass: self packageDefinitionClass class selector: #classNamesAndAttributes omitClassName: true)
+ with: (self linkToClass: className)
+ with: (self linkToClass: superClassName)
+
+ "Modified: / 13-09-2012 / 18:29:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+label
+ "Return the label (possibly instance if a Text) shortly describing the problem"
+
+ ^'Class %1 listed in project definition "%2" before its superclass' bindWith: className allBold with:self packageDefinitionClass
+
+ "Modified: / 13-09-2012 / 17:36:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::MethodCompilabilityIssue methodsFor:'accessing'!
+severity
+ ^ errors notNil ifTrue:[#error] ifFalse:[#warning]
+
+ "Modified: / 11-04-2012 / 15:40:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectProblem::MethodCompilabilityIssue methodsFor:'accessing-description'!
+
description
"Return a (HTML) describing the problem."
@@ -867,7 +1089,7 @@
^ String streamContents:[:s|
s
- nextPutAll: 'Following problems has been found in ';
+ nextPutAll: 'The following problems have been found in ';
nextPutAll: self linkToMethod;
nextPutAll: ':'; cr;
nextPutAll: '<ul>'.
@@ -878,7 +1100,7 @@
errors notNil ifTrue:[
s nextPutAll:
-'STC won''t compile such a code, therefore you must fix it before commiting'
+'STC won''t compile such code, therefore you must fix it before committing'
].
]
@@ -888,23 +1110,26 @@
label
"Return the label (possibly instance if a Text) shortly describing the problem"
- ^ errors notNil ifTrue:[
- 'Uncompilable method %1>>%2' bindWith: className with: selector
- ] ifFalse:[
- 'Warnings for method %1>>%2' bindWith: className with: selector
- ]
+ ^ (errors notNil
+ ifTrue:[ 'Uncompilable method %1 >> %2' ]
+ ifFalse:[ 'Warnings for method %1 >> %2' ]) bindWith: className allBold with: selector allBold
+
"Modified: / 11-04-2012 / 16:04:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-severity
- ^ errors notNil ifTrue:[#error] ifFalse:[#warning]
-
- "Modified: / 11-04-2012 / 15:40:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::MethodCompilabilityIssue methodsFor:'error handling'!
+addError:aMessage from: position to: endPos
+ errors isNil ifTrue:[ errors := OrderedCollection new].
+ errors add: (Error message: aMessage from: position to: endPos)
+!
+
+addWarning:aMessage from: position to: endPos
+ warnings isNil ifTrue:[ warnings := OrderedCollection new].
+ warnings add: (Warning message: aMessage from: position to: endPos)
+!
+
correctableError:aMessage position:position to:endPos from:aCompiler
"error notification during fileIn.
This is sent by the compiler/evaluator if it detects errors."
@@ -942,11 +1167,11 @@
"Argh!!!!!!!! If its an ignorable error, why signal error!!!!!! Bad design,
even worse workaround. Sigh."
- thisContext sender sender sender sender selector == #ignorableParseError:
+ (thisContext findNextContextWithSelector:#ignorableParseError: or:nil or:nil) notNil
+ "/ thisContext sender sender sender sender selector == #ignorableParseError:
ifTrue:[ ^ self ].
- errors isNil ifTrue:[ errors := OrderedCollection new].
- errors add: (Error message: aMessage from: position to: endPos)
+ self addError:aMessage from: position to: endPos
"Created: / 30-07-1999 / 18:10:30 / cg"
"Modified: / 10-09-2012 / 11:32:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -994,13 +1219,6 @@
!ProjectProblem::MethodCompilabilityIssue::Error methodsFor:'accessing'!
-descriptionOn: stream
-
- stream nextPutAll: message; space; nextPutAll:'(error)'
-
- "Created: / 11-04-2012 / 15:52:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
endPosition
^ endPosition
!
@@ -1025,6 +1243,15 @@
startPosition := something.
! !
+!ProjectProblem::MethodCompilabilityIssue::Error methodsFor:'accessing-description'!
+
+descriptionOn: stream
+
+ stream nextPutAll: message; space; nextPutAll:'(error)'
+
+ "Created: / 11-04-2012 / 15:52:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!ProjectProblem::MethodCompilabilityIssue::Warning class methodsFor:'instance creation'!
message: message from: startPosition to: endPosition
@@ -1040,13 +1267,6 @@
!ProjectProblem::MethodCompilabilityIssue::Warning methodsFor:'accessing'!
-descriptionOn: stream
-
- stream nextPutAll: message; space"/; nextPutAll:'(warning)'
-
- "Created: / 11-04-2012 / 15:52:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
endPosition
^ endPosition
!
@@ -1071,20 +1291,16 @@
startPosition := something.
! !
-!ProjectProblem::MethodInNoPackage methodsFor:'accessing'!
+!ProjectProblem::MethodCompilabilityIssue::Warning methodsFor:'accessing-description'!
-description
- "Return a (HTML) describing the problem."
+descriptionOn: stream
- ^
-'Method %1 does not belong to any package. Such methods
-are not commited and will be lost when you restart/recompile.
-Method should be moved to some package, %2 maybe?'
- bindWith: (self linkToMethod)
- with: package
+ stream nextPutAll: message; space"/; nextPutAll:'(warning)'
- "Modified: / 23-02-2012 / 14:21:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
+ "Created: / 11-04-2012 / 15:52:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectProblem::MethodInNoPackage methodsFor:'accessing'!
fixes
@@ -1103,28 +1319,43 @@
])
"Created: / 26-07-2012 / 09:53:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectProblem::MethodInNoPackage methodsFor:'accessing-description'!
+
+description
+ "Return a (HTML) describing the problem."
+
+ ^
+'Method %1 does not belong to any package. Such methods
+are not committed and will be lost when you restart/recompile.
+Method should be moved to some package, %2 maybe?'
+ bindWith: (self linkToMethod)
+ with: package
+
+ "Modified: / 23-02-2012 / 14:21:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
- ^'Unpackaged method %1>>%2' bindWith: className with: selector
+ ^'Unpackaged method %1 >> %2' bindWith: className allBold with: selector allBold
"Modified: / 23-02-2012 / 14:19:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!ProjectProblem::ExtensionMethodListedButDoesNotExist methodsFor:'accessing'!
+!ProjectProblem::ExtensionMethodListedButDoesNotExist methodsFor:'accessing-description'!
description
"Return a (HTML) describing the problem."
-^'Method %1>>%2 listed in %3 but does not exists. This does not hurt
-if you stc-compile all your code, but such a package will fail to
-(auto)load from sources.
+^'Method %1 listed in %3 but does not exist.
+The package will compile but may fail to (auto)load from sources.
-It is highly reccomended to remove the method from the list (%3).'
- bindWith: className with: selector
- with: (self linkToClass: self packageDefinitionClass class selector: #extensionMethodNames)
+It is recommended to remove the method from the list (%3).'
+ bindWith: (self linkToClass: (Smalltalk classNamed: className) selector: selector) "className"
+ with: selector
+ with: (self linkToClass: self packageDefinitionClass class selector: #extensionMethodNames)
"Modified: / 23-02-2012 / 15:18:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -1132,20 +1363,34 @@
label
"Return the label (possibly instance if a Text) shortly describing the problem"
- ^'Extension method %1>>%2 listed but not exist' bindWith: className with: selector
+ ^'Extension method %1 >> %2 listed but not existing' bindWith: className allBold with: selector allBold
"Modified: / 23-02-2012 / 14:22:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::MethodSourceCorrupted methodsFor:'accessing'!
+severity
+ "Return a severity - one of #error, #warning, #info"
+
+ ^#error
+
+ "Created: / 11-04-2012 / 12:47:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectProblem::MethodSourceCorrupted methodsFor:'accessing-description'!
+
description
"Return a (HTML) describing the problem."
^
'Source code for %1 is <b>corrupted</b>. This is likely because
the binary class version does not match the source file. This may happen,
-for instance, if you compile a class library and then edit the .st file.'
+for instance, if you compile a class library and then edit the .st file,
+or you have checked out from the SCM over the existing source code.
+<BR>Be very careful with checkin or fileOut, and check for currupt source code.
+<BR>It is recommended to leave ST/X, restore the old source or compile a system
+based on the current source, restart ST/X, reapply the chages and commit then.'
bindWith: (self linkToMethod)
with: package
@@ -1155,26 +1400,28 @@
label
"Return the label (possibly instance if a Text) shortly describing the problem"
- ^ 'Corrupted source code for %1>>%2' bindWith: className with: selector
+ ^ 'Corrupted source code for %1 >> %2' bindWith: className allBold with: selector allBold
"Modified: / 11-04-2012 / 12:42:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
+! !
+
+!ProjectProblem::MethodSourceNotAvailable methodsFor:'accessing'!
severity
"Return a severity - one of #error, #warning, #info"
^#error
- "Created: / 11-04-2012 / 12:47:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 11-04-2012 / 12:47:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!ProjectProblem::MethodSourceNotAvailable methodsFor:'accessing'!
+!ProjectProblem::MethodSourceNotAvailable methodsFor:'accessing-description'!
description
"Return a (HTML) describing the problem."
^
-'Source code for %1 is not available. Check your package path
+'Source code for %1 is not available. Check your package path
and/or source code management settings.
'
bindWith: (self linkToMethod)
@@ -1186,37 +1433,13 @@
label
"Return the label (possibly instance if a Text) shortly describing the problem"
- ^ 'Unavailable source code for %1>>%2' bindWith: className with: selector
+ ^ 'Unavailable source code for %1 >> %2' bindWith: className allBold with: selector allBold
"Modified: / 11-04-2012 / 12:41:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-severity
- "Return a severity - one of #error, #warning, #info"
-
- ^#error
-
- "Created: / 11-04-2012 / 12:47:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::ProjectDefinitionDoesNotExist methodsFor:'accessing'!
-description
- "Return a (HTML) describing the problem."
-
- ^
-'A project definition class for package %1 does not exists.
-You <b>must</b> create it, otherwise package management won''t work'.
-
- "Modified: / 23-02-2012 / 13:29:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-label
- ^'Project definition class for %1 does not exist' bindWith: package
-
- "Modified: / 23-02-2012 / 13:21:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
severity
"Return a severity - one of #error, #warning, #info"
@@ -1225,22 +1448,74 @@
"Created: / 11-04-2012 / 12:48:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!ProjectProblem::ProjectDefinitionDoesNotExist methodsFor:'accessing-description'!
+
+description
+ "Return a (HTML) describing the problem."
+
+ package = 'stx' ifTrue:[
+ ^
+'Move your code to another package.
+<br>The package named "stx" is reserveed for exept''s ST/X development.'
+ ].
+
+ ^
+'A project definition class for package "%1" does not exist.
+<br>Project definition classes keep the meta information of a package,
+such as contents and build parameters.
+You <b>must</b> create it, otherwise package management won''t work.'
+ bindWith: package
+
+ "Modified: / 23-02-2012 / 13:29:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+label
+ ^'Project definition class for "%1" does not exist' bindWith: package
+
+ "Modified: / 23-02-2012 / 13:21:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectProblem::ProjectDefinitionDoesNotExist methodsFor:'fixing'!
+
+doCreateAs:whatType
+ ProjectDefinition
+ definitionClassForPackage:package
+ projectType: whatType
+ createIfAbsent:true.
+!
+
+doCreateAsGUIApplication
+ self doCreateAs:ProjectDefinition guiApplicationType
+!
+
+doCreateAsLibrary
+ self doCreateAs:ProjectDefinition libraryType
+!
+
+doCreateAsNonGUIApplication
+ self doCreateAs:ProjectDefinition nonGuiApplicationType
+!
+
+fixes
+ package = 'stx' ifTrue:[ ^ #() ].
+
+ ^ Array
+ with: (Array with:'Create as Library' with:[ self doCreateAsLibrary ] )
+ with: (Array with:'Create as GUI Application' with:[ self doCreateAsGUIApplication ] )
+ with: (Array with:'Create as non-GUI Application' with:[ self doCreateAsNonGUIApplication ] )
+! !
+
!ProjectProblem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/ProjectProblem.st,v 1.5 2012/09/13 17:30:14 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ProjectProblem.st,v 1.17 2013-03-30 21:02:36 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic3/ProjectProblem.st,v 1.5 2012/09/13 17:30:14 vrany Exp §'
-!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ProjectProblem.st,v 1.17 2013-03-30 21:02:36 cg Exp $'
!
version_SVN
- ^ '§Id: ProjectProblem.st 1971 2012-09-27 19:37:25Z vranyj1 §'
+ ^ '§Id: ProjectProblem.st 1962 2012-09-10 10:34:08Z vranyj1 §'
! !
--- a/SourceCodeManagerUtilities.st Fri Mar 29 19:43:35 2013 +0000
+++ b/SourceCodeManagerUtilities.st Mon Apr 01 14:07:13 2013 +0100
@@ -52,6 +52,7 @@
"
! !
+
!SourceCodeManagerUtilities class methodsFor:'instance creation'!
forManager: aSourceCodeManager
@@ -72,6 +73,7 @@
"Modified: / 25-07-2012 / 17:10:55 / cg"
! !
+
!SourceCodeManagerUtilities class methodsFor:'Signal constants'!
yesToAllNotification
@@ -88,6 +90,7 @@
^ YesToAllQuery
! !
+
!SourceCodeManagerUtilities class methodsFor:'accessing'!
default
@@ -123,6 +126,7 @@
LastPackage := something.
! !
+
!SourceCodeManagerUtilities class methodsFor:'error handling'!
doesNotUnderstand: aMessage
@@ -140,6 +144,7 @@
"Created: / 10-10-2011 / 14:04:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!SourceCodeManagerUtilities class methodsFor:'private-migration'!
compileForwarders
@@ -174,12 +179,14 @@
"Created: / 11-10-2011 / 10:55:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!SourceCodeManagerUtilities class methodsFor:'resources'!
resourcePackage
^ #'stx:libtool'
! !
+
!SourceCodeManagerUtilities class methodsFor:'utilities'!
classIsNotYetInRepository:aClass withManager:mgr
@@ -249,6 +256,7 @@
^self default versionString:a isLessThan:b
! !
+
!SourceCodeManagerUtilities class methodsFor:'utilities-cvs'!
changeSetForExtensionMethodsForPackage:packageToCheckOut askForRevision:askForRevision usingManager:aSourceCodeManager
@@ -559,6 +567,7 @@
"Created: / 29-12-2011 / 14:31:43 / cg"
! !
+
!SourceCodeManagerUtilities class methodsFor:'utilities-cvs-helpers'!
getMethodVersionsOfClass:aClass selector:selector numberOfRevisions:numberOfRevisionsOrNil
@@ -570,6 +579,7 @@
^self default getMethodVersionsOfClass:aClass selector:selector numberOfRevisions:numberOfRevisionsOrNil
! !
+
!SourceCodeManagerUtilities class methodsFor:'utilities-cvs-user interaction'!
askForContainer:boxText title:title note:notice initialModule:initialModule initialPackage:initialPackage initialFileName:initialFileName
@@ -643,6 +653,7 @@
^self default goodInitialLogMessageForCheckinClassOfClass:aClass
! !
+
!SourceCodeManagerUtilities class methodsFor:'utilities-encoding'!
guessEncodingOfFile:aFilename
@@ -661,6 +672,7 @@
^ CharacterEncoder guessEncodingOfStream:aStream
! !
+
!SourceCodeManagerUtilities methodsFor:'accessing'!
classResources
@@ -704,6 +716,7 @@
"Created: / 11-10-2011 / 12:01:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!SourceCodeManagerUtilities methodsFor:'error handling'!
doesNotUnderstand: aMessage
@@ -721,6 +734,7 @@
"Created: / 10-10-2011 / 14:02:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!SourceCodeManagerUtilities methodsFor:'initialization'!
initialize
@@ -744,6 +758,7 @@
"Modified: / 25-07-2012 / 08:35:35 / cg"
! !
+
!SourceCodeManagerUtilities methodsFor:'utilities'!
classIsNotYetInRepository:aClass withManager:mgr
@@ -906,15 +921,15 @@
!
validateConsistencyOfPackage:aPackage doClasses:doClasses doExtensions:doExtensions
- |checker defClass report msg answer dialog|
-
- defClass := aPackage asPackageId projectDefinitionClass.
- "/ also done by ProjectChecker
+ |checker report msg answer dialog|
+
+ "/ also done by ProjectChecker...
+ "/ defClass := aPackage asPackageId projectDefinitionClass.
"/ defClass validateDescription.
checker := ProjectChecker new.
checker checkExtensionsOnly:(doClasses not and:[ doExtensions ]).
- report := checker check: defClass package.
+ report := checker check: aPackage.
(report notNil and:[report problems notEmptyOrNil]) ifTrue:[
report problems size == 1 ifTrue:[
msg := 'The ProblemChecker found the following error/inconsistency:\\ %2\\Need more detail or help for repair?'
@@ -930,11 +945,11 @@
answer == true ifTrue:[
dialog := Tools::ProjectCheckerBrowser new.
dialog
- projectChecker: (ProjectChecker forPackage: defClass package);
+ projectChecker: (ProjectChecker forPackage: aPackage);
problemList:report problems;
showCancel:true;
openModal.
-self halt.
+
dialog accepted ifFalse:[
AbortSignal raiseRequest
].
@@ -988,6 +1003,7 @@
"Modified: / 17-02-2011 / 10:20:14 / cg"
! !
+
!SourceCodeManagerUtilities methodsFor:'utilities-cvs'!
changeSetForExtensionMethodsForPackage:packageToCheckOut askForRevision:askForRevision usingManager:aSourceCodeManager
@@ -2428,14 +2444,15 @@
aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd | mthd setPackage:requiredPackage].
aClass package:requiredPackage.
- (mgr
+ [ mgr
createContainerFor:aClass
inModule:module
package:directory
container:fileName
- ) ifFalse:[
- self warn:(resources string:'Failed to create container.').
- ^ false.
+ ] whileFalse:[
+ (Dialog confirm:(resources stringWithCRs:'Failed to create container.\(fix your setup then retry, or cancel)\\Retry?') yesLabel:'Retry') ifFalse:[
+ ^ false.
+ ].
].
^ true
@@ -3041,6 +3058,7 @@
"Created: / 29-12-2011 / 14:32:38 / cg"
! !
+
!SourceCodeManagerUtilities methodsFor:'utilities-cvs-helpers'!
getMethodVersionsOfClass:aClass selector:selector numberOfRevisions:numberOfRevisionsOrNil
@@ -3117,6 +3135,7 @@
"
! !
+
!SourceCodeManagerUtilities methodsFor:'utilities-cvs-user interaction'!
askForContainer:boxText title:title note:notice initialModule:initialModule initialPackage:initialPackage initialFileName:initialFileName
@@ -3851,6 +3870,7 @@
"Modified: / 26-09-2012 / 18:31:38 / cg"
! !
+
!SourceCodeManagerUtilities methodsFor:'utilities-encoding'!
guessEncodingOfFile:aFilename
@@ -3888,14 +3908,15 @@
^ CharacterEncoder guessEncodingOfStream:aStream
! !
+
!SourceCodeManagerUtilities class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.268 2013-03-27 19:36:57 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.269 2013-03-28 10:48:26 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.268 2013-03-27 19:36:57 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.269 2013-03-28 10:48:26 cg Exp $'
!
version_HG
--- a/SourceCodeManagerUtilitiesForContainerBasedManagers.st Fri Mar 29 19:43:35 2013 +0000
+++ b/SourceCodeManagerUtilitiesForContainerBasedManagers.st Mon Apr 01 14:07:13 2013 +0100
@@ -343,7 +343,9 @@
allClasses := classes.
checkinInfoOrString quickCheckIn ifTrue:[
- classes := classes select:[:aClass | aClass hasUnsavedChanges].
+ "/ not only the one's in the changeSet;
+ "/ also those which have not been checked in before.
+ classes := classes select:[:each | each hasUnsavedChanges or:[ (each revisionOfManager:aManagerOrNil) isNil ]].
classes isEmpty ifTrue:[ Dialog information:'no changes to checkin (quickCheckIn)' ]
].
@@ -492,20 +494,19 @@
!
checkinPackage:packageToCheckIn classes:doClasses extensions:doExtensions buildSupport:doBuild askForMethodsInOtherPackages:askForMethodsInOtherPackages
- |mgr classes classesToCheckIn methodsToCheckIn
+ |mgr classesToCheckIn methodsToCheckIn
methodsInOtherPackages looseMethods otherPackages
- msg classesInChangeSet checkinInfo originalCheckinInfo classesToTag|
+ msg classesInChangeSet newClasses checkinInfo originalCheckinInfo classesToTag|
mgr := self sourceCodeManagerFor: packageToCheckIn.
- classes := Smalltalk allClasses.
classesToCheckIn := IdentitySet new.
methodsToCheckIn := IdentitySet new.
methodsInOtherPackages := IdentitySet new.
looseMethods := IdentitySet new.
- "/ classes ...
- classes do:[:aClass |
+ "/ collect classes and individual methods...
+ Smalltalk allClassesDo:[:aClass |
|owner classPackage|
(owner := aClass owningClass) notNil ifTrue:[
@@ -516,6 +517,20 @@
(classPackage = packageToCheckIn) ifTrue:[
classesToCheckIn add:aClass.
].
+
+ doExtensions ifTrue:[
+ aClass isMeta ifFalse:[
+ "/ ... whose class is not in the checkIn-set
+ (classesToCheckIn includes:aClass) ifFalse:[
+ aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
+ "/ methods in this project ...
+ (mthd package = packageToCheckIn) ifTrue:[
+ methodsToCheckIn add:mthd
+ ]
+ ]
+ ].
+ ].
+ ].
].
"/ cg: O(n^2) algorithm
@@ -523,21 +538,6 @@
"/ replaced by: O(n) algorithm
classesInChangeSet := ChangeSet current selectClassesForWhichIncludesChangeForClassOrMetaclassOrPrivateClassFrom:classesToCheckIn.
- "/ individual methods ...
- classes do:[:aClass |
- aClass isMeta ifFalse:[
- "/ ... whose class is not in the chechIn-set
- (classesToCheckIn includes:aClass) ifFalse:[
- aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
- "/ methods in this project ...
- (mthd package = packageToCheckIn) ifTrue:[
- methodsToCheckIn add:mthd
- ]
- ]
- ].
- ].
- ].
-
doExtensions ifTrue:[
methodsToCheckIn notEmpty ifTrue:[
doClasses ifTrue:[
@@ -568,6 +568,8 @@
checkinInfo validateConsistency ifTrue:[
self validateConsistencyOfPackage:packageToCheckIn doClasses:doClasses doExtensions:doExtensions.
+ "/ could have changed/recompiled methods
+ methodsToCheckIn := packageToCheckIn asPackageId projectDefinitionClass extensionMethods
].
(self
@@ -598,11 +600,13 @@
checkinInfo isNil ifTrue:[
checkinInfo := self
- getCheckinInfoFor:('%1 classes (%4 changed) and %2 extensions for project "%3"'
- bindWith:classesToCheckIn size
- with:methodsToCheckIn size
- with:packageToCheckIn allBold
- with:classesInChangeSet size)
+ getCheckinInfoFor:((doExtensions
+ ifTrue:['%1 classes (%4 changed) and %2 extensions for project "%3"']
+ ifFalse:['%1 classes (%4 changed) for project "%3"'])
+ bindWith:classesToCheckIn size
+ with:methodsToCheckIn size
+ with:packageToCheckIn allBold
+ with:classesInChangeSet size)
initialAnswer:nil
withQuickOption:(classesToCheckIn size > 0)
withValidateConsistencyOption:true.
@@ -622,7 +626,13 @@
checkinInfo isStable:false.
checkinInfo tag:nil.
].
- classesToCheckIn := classesInChangeSet.
+ "/ not only the one's in the changeSet;
+ "/ also those which have not been checked in before.
+ newClasses := classesToCheckIn select:[:class | (class revisionOfManager:mgr) isNil ].
+ classesToCheckIn := Set new
+ addAll:classesInChangeSet;
+ addAll:newClasses;
+ yourself.
].
"/ check if any of the classes contains methods for other packages ...
@@ -725,11 +735,11 @@
!SourceCodeManagerUtilitiesForContainerBasedManagers class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilitiesForContainerBasedManagers.st,v 1.6 2013-03-27 16:38:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilitiesForContainerBasedManagers.st,v 1.8 2013-03-31 00:27:16 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilitiesForContainerBasedManagers.st,v 1.6 2013-03-27 16:38:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilitiesForContainerBasedManagers.st,v 1.8 2013-03-31 00:27:16 cg Exp $'
!
version_HG