--- a/changelog Wed Mar 05 09:21:52 2014 +0000
+++ b/changelog Wed Mar 05 09:55:13 2014 +0000
@@ -1,6 +1,7 @@
2014-03-05 Jan Vrany <jan.vrany (o) fit.cvut.cz>
* Fixed handling of circular class renames (issue #18)
+ * Improved support for nested packages (issue #29)
2013-07-19 Jan Vrany <jan.vrany (o) fit.cvut.cz>
--- a/common/Make.spec Wed Mar 05 09:21:52 2014 +0000
+++ b/common/Make.spec Wed Mar 05 09:55:13 2014 +0000
@@ -55,6 +55,8 @@
SCMAbstractPackageModelRegistry \
SCMAbstractSourceCodeManager \
SCMAbstractTask \
+ SCMCodeMonitor \
+ SCMCommonPackageModelGroup \
SCMCommonSourceCodeManagerUtilities \
SCMCompatModeQuery \
stx_libscm_common \
@@ -71,6 +73,8 @@
$(OUTDIR_SLASH)SCMAbstractPackageModelRegistry.$(O) \
$(OUTDIR_SLASH)SCMAbstractSourceCodeManager.$(O) \
$(OUTDIR_SLASH)SCMAbstractTask.$(O) \
+ $(OUTDIR_SLASH)SCMCodeMonitor.$(O) \
+ $(OUTDIR_SLASH)SCMCommonPackageModelGroup.$(O) \
$(OUTDIR_SLASH)SCMCommonSourceCodeManagerUtilities.$(O) \
$(OUTDIR_SLASH)SCMCompatModeQuery.$(O) \
$(OUTDIR_SLASH)stx_libscm_common.$(O) \
--- a/common/SCMAbstractCommitDialog.st Wed Mar 05 09:21:52 2014 +0000
+++ b/common/SCMAbstractCommitDialog.st Wed Mar 05 09:55:13 2014 +0000
@@ -455,11 +455,16 @@
!SCMAbstractCommitDialog methodsFor:'accessing'!
defaultSubtitle
- | t |
+ | t packages|
t := self task.
- ^t package notNil ifTrue:[
- 'Package: ' , t package name asText allItalic
+ packages := t packages.
+ ^packages notEmptyOrNil ifTrue:[
+ packages size == 1 ifTrue:[
+ 'Package: ' , packages anElement name asText allItalic
+ ] ifFalse:[
+ 'Packages: ' , ((packages collect:[:e | e name ]) asStringWith: ', ')
+ ].
] ifFalse:[
| title |
@@ -471,7 +476,7 @@
]
"Created: / 28-10-2008 / 09:14:45 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 01-04-2013 / 12:04:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-02-2014 / 23:45:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fileListToCommit
@@ -570,6 +575,25 @@
"Modified: / 12-01-2013 / 14:03:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+doCommitAllChangedPackages
+ "raise an error: this method should be implemented (TODO)"
+
+ | revision packages |
+
+ "/ Collect all changed packages at given revision...
+ revision := task packages revision.
+ packages := task packages class new.
+ task packages anElement root yourselfAndAllChildrenDo:[:each|
+ (each isVirtual not and:[each revision = revision and:[ each hasChanges ]]) ifTrue:[
+ packages add: each.
+ ].
+ ].
+ task packages: packages.
+ self postOpenWith: builder
+
+ "Created: / 03-03-2014 / 10:08:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
doShowDiffsForEntry
"raise an error: must be redefined in concrete subclass(es)"
@@ -729,14 +753,44 @@
"Created: / 08-02-2012 / 18:30:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-postOpenWith: anUIBuilder
+postOpenWith1: anUIBuilder
+
+ (self task isPackageCommit
+ and:[ self task isSelectiveFileoutTask not
+ and:[ self task isCommitingAllChangedPackages not ]]) ifTrue:[
+ self infoPanel
+ reset;
+ beInformation;
+ message:(resources string: 'There are more changed packages...');
+ addButtonWithLabel: (resources string:'Commit all changed')
+ action: [ self doCommitAllChangedPackages. self infoPanel hide.];
+ addButtonWithLabel: (resources string:'Continue')
+ action: [ self infoPanel hide. ];
+ show.
+ ^ false.
+ ].
+ ^ true.
+
+ "Created: / 03-03-2014 / 10:00:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+postOpenWith2: anUIBuilder
self showProgressWhile:[
self doUpdateCode.
self doRunSanityChecks
].
+ "Created: / 03-03-2014 / 09:59:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+postOpenWith: anUIBuilder
+ (self postOpenWith1: anUIBuilder) ifTrue:[
+ self postOpenWith2: anUIBuilder
+ ].
+
"Created: / 09-02-2012 / 15:23:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 03-03-2014 / 10:01:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractCommitDialog methodsFor:'private'!
@@ -752,7 +806,7 @@
ActivityNotification notify: (self resources string:'Checking code...').
checker := self task doSanityChecks.
"/ #doSanityChecks may return nil if the ProjectChecker is not available
- "/ (like in St/X 6.2.2
+ "/ (like in St/X 6.2.2)
(checker isNil or:[(problems := checker problems) isEmptyOrNil]) ifTrue:[
self doUpdateWorkingCopy.
^self.
@@ -787,6 +841,7 @@
"Created: / 10-05-2012 / 17:24:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 30-06-2013 / 12:50:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 21-02-2014 / 23:30:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doUpdateCode
--- a/common/SCMAbstractCommitTask.st Wed Mar 05 09:21:52 2014 +0000
+++ b/common/SCMAbstractCommitTask.st Wed Mar 05 09:55:13 2014 +0000
@@ -56,8 +56,8 @@
self isPackageCommit ifTrue:[
message := String streamContents: [:s|
| klasses methods msg |
- klasses := self classesToFileOut.
- methods := self extensionMethodsToFileOut.
+ klasses := OrderedCollection streamContents:[:s|packages do:[:each | s nextPutAll: (self classesToFileOutFor: each) ]].
+ methods := OrderedCollection streamContents:[:s|packages do:[:each | s nextPutAll: (self extensionMethodsToFileOutFor: each) ]]. .
klasses do:[:cls|
msg := SCMAbstractSourceCodeManager utilities goodInitialLogMessageForCheckinClassOfClass:cls.
msg notEmptyOrNil ifTrue: [
@@ -76,7 +76,7 @@
].
^message.
- "Modified: / 01-04-2013 / 13:56:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-02-2014 / 23:49:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
message:aString
@@ -121,7 +121,7 @@
containers := paths
] ifTrue:[
commitLabel := (paths isEmptyOrNil or:[paths size > 2])
- ifTrue:[self package name ? '']
+ ifTrue:[packages size == 1 ifTrue:[ packages anElement name ] ifFalse:[ packages first name , ', ...' ]]
ifFalse:[paths asStringWith:', '].
containers := paths isEmptyOrNil
ifTrue:[self isSelectiveFileoutTask
@@ -139,13 +139,13 @@
].
].
self isPackageCommit ifTrue:[
- self package commited.
+ packages do:[:each | each isVirtual ifFalse: [ each commited ] ]
].
"Created: / 11-04-2008 / 09:20:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 19-08-2009 / 12:27:44 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 14-03-2012 / 17:42:25 / jv"
- "Modified: / 01-04-2013 / 13:22:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-02-2014 / 22:54:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doPrepareWorkingCopy
@@ -173,12 +173,16 @@
self isPackageCommit ifTrue:[
self do:[
- self package ensureTemporaryWorkingCopy.
+ | p |
+
+ p := packages anElement.
+ p ensureTemporaryWorkingCopy.
self doFileOut
]
].
"Created: / 10-05-2012 / 17:08:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 21-02-2014 / 23:28:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractCommitTask methodsFor:'executing-private'!
@@ -187,6 +191,7 @@
"Actually commit the changes, To be overridden by subclasses"
self synchronized:[
+ self halt: 'Have to be smart here!!!!!!'.
self package workingCopy commit: msg files: containers.
"/ "Update the working copy. We need svn info
@@ -197,7 +202,7 @@
].
"Created: / 15-11-2012 / 09:39:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 15-11-2012 / 16:55:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 21-02-2014 / 23:27:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doSanityChecks
@@ -206,34 +211,54 @@
Return a project checker. Use #problems to get the
list of problems"
+ | checker |
+
self isPackageCommit ifFalse:[ ^ nil ].
(ConfigurableFeatures includesFeature:#ProjectChecker) ifFalse:[ ^ nil ].
- ^ProjectChecker new
- package: self package name;
+ checker := ProjectChecker new.
+ packages do:[:each | each isVirtual ifFalse: [ checker package: each name ] ].
+
+ checker
classes: classes;
methods: (extensionMethods = #() ifTrue:[nil] ifFalse:[extensionMethods]);
- check;
- yourself
+ check.
+ ^ checker
"Created: / 11-04-2008 / 09:19:27 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 17-08-2009 / 18:28:34 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 13-02-2012 / 16:36:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-02-2014 / 22:54:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doShrinkChanges
"Do this only iff this is a package commit"
self isPackageCommit ifTrue:[
- (ChangeSet current)
- condenseChangesForPackageAfterCommit:self package name;
- condenseChangesForExtensionsInPackage:self package name;
- flushChangedClassesCache;
- yourself.
+ packages do:[:each |
+ each isVirtual ifFalse: [
+ (ChangeSet current)
+ condenseChangesForPackageAfterCommit:each name;
+ condenseChangesForExtensionsInPackage:each name;
+ flushChangedClassesCache;
+ yourself.
+ ]
+ ]
].
"Created: / 15-11-2012 / 09:41:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 20-11-2012 / 21:13:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-02-2014 / 22:54:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SCMAbstractCommitTask methodsFor:'queries'!
+
+isCommitingAllChangedPackages
+ "Return true, if package group contain all changed packages
+ of given repository, false otherwise."
+
+ ^ packages containsAllChangedPackages
+
+ "Created: / 03-03-2014 / 00:12:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractCommitTask methodsFor:'testing'!
@@ -243,10 +268,10 @@
(or part of it). False if this is ad-hoc commit task -
for example ad-hoc commit from a file browser"
- ^ self package notNil" and:[paths isEmptyOrNil]"
+ ^ packages notEmpty" and:[paths isEmptyOrNil]"
"Modified: / 14-03-2012 / 17:27:17 / jv"
- "Modified: / 17-03-2012 / 19:49:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 21-02-2014 / 22:54:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractCommitTask class methodsFor:'documentation'!
--- a/common/SCMAbstractFileoutLikeTask.st Wed Mar 05 09:21:52 2014 +0000
+++ b/common/SCMAbstractFileoutLikeTask.st Wed Mar 05 09:55:13 2014 +0000
@@ -5,7 +5,7 @@
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
-version 2.1 of the License.
+version 2.1 of the License.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -37,7 +37,7 @@
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
-version 2.1 of the License.
+version 2.1 of the License.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -64,22 +64,35 @@
!
filesToGenerate
+ self error: 'Should not be sent'.
^ self packageDefinition fileNamesToGenerate keys
"
- SVN::CommitTask new
- package: #stx:libsvn;
- buildSupportFiles"
+ SVN::CommitTask new
+ package: #stx:libsvn;
+ buildSupportFiles"
"Created: / 27-11-2009 / 11:29:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 17-11-2010 / 14:08:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-02-2014 / 22:31:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+filesToGenerateFor: package
+ ^ package definition fileNamesToGenerate keys
+
+ "
+ SVN::CommitTask new
+ package: #stx:libsvn;
+ buildSupportFiles"
+
+ "Created: / 22-02-2014 / 22:31:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
packageDefinition
-
+ self error: 'Should not be sent'.
^self package definition
"Created: / 27-11-2009 / 11:27:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 21-02-2014 / 22:53:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
suppresBuildSupportFiles
@@ -109,122 +122,142 @@
!SCMAbstractFileoutLikeTask methodsFor:'executing - private'!
doAddNewContainers
+ packages do:[:each | each isVirtual ifFalse: [ self doAddNewContainersFor: each ] ]
+
+ "Created: / 11-04-2008 / 10:58:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 19-08-2009 / 14:00:26 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 27-02-2014 / 22:55:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+doAddNewContainersFor: package
| wcroot containers |
ActivityNotification notify:'Adding new containers'.
- containers :=
- self isSelectiveFileoutTask
- ifTrue:[#()]
- ifFalse:[self containersToFileOut].
- wcroot := self temporaryWorkingCopyRoot.
+ containers :=
+ self isSelectiveFileoutTask
+ ifTrue:[#()]
+ ifFalse:[self containersToFileOutFor: package].
+ wcroot := package temporaryWorkingCopyRoot.
+ containers do:[:nm|
+ | entry |
- containers do:[:nm|
- | entry |
-
- entry := wcroot / nm.
- entry track.
+ entry := wcroot / nm.
+ entry track.
]
- "Created: / 11-04-2008 / 10:58:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 19-08-2009 / 14:00:26 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 15-11-2012 / 00:14:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 22-02-2014 / 22:49:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doCompileCopyrightMethods
- | klasses source |
-
- (self packageDefinition class includesSelector: #copyright) ifFalse:[^self].
- ActivityNotification notify:'Compiling #copyright methods...'.
- klasses := self classesToFileOut asArray.
- source := (self packageDefinition class compiledMethodAt: #copyright) source.
-
- klasses
- withIndexDo:[:cls :index |
- |metaCls|
- metaCls := cls theMetaclass.
- (((metaCls includesSelector:#copyright) not) and:[metaCls programmingLanguage isSmalltalk])
- ifTrue:[
- metaCls compile:source classified:'documentation'.
- (metaCls compiledMethodAt:#copyright)
- setPackage:self package name asSymbol
- ].
- ProgressNotification newException
- messageText: ('Compiling %1 (%2)' bindWith:#copyright
- with:cls nameWithoutPrefix);
- parameter: (100 / klasses size) * index;
- raiseRequest.
-
- ]
+ packages do:[:each | each isVirtual ifFalse: [ self doCompileCopyrightMethodsFor: each ] ]
"Modified: / 16-08-2009 / 12:59:50 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 08-04-2010 / 14:31:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 30-06-2013 / 12:44:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-02-2014 / 22:55:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+doCompileCopyrightMethodsFor: package
+ | klasses source |
+
+ (package definition class includesSelector: #copyright) ifFalse:[^self].
+ ActivityNotification notify:'Compiling #copyright methods...'.
+ klasses := (self classesToFileOutFor: package) asArray.
+ source := (package definition class compiledMethodAt: #copyright) source.
+
+ klasses
+ withIndexDo:[:cls :index |
+ |metaCls|
+ metaCls := cls theMetaclass.
+ (((metaCls includesSelector:#copyright) not) and:[metaCls programmingLanguage isSmalltalk])
+ ifTrue:[
+ metaCls compile:source classified:'documentation'.
+ (metaCls compiledMethodAt:#copyright)
+ setPackage:package name asSymbol
+ ].
+ ProgressNotification newException
+ messageText: ('Compiling %1 (%2)' bindWith:#copyright
+ with:cls nameWithoutPrefix);
+ parameter: (100 / klasses size) * index;
+ raiseRequest.
+ ]
+
+ "Created: / 21-02-2014 / 22:59:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doCompileVersionMethods
- self doCompileVersionMethodsIn: self classesToFileOut asArray.
+ packages do:[:each |
+ each isVirtual ifFalse: [
+ | klasses |
+
+ klasses := self classesToFileOutFor: each.
+ self doCompileVersionMethodsFor: each in: klasses asArray.
+ ]
+ ].
"Created: / 09-10-2013 / 11:57:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-02-2014 / 22:55:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-doCompileVersionMethodsIn: klasses
+doCompileVersionMethodsFor: package in: klasses
| versionMethodName|
- versionMethodName := self package manager nameOfVersionMethodInClasses.
+ versionMethodName := package manager nameOfVersionMethodInClasses.
ActivityNotification notify:'Compiling #version methods...'.
- klasses
- withIndexDo:[:cls :index |
- |metaCls|
+ klasses
+ withIndexDo:[:cls :index |
+ |metaCls|
- metaCls := cls theMetaclass.
- ((metaCls includesSelector:versionMethodName) not
- "JV@2012-11-14: libsvn did this check, however, it is not valid for
- SCMs that does not expand keywords. I disable it, but kept as comment
- as I do not remember why it was good for..."
- "or:[ ((cls perform:versionMethodName asSymbol) startsWith:'$Id') not ]")
- ifTrue:[
- metaCls compile:(metaCls
- versionMethodTemplateForSourceCodeManager:self package manager)
- classified:'documentation'.
- (metaCls compiledMethodAt:versionMethodName)
- setPackage:self package name asSymbol
- ].
- self package manager utilities ensureCorrectVersionMethodsInClass: cls usingManager: self package manager.
- ^ ProgressNotification newException
- messageText: ('Compiling %1 (%2)' bindWith:versionMethodName
- with:cls nameWithoutPrefix);
- parameter: (100 / klasses size) * index;
- raiseRequest
- ].
+ metaCls := cls theMetaclass.
+ ((metaCls includesSelector:versionMethodName) not
+ "JV@2012-11-14: libsvn did this check, however, it is not valid for
+ SCMs that does not expand keywords. I disable it, but kept as comment
+ as I do not remember why it was good for..."
+ "or:[ ((cls perform:versionMethodName asSymbol) startsWith:'$Id') not ]")
+ ifTrue:[
+ metaCls compile:(metaCls
+ versionMethodTemplateForSourceCodeManager:package manager)
+ classified:'documentation'.
+ (metaCls compiledMethodAt:versionMethodName)
+ setPackage:package name asSymbol
+ ].
+ package manager utilities ensureCorrectVersionMethodsInClass: cls usingManager: package manager.
+ ^ ProgressNotification newException
+ messageText: ('Compiling %1 (%2)' bindWith:versionMethodName
+ with:cls nameWithoutPrefix);
+ parameter: (100 / klasses size) * index;
+ raiseRequest
+ ].
- self extensionMethodsToFileOut notEmpty ifTrue:[
- | def |
+ (self extensionMethodsToFileOutFor: package) notEmpty ifTrue:[
+ | def |
- "TODO: Not programming language aware..."
- ((def := self packageDefinition) class includesSelector: self package manager nameOfVersionMethodForExtensions) ifFalse:[
- def class
- compile:
- (self package manager versionMethodTemplateForSmalltalkFor:self package manager nameOfVersionMethodForExtensions)
- classified: #documentation.
- (def class compiledMethodAt:self package manager nameOfVersionMethodForExtensions)
- setPackage:self package name asSymbol
+ "TODO: Not programming language aware..."
+ ((def := package definition) class includesSelector: package manager nameOfVersionMethodForExtensions) ifFalse:[
+ def class
+ compile:
+ (package manager versionMethodTemplateForSmalltalkFor:package manager nameOfVersionMethodForExtensions)
+ classified: #documentation.
+ (def class compiledMethodAt:package manager nameOfVersionMethodForExtensions)
+ setPackage:package name asSymbol
- ]
+ ]
]
- "Created: / 09-10-2013 / 11:57:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-02-2014 / 23:01:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+
+
doFileOut
"Fileouts everything to the working copy"
self
- doUpdateBuildSupportFiles;
- doRenameContainers;
- doFileOutPackageClasses;
- doFileOutPackageExtensions;
- doAddNewContainers;
- doRemoveOldContainers.
+ doUpdateBuildSupportFiles;
+ doRenameContainers;
+ doFileOutPackageClasses;
+ doFileOutPackageExtensions;
+ doAddNewContainers;
+ doRemoveOldContainers.
"Created: / 10-05-2012 / 17:05:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 21-11-2012 / 00:43:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -233,96 +266,118 @@
doFileOutAll
self
- doUpdateCode;
- doFileOut.
+ doUpdateCode;
+ doFileOut.
"Created: / 17-08-2009 / 18:28:18 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 10-05-2012 / 17:06:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doFileOutPackageClasses
+ packages do:[:each | each isVirtual ifFalse: [ self doFileOutPackageClassesFor: each ] ].
+
+ "Created: / 11-04-2008 / 10:58:16 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 19-08-2009 / 13:44:00 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 27-02-2014 / 22:55:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+doFileOutPackageClassesFor: package
|klasses|
suppressClasses == true ifTrue:[^self].
ActivityNotification notify:'Filing out package classes'.
- klasses := self classesToFileOut asArray.
- klasses
- withIndexDo:[:cls :index |
- |clsStream|
- ProgressNotification newException
- messageText: 'Filing out ' , cls nameWithoutPrefix;
- parameter: (100 / klasses size) * index;
- raiseRequest.
+ klasses := (self classesToFileOutFor: package) asArray.
+ klasses
+ withIndexDo:[:cls :index |
+ |clsStream|
+ ProgressNotification newException
+ messageText: 'Filing out ' , cls nameWithoutPrefix;
+ parameter: (100 / klasses size) * index;
+ raiseRequest.
- (self shouldFileOutClass:cls) ifTrue:[self package fileOutClass: cls]
- ].
+ (self shouldFileOutClass:cls) ifTrue:[package fileOutClass: cls]
+ ].
- "Created: / 11-04-2008 / 10:58:16 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 19-08-2009 / 13:44:00 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 30-06-2013 / 00:16:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-02-2014 / 23:09:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doFileOutPackageExtensions
-
- suppressExtensions == true ifTrue:[^self].
-
- self extensionMethodsToFileOut isEmpty ifTrue:[^self].
- self package fileOutExtensions: self extensionMethodsToFileOut
+ packages do:[:each | each isVirtual ifFalse: [ self doFileOutPackageExtensionsFor: each ] ]
"Modified: / 07-04-2008 / 08:37:25 / janfrog"
"Created: / 11-04-2008 / 10:58:36 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 14-05-2009 / 13:37:40 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 07-10-2012 / 10:56:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-02-2014 / 22:55:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+doFileOutPackageExtensionsFor: package
+ | extensions |
+
+ suppressExtensions == true ifTrue:[^self].
+
+ extensions := self extensionMethodsToFileOutFor: package.
+ extensions notEmpty ifTrue:[
+ package fileOutExtensions: extensions.
+ ]
+
+ "Created: / 21-02-2014 / 23:10:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-02-2014 / 23:04:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doInitStateVariables
- packageClassesChanged := self package classesHasChanged.
- packageExtensionsChanged := self package extensionsHasChanged.
+ packageClassesChanged := packages contains:[:each| each isVirtual ifFalse: [ each classesHasChanged ] ] .
+ packageExtensionsChanged := packages contains:[:each| each isVirtual ifFalse: [ each extensionsHasChanged ] ].
"Created: / 17-06-2009 / 10:17:04 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 13-08-2009 / 10:18:37 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 06-10-2012 / 23:28:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 28-02-2014 / 09:52:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doRemoveOldContainers
+ packages do:[:each | each isVirtual ifFalse: [ self doRemoveOldContainersFor: each ] ]
+
+ "Created: / 11-04-2008 / 11:00:27 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 19-08-2009 / 15:03:51 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 27-02-2014 / 22:55:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+doRemoveOldContainersFor: package
| wcroot containers containersToKeep containersToDelete |
self isSelectiveFileoutTask ifTrue:[
- ^ self
+ ^ self
].
ActivityNotification notify:'Removing old containers'.
wcroot := package temporaryWorkingCopyRoot.
- containers := self package containers.
+ containers := package containers.
- containersToKeep := self package containersToKeep.
+ containersToKeep := package containersToKeep.
containersToDelete := containers \ containersToKeep.
"/ Fix for issue #26: Java extension files are removed.
"/ Filter out all Java extension containers which are for classes which
"/ are currently not loaded.
containersToDelete := containersToDelete reject:[:each |
- (each startsWith: 'java/extensions/')
- and:[
- | nm |
+ (each startsWith: 'java/extensions/')
+ and:[
+ | nm |
- nm := each copyFrom:17 to: (each lastIndexOf: $.) - 1.
- (JavaVM registry classes contains: [:cls | cls binaryName = nm]) not.
- ].
+ nm := each copyFrom:17 to: (each lastIndexOf: $.) - 1.
+ (JavaVM registry classes contains: [:cls | cls binaryName = nm]) not.
+ ].
].
containersToDelete do:[:nm|
- | entry |
+ | entry |
- entry := wcroot / nm.
- entry remove
+ entry := wcroot / nm.
+ entry remove
]
- "Created: / 11-04-2008 / 11:00:27 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 19-08-2009 / 15:03:51 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 29-11-2013 / 17:56:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-02-2014 / 23:12:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-doRenameContainerForClassNamed: new using: renames language: lang
+doRenameContainerForClassNamed: new for: package using: renames language: lang
| wcroot assoc old circular oldC oldE newC newE |
assoc := renames detectLast:[:each | each key == new ] ifNone:[ ^ self ].
@@ -333,15 +388,15 @@
"/ its a circular rename...
circular := (renames contains:[:each | each value == new ]).
circular ifTrue:[ ^ self ].
- self doRenameContainerForClassNamed: old using: renames language: lang.
+ self doRenameContainerForClassNamed: old for: package using: renames language: lang.
wcroot := package temporaryWorkingCopyRoot.
- oldC := self package containerNameForClassNamed: old language: lang .
- newC := self package containerNameForClassNamed: new language: lang .
+ oldC := package containerNameForClassNamed: old language: lang .
+ newC := package containerNameForClassNamed: new language: lang .
(oldE := wcroot / oldC) exists ifTrue:[
- packageClassesChanged := true.
- newE := wcroot / newC.
- oldE moveTo: newE.
+ packageClassesChanged := true.
+ newE := wcroot / newC.
+ oldE moveTo: newE.
].
"Created: / 11-04-2008 / 11:00:27 / Jan Vrany <vranyj1@fel.cvut.cz>"
@@ -356,235 +411,247 @@
renames := OrderedCollection new.
names := OrderedCollection new.
ChangeSet current do:
- [:chg|
- chg isClassRenameChange ifTrue:[
- renames add: chg className -> chg oldName.
- names add: chg fullClassName.
- ]].
- self classesToFileOut do:[:cls|
- (names includes: cls name) ifTrue:[
- self doRenameContainerForClassNamed: cls name using: renames language: cls programmingLanguage.
- ].
- ]
+ [:chg|
+ chg isClassRenameChange ifTrue:[
+ renames add: chg className -> chg oldName.
+ names add: chg fullClassName.
+ ]].
+ packages do:[:each |
+ each isVirtual ifFalse: [
+ (self classesToFileOutFor: each) do:[:cls|
+ (names includes: cls name) ifTrue:[
+ self doRenameContainerForClassNamed: cls name for: each using: renames language: cls programmingLanguage.
+ ]
+ ]
+ ]
+ ].
"Created: / 11-04-2008 / 11:00:27 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 19-08-2009 / 15:03:51 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 06-08-2011 / 21:13:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 04-03-2014 / 23:43:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-02-2014 / 22:55:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doUpdateBuildSupportFiles
+ packages do:[:each | each isVirtual ifFalse: [ self doUpdateBuildSupportFilesFor: each ] ]
+
+ "Created: / 20-06-2009 / 16:01:16 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 21-06-2009 / 15:18:17 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 27-02-2014 / 22:56:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+doUpdateBuildSupportFilesFor: package
|pkgDef|
suppresBuildSupportFiles == true ifTrue:[
- ^self.
+ ^self.
].
- pkgDef := self package definition.
+ pkgDef := package definition.
(self isSelectiveFileoutTask and:[packageClassesChanged not and:[(classes includes: pkgDef) not]]) ifTrue:[
- ^self.
+ ^self.
].
ActivityNotification notify:'Updating build files'.
"First, generate files into a temporary files - so originals
are not destroyed when something goes wrong."
- self filesToGenerate do:[:supportFileName |
- | supportFile |
+ (self filesToGenerateFor: package) do:[:supportFileName |
+ | supportFile |
- supportFile := self temporaryWorkingCopyRoot / (supportFileName , '.tmp').
- (packageClassesChanged or:[ supportFile exists not ]) ifTrue:[
- ActivityNotification notify:'Updating ' , supportFileName.
- supportFile directory exists ifFalse: [supportFile directory makeDirectory].
- supportFile writingFileDo:[:s|
- s nextPutAll:(self for: pkgDef generateFile:supportFileName)
- ]
- ]
+ supportFile := package temporaryWorkingCopyRoot / (supportFileName , '.tmp').
+ (packageClassesChanged or:[ supportFile exists not ]) ifTrue:[
+ ActivityNotification notify:'Updating ' , supportFileName.
+ supportFile directory exists ifFalse: [supportFile directory makeDirectory].
+ supportFile writingFileDo:[:s|
+ s nextPutAll:(self for: package generateFile:supportFileName)
+ ]
+ ]
].
"Now, copy them over the old files"
- self filesToGenerate do:[:supportFileName |
- | supportFile supportFileTmp |
+ (self filesToGenerateFor: package) do:[:supportFileName |
+ | supportFile supportFileTmp |
- supportFile := package temporaryWorkingCopyRoot / supportFileName.
- supportFileTmp := package temporaryWorkingCopyRoot / (supportFileName , '.tmp').
+ supportFile := package temporaryWorkingCopyRoot / supportFileName.
+ supportFileTmp := package temporaryWorkingCopyRoot / (supportFileName , '.tmp').
- supportFileTmp moveTo: supportFile.
- supportFile track.
+ supportFileTmp moveTo: supportFile.
+ supportFile track.
].
- "Created: / 20-06-2009 / 16:01:16 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 21-06-2009 / 15:18:17 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 12-01-2013 / 13:54:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-02-2014 / 23:16:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-02-2014 / 22:47:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doUpdateCode
"Updates project definitions and compiles version/copyright methods"
self
- doInitStateVariables;
- doCompileVersionMethods;
- doCompileCopyrightMethods;
- doUpdateProjectDefinition.
+ doInitStateVariables;
+ doCompileVersionMethods;
+ doCompileCopyrightMethods;
+ doUpdateProjectDefinition.
"Created: / 10-05-2012 / 17:04:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doUpdateProjectDefinition
+ packages do:[:each | each isVirtual ifFalse: [ self doUpdateProjectDefinitionFor: each ] ]
+
+ "Created: / 11-04-2008 / 11:01:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 13-08-2009 / 09:13:14 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 27-02-2014 / 22:56:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+doUpdateProjectDefinitionFor: package
| prjClass classesSpec classNamesAndAttributesMap |
(packageClassesChanged | packageExtensionsChanged) ifFalse:[
- ^ self
+ ^ self
].
ActivityNotification notify:'Updating project definition'.
- prjClass := ProjectDefinition definitionClassForPackage:self package name createIfAbsent:true.
+ prjClass := ProjectDefinition definitionClassForPackage: package name createIfAbsent:true.
"/Update classlist beforehand - to care about order and removals...
classNamesAndAttributesMap := Dictionary new.
prjClass classNamesAndAttributes do:[:nameOrPair |
- nameOrPair isArray
- ifTrue:[classNamesAndAttributesMap at: nameOrPair first put: nameOrPair]
- ifFalse:[classNamesAndAttributesMap at: nameOrPair put: (Array with: nameOrPair)]
+ nameOrPair isArray
+ ifTrue:[classNamesAndAttributesMap at: nameOrPair first put: nameOrPair]
+ ifFalse:[classNamesAndAttributesMap at: nameOrPair put: (Array with: nameOrPair)]
].
classesSpec := prjClass searchForClasses collect:[:cls|
- classNamesAndAttributesMap at: cls name ifAbsent:[Array with: cls name]
+ classNamesAndAttributesMap at: cls name ifAbsent:[Array with: cls name]
].
prjClass classNamesAndAttributes:classesSpec usingCompiler:nil.
"/Now do standard update
Class packageQuerySignal answer:prjClass package do:[
- prjClass theNonMetaclass
- forEachContentsMethodsCodeToCompileDo:[:code :category |
- (code startsWith: 'excludedFromPreRequisites')
- ifFalse:[prjClass theMetaclass compile:code classified:category]
- ]
- "/ignoreOldEntries: false
- ignoreOldDefinition: false
+ prjClass theNonMetaclass
+ forEachContentsMethodsCodeToCompileDo:[:code :category |
+ (code startsWith: 'excludedFromPreRequisites')
+ ifFalse:[prjClass theMetaclass compile:code classified:category]
+ ]
+ "/ignoreOldEntries: false
+ ignoreOldDefinition: false
]
- "Created: / 11-04-2008 / 11:01:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 13-08-2009 / 09:13:14 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 19-03-2013 / 10:35:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-02-2014 / 23:17:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractFileoutLikeTask methodsFor:'private'!
classesToFileOut
+ self shouldNotImplement.
suppressClasses == true ifTrue:[^#()].
^ self package classesFiltered:
- [:class |
- class isLoaded and: [ classes isNil or: [ classes includes: class ] ] ]
+ [:class |
+ class isLoaded and: [ classes isNil or: [ classes includes: class ] ] ]
"Created: / 23-03-2009 / 12:08:24 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 11-06-2009 / 18:17:38 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 06-10-2012 / 23:28:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-02-2014 / 22:51:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+classesToFileOutFor: package
+
+ suppressClasses == true ifTrue:[^#()].
+
+ ^ package classesFiltered:
+ [:class |
+ class isLoaded and: [ classes isNil or: [ classes includes: class ] ] ]
+
+ "Created: / 21-02-2014 / 22:59:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-02-2014 / 22:19:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
containersToFileOut
+ self shouldNotImplement
+
+ "Created: / 14-05-2009 / 11:35:05 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 22-02-2014 / 22:50:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+containersToFileOutFor: package
| containers extensions |
- containers := self classesToFileOut
- collect: [:class | package containerNameForClass: class ].
- (extensions := self extensionMethodsToFileOut) notEmpty ifTrue:[
- | languages extensionsNonJava extensionsJava |
+ containers := (self classesToFileOutFor: package)
+ collect: [:class | package containerNameForClass: class ].
+ (extensions := (self extensionMethodsToFileOutFor: package)) notEmpty ifTrue:[
+ | languages extensionsNonJava extensionsJava |
- extensionsNonJava := extensions reject:[:m | m mclass programmingLanguage isJava].
- extensionsJava := extensions select:[:m | m mclass programmingLanguage isJava].
- languages := (extensionsNonJava collect:[:each|each programmingLanguage]) asSet.
- languages do: [:lang| containers add: (package containerNameForExtensions: lang)].
- extensionsJava do:[:m |
- | container |
+ extensionsNonJava := extensions reject:[:m | m mclass programmingLanguage isJava].
+ extensionsJava := extensions select:[:m | m mclass programmingLanguage isJava].
+ languages := (extensionsNonJava collect:[:each|each programmingLanguage]) asSet.
+ languages do: [:lang| containers add: (package containerNameForExtensions: lang)].
+ extensionsJava do:[:m |
+ | container |
- container := package containerNameForExtensions: m programmingLanguage javaClass: m mclass.
- (containers includes: container) ifFalse:[
- containers add: container
- ].
- ].
+ container := package containerNameForExtensions: m programmingLanguage javaClass: m mclass.
+ (containers includes: container) ifFalse:[
+ containers add: container
+ ].
+ ].
].
^ containers
- "Created: / 14-05-2009 / 11:35:05 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 24-09-2013 / 12:32:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 22-02-2014 / 22:49:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
extensionMethodsToFileOut
+ self error: 'Should no longer be sent'.
^ self package extensionsFiltered:
- [:mth |
- extensionMethods isNil or: [ extensionMethods includes: mth ] ]
+ [:mth |
+ extensionMethods isNil or: [ extensionMethods includes: mth ] ]
"Created: / 14-05-2009 / 11:32:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 06-10-2012 / 23:28:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-02-2014 / 22:19:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-for: def generateFile: file
+extensionMethodsToFileOutFor: package
+ ^package extensionsFiltered:
+ [:mth |
+ extensionMethods isNil or: [ extensionMethods includes: mth ] ]
- | contents savedClassFilenames |
+ "Created: / 21-02-2014 / 23:03:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-02-2014 / 22:20:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
-
+for: package generateFile: file
+ | def contents savedClassFilenames |
+
+ def := package definition.
file ~= 'abbrev.stc' ifTrue:[^def generateFile: file].
"Yet another kludge to trick Smalltalk>>fileNameForClass:, sigh"
-
savedClassFilenames := Dictionary new.
(def searchForClasses reject:[:e|e owningClass notNil]) do:
- [:cls|
- savedClassFilenames
- at: cls
- put: cls getClassFilename.
- cls setClassFilename: (self package containerNameForClass: cls)].
+ [:cls|
+ savedClassFilenames
+ at: cls
+ put: cls getClassFilename.
+ cls setClassFilename: (package containerNameForClass: cls)].
contents := def generateFile: file.
savedClassFilenames keysAndValuesDo:
- [:cls :classFileName|
- cls setClassFilename: classFileName].
+ [:cls :classFileName|
+ cls setClassFilename: classFileName].
^contents
- "Modified: / 19-11-2012 / 23:01:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-02-2014 / 22:47:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
shouldFileOutClass: class
-
- "Do not fileout autoloaded classes,
- they are untouched"
- class isLoaded ifFalse:[^false].
-
- class theNonMetaclass
- methodsDo:[:mth|(self shouldFileOutMethod: mth) ifTrue:[^true]].
-
- class theMetaclass
- methodsDo:[:mth|(self shouldFileOutMethod: mth) ifTrue:[^true]].
-
- class privateClasses
- do:[:cls|(self shouldFileOutClass: cls) ifTrue:[^true]].
-
- (ChangeSet current includesChangeForClass:class) ifTrue:[ ^ true ].
-
- ^false
-
- "
- CommitTask basicNew
- package: #'stx:libsvn';
- shouldFileOutClass: CommitTask
-
- CommitTask basicNew
- package: #'stx:libbasic';
- shouldFileOutClass: Object
- "
+ ^ packages anySatisfy:
+ [:p | p name = class package and:[ p hasChangesInClass: class ] ]
"Created: / 24-06-2009 / 19:04:48 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 19-08-2009 / 13:54:39 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 21-01-2013 / 19:35:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 03-03-2014 / 09:18:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-shouldFileOutMethod: mth
-
- ^mth package = package name and:
- [mth getSourcePosition isNil]
-
- "Created: / 24-06-2009 / 19:07:27 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified (comment): / 15-11-2012 / 00:36:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
+ !
!SCMAbstractFileoutLikeTask methodsFor:'queries'!
@@ -609,4 +676,3 @@
version_SVN
^ '§Id:: §'
! !
-
--- a/common/SCMAbstractPackageModel.st Wed Mar 05 09:21:52 2014 +0000
+++ b/common/SCMAbstractPackageModel.st Wed Mar 05 09:55:13 2014 +0000
@@ -5,7 +5,7 @@
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
-version 2.1 of the License.
+version 2.1 of the License.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,8 +19,9 @@
"{ Package: 'stx:libscm/common' }"
Object subclass:#SCMAbstractPackageModel
- instanceVariableNames:'name parent children repository repositoryRoot wc wcroot
- classesHasChanged extensionsHasChanged'
+ instanceVariableNames:'name parent children repository repositoryRoot wc wcroot changed
+ classesHasChanged extensionsHasChanged virtual lastSequenceNumber
+ lastSequenceNumberForChildren'
classVariableNames:''
poolDictionaries:''
category:'SCM-Common-StX'
@@ -36,7 +37,7 @@
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
-version 2.1 of the License.
+version 2.1 of the License.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -55,6 +56,8 @@
map living classes to their respective file containers and can
fileout individual classes.
+ == Hierarchy ==
+
Package models forms a hiearchy that copies package hiearchy. The root
has no parent and represent a package which is located in the root
of the repository. Examples:
@@ -63,7 +66,26 @@
stx:libscm/common ---> parent = stx:libscm, repository = /home/.../build/stx/libscm, repositoryPath = 'common'
stx:libscm/mercurial ---> parent = stx:libscm, repository = /home/.../build/stx/libscm, repositoryPath = 'mercurial'
- In this case, the HGRepository object is shared by all three package models.
+ In this case, the (HG)Repository object is shared by all three package models. See
+ #chilren, #parent and #root.
+
+ == Virtual packages ==
+
+ Package is 'virtual' if there's actually no code in the package. Virtual packages
+ are therefore just containers for nested packages. For example, package 'stx' would
+ be a 'virtual' package, since there's no code packages in 'stx' - all is in one of
+ its nested sub-packages - stx:libbasic, stx:libscm.
+
+ See #isVirtual.
+
+ == Changed packages ==
+
+ A 'changed' package is a package that contain changes, i.e., some method/class
+ beloging to a package has been modified or class/method has been added/removed.
+ Compared to state of the package at its LOAD TIME, not to last nor compiled
+ revision !!!!!!
+
+ See #hasChanges, #classesHasChanged, #extensionsHasChanged.
[author:]
Jan Vrany <jan.vrany@fit.cvut.cz>
@@ -79,7 +101,7 @@
!SCMAbstractPackageModel class methodsFor:'instance creation'!
-named: package
+named: package
self subclassResponsibility
"Created: / 16-11-2012 / 19:52:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -91,6 +113,15 @@
^ self basicNew initialize.
! !
+!SCMAbstractPackageModel class methodsFor:'testing'!
+
+isAbstract
+ ^ self == SCMAbstractPackageModel
+
+ "Created: / 13-11-2012 / 23:07:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 25-02-2014 / 22:38:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!SCMAbstractPackageModel methodsFor:'accessing'!
classes
@@ -120,7 +151,7 @@
!
commitTask
- ^self commitTaskClass new
+ ^self commitTaskClass new
package: self;
yourself
@@ -178,14 +209,6 @@
^ name
!
-parent
- "Returns the parent model. See class documentation for details on parents"
-
- ^parent
-
- "Created: / 01-12-2012 / 17:56:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
repositoryRoot
"Returns relative path within the repository root where the package
content is located. Example: let's assume:
@@ -195,9 +218,9 @@
<repo>/mercurial/tests/...
<repo>/common/..
- then
+ then
- (HGPackageModelRegistry packageNamed: 'stx:libscm/mercurial/tests') path
+ (HGPackageModelRegistry packageNamed: 'stx:libscm/mercurial/tests') path
== 'mercurial/tests'
"
@@ -208,6 +231,31 @@
"Created: / 01-12-2012 / 02:03:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+revision
+ "Return a logical revision of the package, i.e., a revision
+ on which the next commit will be based on"
+
+ self isVirtual ifTrue:[
+ | childRevs |
+
+ childRevs := Set new.
+ self childrenDo:[:each | childRevs add: each revision ].
+ childRevs size == 0 ifTrue:[
+ self error: 'No non-virtual children'.
+ ^ nil.
+ ].
+ childRevs size ~~ 1 ifTrue:[
+ self error: 'Inconsistent revisions of chilren of virtual package'.
+ ^ nil
+ ].
+ ^ childRevs anElement
+ ] ifFalse:[
+ ^ self getRevision
+ ].
+
+ "Modified: / 28-02-2014 / 09:38:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
temporaryWorkingCopy
self ensureTemporaryWorkingCopy.
^wc
@@ -232,41 +280,6 @@
"Created: / 14-11-2012 / 23:51:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!SCMAbstractPackageModel methodsFor:'accessing - containers'!
-
-containerSuffixes
-
- ^ProgrammingLanguage all collect:[:each|each sourceFileSuffix]
-
- "Created: / 23-03-2009 / 18:53:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 30-12-2009 / 18:15:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-containers
-
- | containers jextensions |
-
- containers := OrderedCollection new.
- containers addAll:
- (wcroot directoryContents select:
- [:container|self containerSuffixes anySatisfy:
- [:suffix|container endsWith:suffix]]) asSet.
- (jextensions:= wcroot / 'java' / 'extensions') exists ifTrue:[
- jextensions recursiveDirectoryContentsDo:[:each|
- (self containerSuffixes anySatisfy:[:suffix|each endsWith:suffix]) ifTrue:[
- (jextensions / each) isRegularFile ifTrue:[
- containers add: 'java/extensions/' , each.
- ].
- ].
- ]
- ].
- ^ containers
-
- "Created: / 23-03-2009 / 18:52:27 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 12-06-2009 / 21:44:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 24-09-2013 / 12:39:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
!SCMAbstractPackageModel methodsFor:'accessing-classes'!
commitDialogClass
@@ -292,7 +305,7 @@
!
containerNameForClass:cls
- ^self
+ ^self
containerNameForClassNamed: cls theNonMetaclass fullName
language: cls programmingLanguage
@@ -327,12 +340,12 @@
class := aJavaClass theNonMetaClass.
"Sigh, make it compatible with old and new naming of Java classes
-
+
old -> aJavaClass name == #'java/lang/Object'
new -> aJavaClass name == JAVA::java::lang::Object
aJavaClass binaryName == #'java/lang/Object'
"
- classBinaryName := (class respondsTo: #binaryName)
+ classBinaryName := (class respondsTo: #binaryName)
ifTrue:[ class binaryName ]
ifFalse:[ class name ].
self assert: (classBinaryName includes: $:) not.
@@ -348,6 +361,14 @@
"Modified: / 09-10-2013 / 08:56:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+containerSuffixes
+
+ ^ProgrammingLanguage all collect:[:each|each sourceFileSuffix]
+
+ "Created: / 23-03-2009 / 18:53:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-12-2009 / 18:15:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
containerWriteStreamFor: containerName
| filename directory |
@@ -363,7 +384,7 @@
"Modified: / 04-09-2012 / 23:44:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-containerWriteStreamForClass:cls
+containerWriteStreamForClass:cls
^self containerWriteStreamFor: (self containerNameForClass:cls)
"Created: / 07-10-2012 / 10:27:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -389,6 +410,31 @@
"Modified: / 24-09-2013 / 12:07:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+containers
+
+ | containers jextensions |
+
+ containers := OrderedCollection new.
+ containers addAll:
+ (wcroot directoryContents select:
+ [:container|self containerSuffixes anySatisfy:
+ [:suffix|container endsWith:suffix]]) asSet.
+ (jextensions:= wcroot / 'java' / 'extensions') exists ifTrue:[
+ jextensions recursiveDirectoryContentsDo:[:each|
+ (self containerSuffixes anySatisfy:[:suffix|each endsWith:suffix]) ifTrue:[
+ (jextensions / each) isRegularFile ifTrue:[
+ containers add: 'java/extensions/' , each.
+ ].
+ ].
+ ]
+ ].
+ ^ containers
+
+ "Created: / 23-03-2009 / 18:52:27 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 12-06-2009 / 21:44:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 24-09-2013 / 12:39:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
containersToKeep
| containers extensions |
@@ -406,10 +452,10 @@
container := self containerNameForExtensions: m programmingLanguage javaClass: m mclass.
(containers includes: container) ifFalse:[
- containers add: container
+ containers add: container
].
].
- ].
+ ].
"Keep all directories"
wcroot directoryContents do: [:f|
@@ -434,6 +480,78 @@
"Modified: / 24-09-2013 / 12:32:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!SCMAbstractPackageModel methodsFor:'accessing-hierarchy'!
+
+children
+ "Returns all my immediate children."
+
+ self updateCachedValues.
+ ^ children values.
+
+ "
+ (HGPackageModelRegistry packageNamed: 'stx:libscm') children
+ "
+
+ "Created: / 19-02-2014 / 23:43:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 28-02-2014 / 23:54:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+childrenDo: aBlock
+ "Evaluate a block for all immediate children of the receiver.
+ Does NOT recurse."
+
+ self children do: aBlock
+
+ "Created: / 19-02-2014 / 23:47:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parent
+ "Returns the parent model. See class documentation for details on parents"
+
+ ^parent
+
+ "Created: / 01-12-2012 / 17:56:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+root
+ "Returns the root of this package model hierarchy, i.e., grand-parent which itself has no parent.
+ See class documentation for details on parents"
+
+ | p |
+
+ p := self.
+ [ p parent notNil ] whileTrue:[
+ p := p parent.
+ ].
+ ^ p
+
+ "Created: / 19-02-2014 / 23:30:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+siblings
+ "Returns all my siblings"
+
+ parent notNil
+ ifTrue:[ ^ self parent children copy remove: self; yourself]
+ ifFalse:[ ^ #() ]
+
+ "
+ (HGPackageModelRegistry packageNamed: 'stx:libscm') siblings
+ (HGPackageModelRegistry packageNamed: 'stx:libscm/common') siblings
+ "
+
+ "Created: / 20-02-2014 / 00:22:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+yourselfAndAllChildrenDo: aBlock
+ "Evaluate a block for receiver and all its children, recursively."
+
+ aBlock value: self.
+ self children do:[:each | each yourselfAndAllChildrenDo: aBlock ]
+
+ "Created: / 19-02-2014 / 23:49:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!SCMAbstractPackageModel methodsFor:'accessing-private'!
childNamed: aString
@@ -444,7 +562,7 @@
children at: aString ifPresent:[:child|^child].
child := self class new.
- nm := (name includes: $:)
+ nm := (name includes: $:)
ifTrue: [name , '/' , aString]
ifFalse:[name , ':' , aString].
child setName: nm repository: repository.
@@ -454,6 +572,15 @@
"Created: / 01-12-2012 / 01:29:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-12-2012 / 18:11:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+getRevision
+ "Return a logical revision of the package, i.e., a revision
+ on which the next commit will be based on"
+
+ ^ self subclassResponsibility
+
+ "Created: / 28-02-2014 / 09:33:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageModel methodsFor:'file out'!
@@ -465,7 +592,7 @@
stream := self containerWriteStreamForClass:cls.
[
self fileOutClass:cls on:stream
- ] ensure:[
+ ] ensure:[
stream close
]
@@ -483,10 +610,10 @@
"/ [:each|each makeLocalStringSource].
self manager
- fileOutSourceCodeOf:cls
- on:clsStream
- withTimeStamp:false
- withInitialize:true
+ fileOutSourceCodeOf:cls
+ on:clsStream
+ withTimeStamp:false
+ withInitialize:true
withDefinition:true
methodFilter:[:mth | mth package = name ]
@@ -515,7 +642,7 @@
fileOutExtensions: extensionMethods in: directory
- ProgrammingLanguage all do:[:lang|
+ ProgrammingLanguage all do:[:lang|
| stream methods |
methods := extensionMethods select:[:mth|mth programmingLanguage = lang].
@@ -564,7 +691,7 @@
"Modified: / 15-12-2012 / 17:50:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-fileOutExtensions: extensionMethods on:stream language: language
+fileOutExtensions: extensionMethods on:stream language: language
extensionMethods do:[:each|each makeLocalStringSource].
@@ -658,7 +785,7 @@
"Modified: / 21-06-2013 / 23:45:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-setWorkingCopy: aSCMAbstractWorkingCopy
+setWorkingCopy: aSCMAbstractWorkingCopy
wc := aSCMAbstractWorkingCopy.
wcroot := wc root / self repositoryRoot
@@ -676,29 +803,25 @@
"Created: / 13-08-2009 / 10:23:19 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 15-11-2012 / 10:05:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 23-11-2012 / 22:50:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
-!SCMAbstractPackageModel methodsFor:'queries'!
-
-classesHasChanged
- classesHasChanged :=
- (classesHasChanged == true) or:[self computeClassesHasChanged].
-
- ^ classesHasChanged
-
- "Created: / 06-10-2012 / 23:16:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-extensionsHasChanged
- extensionsHasChanged :=
- (extensionsHasChanged == true) or:[self computeExtensionsHasChanged].
+computeChildren
+ | childNames nameSizePlus1 |
- ^ extensionsHasChanged
+ nameSizePlus1 := name size + 1.
+ childNames := Smalltalk allLoadedProjectIDs select:[:each |
+ (each startsWith: name)
+ and:[ each ~= name
+ and:[ ((each at: nameSizePlus1) == $/ or:[ (each at: nameSizePlus1) == $: ])
+ and:[ (each indexOf: $/ startingAt: nameSizePlus1 + 1) == 0]]]].
+ childNames do:[:each | self childNamed: (each copyFrom: nameSizePlus1 + 1) ].
- "Created: / 06-10-2012 / 23:16:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
+ "
+ (HGPackageModelRegistry packageNamed: 'stx:libscm') children
+ "
-!SCMAbstractPackageModel methodsFor:'queries-privacy'!
+ "Created: / 28-02-2014 / 23:53:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
computeClassesHasChanged
"
@@ -714,7 +837,7 @@
pkgDef autoloaded_classNames.
realClasses := self classes collect:[:cls | cls fullName ].
- listedClasses size ~= realClasses size
+ listedClasses size ~= realClasses size
ifTrue:[^ true].
(realClasses allSatisfy:[:realClass | listedClasses includes:realClass ])
ifFalse:[^true].
@@ -729,7 +852,7 @@
(CommitTask new package: 'cvut:fel/smallruby')
computePackageClassesChanged
(SVN::RepositoryManager workingCopyForPackage: #'stx:libbasic')
- computePackageClassesChanged
+ computePackageClassesChanged
"
"Created: / 06-10-2012 / 23:17:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -740,26 +863,26 @@
"
Answers true iff package extension method differs from
those listed in ProjectDefinition>>extensionMethodNames"
-
+
| listedExtensions listedExtensionsDictionary realExtensions |
realExtensions := self extensions.
- listedExtensions := self definition
+ listedExtensions := self definition
extensionMethodNames.
(listedExtensions size / 2) ~= realExtensions size ifTrue:[
^ true
].
listedExtensionsDictionary := Dictionary new.
- listedExtensions
- pairWiseDo:[:className :selector |
+ listedExtensions
+ pairWiseDo:[:className :selector |
(listedExtensionsDictionary at:className
ifAbsentPut:[ OrderedCollection new ]) add:selector
].
- ^ (realExtensions
- allSatisfy:[:mth |
- (listedExtensionsDictionary includesKey:mth mclass name)
+ ^ (realExtensions
+ allSatisfy:[:mth |
+ (listedExtensionsDictionary includesKey:mth mclass name)
and:[ (listedExtensionsDictionary at:mth mclass name) includes:mth selector ]
- ])
+ ])
not
"
@@ -768,13 +891,182 @@
"Created: / 06-10-2012 / 23:17:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 19-03-2013 / 10:12:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+computeHasChanges
+
+ classesHasChanged == true ifTrue:[
+ ^ true.
+ ].
+
+ extensionsHasChanged == true ifTrue:[
+ ^ true.
+ ].
+
+ self classes do:[:class |
+ (self hasChangesInClass: class) ifTrue:[
+ ^ true.
+ ].
+ ].
+ self extensions do:[:each |
+ (self hasChangesInMethod: each) ifTrue:[
+ ^ true.
+ ]
+ ].
+ ^ false.
+
+ "Created: / 03-03-2014 / 09:08:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+computeIsVirtual
+ "raise an error: this method should be implemented (TODO)"
+
+ ^ self classes isEmpty and:[ self extensions isEmpty ].
+
+ "Created: / 28-02-2014 / 23:46:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+updateCachedValues
+ "Update all cached data"
+
+ | sequenceNumber |
+
+ sequenceNumber := SCMCodeMonitor sequenceNumber.
+ sequenceNumber ~~ lastSequenceNumber ifTrue:[
+ lastSequenceNumber := sequenceNumber.
+ virtual := self computeIsVirtual.
+ virtual ifTrue:[
+ classesHasChanged := false.
+ extensionsHasChanged := false.
+ changed := false.
+ ] ifFalse:[
+ classesHasChanged := (classesHasChanged == true) or:[ self computeClassesHasChanged ].
+ extensionsHasChanged := (extensionsHasChanged == true) or:[ self computeExtensionsHasChanged ].
+ changed := self computeHasChanges.
+ ].
+ self computeChildren.
+ ].
+
+ "Created: / 28-02-2014 / 23:46:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 03-03-2014 / 09:23:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!SCMAbstractPackageModel methodsFor:'utils'!
+!SCMAbstractPackageModel methodsFor:'queries'!
+
+classesHasChanged
+ "Return true, if list of classes has changed, i.e., a class
+ was added, removed or renamed. False otherwise"
+
+ self updateCachedValues.
+ ^ classesHasChanged
+
+ "Created: / 06-10-2012 / 23:16:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 28-02-2014 / 23:51:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 03-03-2014 / 09:06:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+extensionsHasChanged
+ "Return true, if list of extensions has changed, i.e., a method
+ was added, removed or renamed. False otherwise"
+
+ self updateCachedValues.
+ ^ extensionsHasChanged
+
+ "Created: / 06-10-2012 / 23:16:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 28-02-2014 / 23:51:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 03-03-2014 / 09:07:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+hasChanges
+
+ self updateCachedValues.
+ ^ changed
+
+ "Created: / 03-03-2014 / 00:10:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 03-03-2014 / 09:08:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+hasChangesInClass: class
+ "Return true, if there's a change in given class, false otherwise"
+
+ "/ Class which is not loaded could not be changed
+ class isLoaded ifFalse:[^false].
+
+ class withAllPrivateClassesDo:[:each |
+ (ChangeSet current includesChangeForClass:each) ifTrue:[ ^ true ].
+ ].
+ class withAllPrivateClassesDo:[:each |
+ each theNonMetaclass
+ methodsDo:[:mth|(self hasChangesInMethod: mth) ifTrue:[^ true]].
+ each theMetaclass
+ methodsDo:[:mth|(self hasChangesInMethod: mth) ifTrue:[^ true]].
+ ].
+ ^false
+
+ "Created: / 03-03-2014 / 09:10:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+hasChangesInMethod: method
+ "Return true, if the method's code has been edited, false otherwise"
+
+ ^ method package = name
+ "/ This is not strictly true, for byte-code compiled method
+ "/ sourcePosition is also non-nil...
+ and:[ method getSourcePosition isNil ]
+
+ "Created: / 03-03-2014 / 09:13:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SCMAbstractPackageModel methodsFor:'testing'!
+
+isChildOf: anotherPackageModel
+ ^ anotherPackageModel isParentOf: self.
+
+ "Created: / 25-02-2014 / 22:51:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+isParentOf: anotherPackageModel
+ | anotherName |
+
+ anotherName := anotherPackageModel name.
+ ^ (anotherName size) > (name size + 1)
+ and:[ (anotherName startsWith: name)
+ and:[ ':/' includes: (anotherName at: name size + 1) ]].
+
+ "Created: / 25-02-2014 / 22:50:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+isVirtual
+ "Return true, if the package is virtual, i.e., there's no code in
+ the package. False otherwise.
+
+ Virtual packages serves merely as containers for nested packages"
+
+ self updateCachedValues.
+ ^ virtual
+
+ "
+ (HGPackageModel named: 'stx:libscm') isVirtual
+ (HGPackageModel named: 'stx:libscm/mercurial') isVirtual
+ "
+
+ "Created: / 27-02-2014 / 22:46:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 28-02-2014 / 23:50:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SCMAbstractPackageModel methodsFor:'utilities'!
+
+, anotherPackageModel
+ ^ SCMCommonPackageModelGroup
+ with: self
+ with: anotherPackageModel
+
+ "Created: / 26-02-2014 / 22:43:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
ensureTemporaryWorkingCopy
"raise an error: must be redefined in concrete subclass(es)"
-
+
^ self subclassResponsibility
! !
--- a/common/SCMAbstractPackageModelRegistry.st Wed Mar 05 09:21:52 2014 +0000
+++ b/common/SCMAbstractPackageModelRegistry.st Wed Mar 05 09:55:13 2014 +0000
@@ -103,6 +103,15 @@
"Created: / 14-11-2012 / 00:14:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!SCMAbstractPackageModelRegistry class methodsFor:'testing'!
+
+isAbstract
+ ^ self == SCMAbstractPackageModelRegistry
+
+ "Created: / 13-11-2012 / 23:07:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 25-02-2014 / 22:38:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!SCMAbstractPackageModelRegistry methodsFor:'accessing'!
packageNamed:arg
--- a/common/SCMAbstractTask.st Wed Mar 05 09:21:52 2014 +0000
+++ b/common/SCMAbstractTask.st Wed Mar 05 09:55:13 2014 +0000
@@ -19,7 +19,7 @@
"{ Package: 'stx:libscm/common' }"
Object subclass:#SCMAbstractTask
- instanceVariableNames:'package classes temporaryWorkingCopy'
+ instanceVariableNames:'packages classes temporaryWorkingCopy temporaryWorkingCopyRoot'
classVariableNames:''
poolDictionaries:''
category:'SCM-Common-StX-Tasks'
@@ -48,6 +48,14 @@
"
! !
+!SCMAbstractTask class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+! !
+
!SCMAbstractTask methodsFor:'accessing'!
branch
@@ -62,30 +70,48 @@
!
classes:aCollection"<Collection[Class]>"
+ | packageNames |
self
assert: (aCollection allSatisfy: [:e|e isBehavior])
message: 'All elements should be classes'.
+ packageNames := packages collect:[:each | each name ].
self
- assert: (aCollection allSatisfy: [:e|e package = package name])
- message: 'All classes should belongs to my package (' , package name , ')'.
+ assert: (aCollection allSatisfy: [:e| packageNames includes: e package] )
+ message: 'All classes should belongs to one of my packages'.
classes := aCollection.
"Modified: / 16-06-2009 / 20:56:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 14-11-2012 / 00:38:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 21-02-2014 / 22:52:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
package
- ^ package
+ self error: 'Should no longer be sent'.
+ ^ packages
+
+ "Modified: / 21-02-2014 / 22:49:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
package:aSCMAbstractPackageModel
- package := aSCMAbstractPackageModel.
- temporaryWorkingCopy := aSCMAbstractPackageModel temporaryWorkingCopy
+ self packages: (SCMCommonPackageModelGroup with: aSCMAbstractPackageModel)
+
+ "Modified: / 26-02-2014 / 22:47:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+packages
+ ^ packages
- "Modified: / 11-01-2013 / 19:31:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 22-02-2014 / 23:46:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+packages:aSCMCommonPackageModelGroup
+ packages := aSCMCommonPackageModelGroup.
+ temporaryWorkingCopy := aSCMCommonPackageModelGroup temporaryWorkingCopy.
+ temporaryWorkingCopyRoot := aSCMCommonPackageModelGroup temporaryWorkingCopyRoot.
+
+ "Created: / 26-02-2014 / 22:46:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
repository
@@ -100,20 +126,18 @@
!
temporaryWorkingCopy: wc
- temporaryWorkingCopy := wc
+ temporaryWorkingCopy := wc.
+ temporaryWorkingCopyRoot := wc root.
"Created: / 12-01-2013 / 13:57:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-02-2014 / 23:58:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
temporaryWorkingCopyRoot
- ^package notNil ifTrue:[
- package temporaryWorkingCopyRoot
- ] ifFalse:[
- temporaryWorkingCopy root
- ]
+ ^ temporaryWorkingCopyRoot
"Created: / 14-11-2012 / 23:51:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 12-01-2013 / 13:55:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-02-2014 / 23:57:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
workingCopy
@@ -162,52 +186,31 @@
!SCMAbstractTask methodsFor:'executing - private'!
do: aBlock
- ^package notNil ifTrue:[
+ ^packages notNil ifTrue:[
SCMCompatModeQuery
- answer: package name
+ answer: "packages name"nil
do: aBlock
] ifFalse:[
aBlock value.
]
"Created: / 15-07-2009 / 20:07:14 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 01-04-2013 / 12:19:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-doCompileSvnRepositoryUrlStringMethod
- |pkgDef revNr|
+ "Modified: / 22-02-2014 / 22:30:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
- ActivityNotification notify:'Compiling #svnRepositoryUrlString method'.
- pkgDef := self workingCopy packageDefinition.
- (pkgDef theMetaclass includesSelector:#svnRepositoryUrlString) not
- ifTrue:[
- pkgDef theMetaclass compile:(pkgDef svnRepositoryUrlString_code)
- classified:'description - svn'.
- (pkgDef theMetaclass compiledMethodAt:#svnRepositoryUrlString)
- setPackage:self package asSymbol
- ].
+!SCMAbstractTask methodsFor:'initialization'!
- "Created: / 08-04-2011 / 15:58:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
+initialize
+ "Invoked when a new instance is created."
-doCompileSvnRevisionNrMethod:compileRevision
- |pkgDef revNr|
+ "/ please change as required (and remove this comment)
+ packages := #()
+ "/ classes := nil.
+ "/ temporaryWorkingCopy := nil.
- ActivityNotification notify:'Compiling #svnRevisionNr method'.
- pkgDef := self workingCopy packageDefinition.
- revNr := compileRevision ifTrue:[
- pkgDef svnRevision number
- ] ifFalse:[ nil ].
- (revNr notNil
- or:[ (pkgDef theMetaclass includesSelector:#svnRevisionNr) not ])
- ifTrue:[
- pkgDef theMetaclass compile:(pkgDef svnRevisionNr_code:revNr)
- classified:'description - svn'.
- (pkgDef theMetaclass compiledMethodAt:#svnRevisionNr)
- setPackage:self package asSymbol
- ].
+ "/ super initialize. -- commented since inherited method does nothing
- "Created: / 16-06-2009 / 12:16:25 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 21-02-2014 / 22:51:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractTask methodsFor:'notification'!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/common/SCMCodeMonitor.st Wed Mar 05 09:55:13 2014 +0000
@@ -0,0 +1,147 @@
+"
+stx:libscm - a new source code management library for Smalltalk/X
+Copyright (C) 2012-2013 Jan Vrany
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+"
+"{ Package: 'stx:libscm/common' }"
+
+Object subclass:#SCMCodeMonitor
+ instanceVariableNames:'sequenceNumber'
+ classVariableNames:'Current SequenceNumberMax'
+ poolDictionaries:''
+ category:'SCM-Common-StX'
+!
+
+!SCMCodeMonitor class methodsFor:'documentation'!
+
+copyright
+"
+stx:libscm - a new source code management library for Smalltalk/X
+Copyright (C) 2012-2013 Jan Vrany
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+"
+!
+
+documentation
+"
+ SCMCodeMonitor is helper class that monitors code changes
+ in Smalltalk. Upon each change (class or method added/removed/moved
+ to package/...) it increases internal sequenceNumber.
+
+ Client may use that sequence number to check whether some
+ cached data are still valid - they should be considered
+ out-of-date if sequence number from monitor differs from
+ sequence number remembered when cached value has been
+ computed.
+
+ [author:]
+ Jan Vrany <jan.vrany@fit.cvut.cz>
+
+ [instance variables:]
+
+ [class variables:]
+
+ [see also:]
+
+"
+! !
+
+!SCMCodeMonitor class methodsFor:'initialization'!
+
+initialize
+ "Invoked at system start or when the class is dynamically loaded."
+
+ "/ please change as required (and remove this comment)
+
+ SequenceNumberMax := SmallInteger maxVal
+
+ "Modified: / 28-02-2014 / 23:25:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SCMCodeMonitor class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+! !
+
+!SCMCodeMonitor class methodsFor:'accessing'!
+
+sequenceNumber
+ Current isNil ifTrue:[
+ Current := self new.
+ ].
+ ^ Current sequenceNumber
+
+ "Created: / 28-02-2014 / 23:23:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SCMCodeMonitor methodsFor:'accessing'!
+
+sequenceNumber
+ ^ sequenceNumber
+
+ "Created: / 28-02-2014 / 23:29:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SCMCodeMonitor methodsFor:'change & update'!
+
+update:something with:aParameter from:changedObject
+ "Invoked when an object that I depend upon sends a change notification."
+
+ ((something == #methodInClass)
+ or:[ something == #projectOrganization
+ or:[ something == #classRemove
+ or:[ something == #newClass ]]]
+ ) ifTrue:[
+ sequenceNumber := sequenceNumber == SequenceNumberMax ifTrue:[0] ifFalse:[sequenceNumber := sequenceNumber + 1].
+ ^ self
+ ].
+ ^ self
+"/ Transcript showCR: '>> ', something
+
+ "Modified: / 01-03-2014 / 00:13:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SCMCodeMonitor methodsFor:'initialization'!
+
+initialize
+ "Invoked when a new instance is created."
+
+ sequenceNumber := 0.
+ Smalltalk addDependent: self.
+
+ "/ super initialize. -- commented since inherited method does nothing
+
+ "Modified: / 28-02-2014 / 23:25:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+
+SCMCodeMonitor initialize!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/common/SCMCommonPackageModelGroup.st Wed Mar 05 09:55:13 2014 +0000
@@ -0,0 +1,284 @@
+"
+stx:libscm - a new source code management library for Smalltalk/X
+Copyright (C) 2012-2013 Jan Vrany
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+"
+"{ Package: 'stx:libscm/common' }"
+
+Collection subclass:#SCMCommonPackageModelGroup
+ instanceVariableNames:'roots'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'SCM-Common-StX'
+!
+
+!SCMCommonPackageModelGroup class methodsFor:'documentation'!
+
+copyright
+"
+stx:libscm - a new source code management library for Smalltalk/X
+Copyright (C) 2012-2013 Jan Vrany
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+"
+!
+
+documentation
+"
+ Package model group represents a group of packages that are related
+ and should be manipulated at once by 'tasks'. Use #do: to iterate over
+ individual packages.
+
+ All packages in package group are guaranteed to be of same logical
+ revision (see SCMAbstractPackageModel>>revision)
+
+ NOTE: If package model A is part of the package group, all its children
+ are **automatically** part of of the group (but only if it has the same revision
+ as it's parent). Therefore you only need to add roots - in most case there's
+ only one root (the top-most package in the repository).
+ It is illegal to add two roots with different revisions, in that case,
+ and error is thrown.
+
+ [author:]
+ Jan Vrany <jan.vrany@fit.cvut.cz>
+
+ [instance variables:]
+
+ [class variables:]
+
+ [see also:]
+ SCMAbstractPackageModel
+ SCMAbstractTask
+ SCMCommitTask
+
+ HGCommitTask
+ HGPackageModel
+
+
+"
+! !
+
+!SCMCommonPackageModelGroup class methodsFor:'instance creation'!
+
+with: packageModel
+ ^ self new
+ add: packageModel;
+ yourself
+
+ "Created: / 25-02-2014 / 22:57:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+with: packageModel1 with: packageModel2
+ ^ self new
+ add: packageModel1;
+ add: packageModel2;
+ yourself
+
+ "Created: / 25-02-2014 / 22:57:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+with: packageModel1 with: packageModel2 with: packageModel3
+ ^ self new
+ add: packageModel1;
+ add: packageModel2;
+ add: packageModel3;
+ yourself
+
+ "Created: / 25-02-2014 / 22:57:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SCMCommonPackageModelGroup methodsFor:'accessing'!
+
+commitTask
+ self isEmpty ifTrue:[
+ self error: 'Package group is empty'.
+ ].
+ ^ roots anElement commitTaskClass new
+ packages: self;
+ yourself
+
+ "Created: / 26-02-2014 / 22:53:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+repository
+ "Return the repository for packages in this group"
+
+ self do:[:each | ^ each repository ].
+ ^ self emptyCollectionError
+
+ "Created: / 03-03-2014 / 00:19:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+revision
+ "Return the logical revision of packages is this group"
+
+ self do:[:each | ^ each revision ].
+ ^ self emptyCollectionError
+
+ "Created: / 03-03-2014 / 00:21:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+temporaryWorkingCopy
+ self isEmpty ifTrue:[
+ self error:'Package group is empty'.
+ ].
+ ^ roots anElement temporaryWorkingCopy.
+
+ "Modified: / 26-02-2014 / 23:00:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+temporaryWorkingCopyRoot
+ self isEmpty ifTrue:[
+ self error:'Package group is empty'.
+ ].
+ roots anElement ensureTemporaryWorkingCopy.
+ ^ roots size == 1 ifTrue:[
+ roots anElement temporaryWorkingCopyRoot
+ ] ifFalse:[
+ roots anElement temporaryWorkingCopy root
+ ].
+
+ "Created: / 14-11-2012 / 23:51:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 26-02-2014 / 22:52:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SCMCommonPackageModelGroup methodsFor:'adding & removing'!
+
+add: packageModel
+ roots isNil ifTrue:[
+ roots := Array with: packageModel.
+ ] ifFalse:[
+ (packageModel isKindOf: roots anElement class) ifFalse:[
+ self error: 'Package model is for different SCM'.
+ ^ self.
+ ].
+ roots do:[:root |
+ (root isParentOf: packageModel) ifTrue:[ ^ self ]
+ ].
+ roots withIndexDo:[:root :i|
+ (root isChildOf: packageModel) ifTrue:[
+ roots at: i put: packageModel.
+ ^ self.
+ ].
+ ].
+ (packageModel revision = roots first revision) ifFalse:[
+ self error: 'Package model has different revision than models already in group!!'.
+ ^ self.
+ ].
+ roots := roots copyWith: packageModel.
+ ].
+
+ "Created: / 25-02-2014 / 22:53:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 03-03-2014 / 09:05:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+remove: element ifAbsent: block
+ ^ self shouldImplement
+
+ "Created: / 25-02-2014 / 23:12:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SCMCommonPackageModelGroup methodsFor:'enumerating'!
+
+do: block
+ "Evaluate `block` with each package model is a group"
+
+ roots notNil ifTrue:[
+ | rev |
+
+ rev := roots anElement revision.
+ roots do:[:root | root yourselfAndAllChildrenDo: [:p | p revision = rev ifTrue:[ block value: p ] ] ]
+ ].
+
+ "Created: / 25-02-2014 / 22:55:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+reverseDo: block
+ self do: block
+
+ "Created: / 25-02-2014 / 23:11:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SCMCommonPackageModelGroup methodsFor:'enumerating-tests'!
+
+containsAllChangedPackages
+ "Returns true, if receiver contains all changed packages in a repository"
+
+ | revision changed |
+
+ self isEmpty ifTrue:[
+ self emptyCollectionError.
+ ^ false.
+ ].
+
+ "/ Collect all changed packages at given revision...
+ revision := self revision.
+ changed := Set new.
+ roots anElement root yourselfAndAllChildrenDo:[:each|
+ (each isVirtual not and:[each revision = revision and:[ each hasChanges ]]) ifTrue:[
+ changed add: each.
+ ].
+ ].
+
+ "/ Remove each package in receiver. If then
+ "/ `changed` collection is empty, all
+ self do:[:each |
+ changed remove: each ifAbsent:[ ].
+ ].
+ ^ changed isEmpty
+
+ "Created: / 03-03-2014 / 00:23:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SCMCommonPackageModelGroup methodsFor:'queries'!
+
+species
+ "Return the type of collection for select: / collect: / reject: kind
+ of methods"
+ ^ OrderedCollection
+
+ "Created: / 27-02-2014 / 17:07:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SCMCommonPackageModelGroup methodsFor:'utilities'!
+
+, anotherPackageModel
+ ^ self
+ add: anotherPackageModel;
+ yourself.
+
+ "Created: / 26-02-2014 / 22:43:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SCMCommonPackageModelGroup class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/common/abbrev.stc Wed Mar 05 09:21:52 2014 +0000
+++ b/common/abbrev.stc Wed Mar 05 09:55:13 2014 +0000
@@ -5,10 +5,12 @@
SCMAbstractPackageModel SCMAbstractPackageModel stx:libscm/common 'SCM-Common-StX' 0
SCMAbstractPackageModelRegistry SCMAbstractPackageModelRegistry stx:libscm/common 'SCM-Common-StX' 1
SCMAbstractSourceCodeManager SCMAbstractSourceCodeManager stx:libscm/common 'SCM-Common-StX' 2
+SCMAbstractTask SCMAbstractTask stx:libscm/common 'SCM-Common-StX-Tasks' 0
+SCMCodeMonitor SCMCodeMonitor stx:libscm/common 'SCM-Common-StX' 0
+SCMCommonPackageModelGroup SCMCommonPackageModelGroup stx:libscm/common 'SCM-Common-StX' 0
+SCMCommonSourceCodeManagerUtilities SCMCommonSourceCodeManagerUtilities stx:libscm/common 'SCM-Common-StX' 0
+SCMCompatModeQuery SCMCompatModeQuery stx:libscm/common 'SCM-Common-StX' 1
stx_libscm_common stx_libscm_common stx:libscm/common '* Projects & Packages *' 3
-SCMAbstractTask SCMAbstractTask stx:libscm/common 'SCM-Common-StX-Tasks' 0
SCMAbstractCommitDialog SCMAbstractCommitDialog stx:libscm/common 'SCM-Common-StX-Interface' 1
SCMAbstractFileoutLikeTask SCMAbstractFileoutLikeTask stx:libscm/common 'SCM-Common-StX-Tasks' 0
SCMAbstractCommitTask SCMAbstractCommitTask stx:libscm/common 'SCM-Common-StX-Tasks' 0
-SCMCommonSourceCodeManagerUtilities SCMCommonSourceCodeManagerUtilities stx:libscm/common 'SCM-Common-StX' 0
-SCMCompatModeQuery SCMCompatModeQuery stx:libscm/common 'SCM-Common-StX' 1
--- a/common/common.rc Wed Mar 05 09:21:52 2014 +0000
+++ b/common/common.rc Wed Mar 05 09:55:13 2014 +0000
@@ -25,7 +25,7 @@
VALUE "LegalCopyright", "Copyright Jan Vrany 2012\0"
VALUE "ProductName", "Smalltalk/X SCM Support Library\0"
VALUE "ProductVersion", "6.2.3.0\0"
- VALUE "ProductDate", "Wed, 09 Oct 2013 11:09:21 GMT\0"
+ VALUE "ProductDate", "Mon, 03 Mar 2014 10:17:17 GMT\0"
END
END
--- a/common/libInit.cc Wed Mar 05 09:21:52 2014 +0000
+++ b/common/libInit.cc Wed Mar 05 09:55:13 2014 +0000
@@ -32,6 +32,8 @@
_SCMAbstractPackageModelRegistry_Init(pass,__pRT__,snd);
_SCMAbstractSourceCodeManager_Init(pass,__pRT__,snd);
_SCMAbstractTask_Init(pass,__pRT__,snd);
+_SCMCodeMonitor_Init(pass,__pRT__,snd);
+_SCMCommonPackageModelGroup_Init(pass,__pRT__,snd);
_SCMCommonSourceCodeManagerUtilities_Init(pass,__pRT__,snd);
_SCMCompatModeQuery_Init(pass,__pRT__,snd);
_stx_137libscm_137common_Init(pass,__pRT__,snd);
--- a/common/stx_libscm_common.st Wed Mar 05 09:21:52 2014 +0000
+++ b/common/stx_libscm_common.st Wed Mar 05 09:55:13 2014 +0000
@@ -72,6 +72,21 @@
)
!
+mandatoryPreRequisites
+ "list all required mandatory packages.
+ Packages are mandatory, if they contain superclasses of the package's classes
+ or classes which are extended by this package.
+ This list can be maintained manually or (better) generated and
+ updated by scanning the superclass hierarchies
+ (the browser has a menu function for that)"
+
+ ^ #(
+ #'stx:libbasic' "Collection - extended "
+ #'stx:libbasic3' "AbstractSourceCodeManager - superclass of SCMAbstractSourceCodeManager "
+ #'stx:libview2' "ApplicationModel - superclass of SCMAbstractCommitDialog "
+ )
+!
+
preRequisites
"list all required packages.
This list can be maintained manually or (better) generated and
@@ -89,6 +104,33 @@
#'stx:libwidg' "Button - referenced by SCMAbstractCommitDialog>>doRunSanityChecks "
#'stx:libwidg2' "ProgressNotification - referenced by SCMAbstractTask>>notify:progress: "
)
+!
+
+referencedPreRequisites
+ "list all packages containing classes referenced by the packages's members.
+ This list can be maintained manually or (better) generated and
+ updated by looking for global variable accesses
+ (the browser has a menu function for that)
+ However, often too much is found, and you may want to explicitely
+ exclude individual packages in the #excludedFromPreRequisites method."
+
+ ^ #(
+ #'stx:libjava' "JavaVM - referenced by SCMAbstractFileoutLikeTask>>doRemoveOldContainersFor: "
+ #'stx:libtool' "Tools::ChangeSetDiffTool - referenced by SCMCommonSourceCodeManagerUtilities>>compareProject:withRepositoryVersionFrom: "
+ #'stx:libview' "Color - referenced by SCMAbstractCommitDialog>>browseWorkingCopyLabel "
+ #'stx:libwidg' "Button - referenced by SCMAbstractCommitDialog>>doRunSanityChecks "
+ #'stx:libwidg2' "ProgressNotification - referenced by SCMAbstractFileoutLikeTask>>doCompileCopyrightMethodsFor: "
+ )
+!
+
+subProjects
+ "list packages which are known as subprojects.
+ The generated makefile will enter those and make there as well.
+ However: they are not forced to be loaded when a package is loaded;
+ for those, redefine requiredPrerequisites"
+
+ ^ #(
+ )
! !
!stx_libscm_common class methodsFor:'description - contents'!
@@ -105,13 +147,15 @@
SCMAbstractPackageModel
SCMAbstractPackageModelRegistry
SCMAbstractSourceCodeManager
+ SCMAbstractTask
+ SCMCodeMonitor
+ SCMCommonPackageModelGroup
+ SCMCommonSourceCodeManagerUtilities
+ SCMCompatModeQuery
#'stx_libscm_common'
- SCMAbstractTask
SCMAbstractCommitDialog
SCMAbstractFileoutLikeTask
SCMAbstractCommitTask
- SCMCommonSourceCodeManagerUtilities
- SCMCompatModeQuery
)
!
@@ -120,10 +164,8 @@
Entries are 2-element array literals, consisting of class-name and selector."
^ #(
- ChangeSet condenseChangesForPackageAfterCommit:
+ ChangeSet condenseChangesForPackageAfterCommit:
)
-
- "Modified: / 20-11-2012 / 21:13:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!stx_libscm_common class methodsFor:'description - project information'!
--- a/mercurial/HGCommitDialog.st Wed Mar 05 09:21:52 2014 +0000
+++ b/mercurial/HGCommitDialog.st Wed Mar 05 09:55:13 2014 +0000
@@ -435,12 +435,12 @@
remoteHolder isNil ifTrue:[
| remote |
- remote := self task isPackageCommit ifTrue:[self task package repository remoteDefault] ifFalse:[nil].
+ remote := self task isPackageCommit ifTrue:[self task repository remoteDefault] ifFalse:[nil].
remoteHolder := remote asValue.
].
^ remoteHolder.
- "Modified: / 12-01-2013 / 12:05:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-02-2014 / 23:47:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
remoteListHolder
@@ -456,12 +456,12 @@
remoteListHolder isNil ifTrue:[
| remoteList |
- remoteList := self task isPackageCommit ifTrue:[self task package repository remotes] ifFalse:[nil].
+ remoteList := self task isPackageCommit ifTrue:[self task repository remotes] ifFalse:[nil].
remoteListHolder := remoteList asValue
].
^ remoteListHolder.
- "Modified: / 12-01-2013 / 12:06:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-02-2014 / 23:47:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
remotePushHolder
@@ -560,7 +560,7 @@
doCheckHead
"Checks whether commit would create a new head"
- self task commitingNewHead ifTrue:[
+ self task isCommitingNewHead ifTrue:[
self infoPanel
reset;
beInformation;
--- a/mercurial/HGCommitTask.st Wed Mar 05 09:21:52 2014 +0000
+++ b/mercurial/HGCommitTask.st Wed Mar 05 09:55:13 2014 +0000
@@ -5,7 +5,7 @@
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
-version 2.1 of the License.
+version 2.1 of the License.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -35,7 +35,7 @@
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
-version 2.1 of the License.
+version 2.1 of the License.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -52,7 +52,7 @@
author
^author isNil ifTrue:[
- | a |
+ | a |
a := HGAuthorQuery query.
a isNil ifTrue:[
a := temporaryWorkingCopy repository config ui_username.
@@ -81,7 +81,7 @@
message
(message isNil and:[self isMergeCommit]) ifTrue:[
message := String streamContents:[:s|
- | parent2 |
+ | parent2 |
s nextPutAll: 'Merged '.
s nextPutAll: temporaryWorkingCopy parent1Id printStringWithoutNumber.
s nextPutAll: ' and '.
@@ -102,6 +102,7 @@
^super message.
"Created: / 01-04-2013 / 13:53:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+
!
remote
@@ -117,14 +118,15 @@
doCommit: msg files: containers
"Actually commit the changes, To be overridden by subclasses"
- self synchronized:[
- | wc createBranch |
+ self synchronized:[
+ | wc repository createBranch |
wc := temporaryWorkingCopy.
+ repository := packages notEmpty ifTrue:[packages anElement repository] ifFalse:[ temporaryWorkingCopy repository ].
createBranch := branch notNil and:[branch ~= wc branch name].
createBranch ifTrue:[
- (self package repository branches contains:[:b|b name = branch]) ifTrue:[
+ (repository branches contains:[:b|b name = branch]) ifTrue:[
HGCommitError raiseErrorString: 'Commiting to an existing branch is not allowed'.
^self.
].
@@ -139,90 +141,100 @@
self isPackageCommit ifTrue:[
wc repository push: nil force: true.
remote notNil ifTrue:[
- self package repository push: remote name force: false.
- ].
+ repository push: remote name force: false.
+ ].
"/Also, mark original (package) working copy as given branch
"/so subsequent 'hg update' will update from that branch
createBranch ifTrue:[
- self package repository workingCopy branch: branch.
+ repository workingCopy branch: branch.
].
]
].
"Created: / 15-11-2012 / 16:52:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 10-12-2012 / 10:53:14 / jv"
- "Modified: / 01-04-2013 / 13:41:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-02-2014 / 23:07:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doPrepareWorkingCopy2
self isPackageCommit ifTrue:[
self do:[
- self package ensureTemporaryWorkingCopyAtRevision:self package revision.
+ | p |
+
+ p := packages anElement.
+ p ensureTemporaryWorkingCopyAtRevision:p revision.
+
self doFileOut
]
].
"Created: / 28-11-2012 / 09:42:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 21-02-2014 / 23:27:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGCommitTask methodsFor:'executing - private'!
-doCompileCopyrightMethods
+doCompileCopyrightMethodsFor: package
- self packageDefinition hgEnsureCopyrightMethod ifFalse:[ ^ self ].
- super doCompileCopyrightMethods
+ package definition hgEnsureCopyrightMethod ifFalse:[ ^ self ].
+ super doCompileCopyrightMethodsFor: package.
- "Created: / 09-10-2013 / 11:55:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-02-2014 / 23:00:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doCompileVersionMethods
- | klasses |
+
+ packages do:[:each |
+ each isVirtual ifFalse:[
+ | klasses |
- klasses := self classesToFileOut asArray.
- self packageDefinition hgEnsureVersion_HGMethod ifFalse:[
- klasses := klasses select:[:cls| self shouldFileOutClass: cls ].
- ].
- self doCompileVersionMethodsIn: klasses
+ klasses := self classesToFileOutFor: each.
+ (each definition hgEnsureVersion_HGMethod or:[each root definition hgEnsureVersion_HGMethod]) ifFalse:[
+ klasses := klasses select:[:cls| self shouldFileOutClass: cls].
+ ].
+ self doCompileVersionMethodsFor: each in: klasses asArray.
+ ]
+ ].
"Created: / 09-10-2013 / 11:58:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 28-02-2014 / 09:53:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-doRemoveOldContainers
- | def |
+doRemoveOldContainersFor: package
- def := self package definition.
- def hgRemoveContainesForDeletedClasses ifFalse:[
+ (package definition hgRemoveContainesForDeletedClasses or:[package root definition hgRemoveContainesForDeletedClasses]) ifFalse:[
^self.
].
- super doRemoveOldContainers
+ super doRemoveOldContainersFor: package
- "Created: / 21-05-2013 / 16:48:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 21-02-2014 / 23:23:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGCommitTask methodsFor:'queries'!
-commitingNewHead
+isCommitingNewHead
"Return true, if a new head is to be commited, false otherwise.
!!!!!!NOTE!!!!!!
When there is no head at all such as when commiting to a fresh repository
- or into a just-created branch, this method returns FALSE.
- "
+ or into a just-created branch, this method returns FALSE."
- | heads changeset |
+ | heads changeset |
heads := temporaryWorkingCopy heads.
- heads isEmpty ifTrue:[ ^ false ].
+ heads isEmpty ifTrue:[
+ ^ false
+ ].
changeset := temporaryWorkingCopy changeset.
- ^(heads includes: changeset) not
+ ^ (heads includes:changeset) not
"Created: / 08-03-2013 / 20:11:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-04-2013 / 12:57:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isMergeCommit
- "Return true, if this commit is a merge commit, i.e.,
+ "Return true, if this commit is a merge commit, i.e.,
if commited changeset will have two parents"
^temporaryWorkingCopy parent2Id isNull not
--- a/mercurial/HGPackageModel.st Wed Mar 05 09:21:52 2014 +0000
+++ b/mercurial/HGPackageModel.st Wed Mar 05 09:55:13 2014 +0000
@@ -73,27 +73,6 @@
"Modified: / 01-12-2012 / 00:33:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-revision
- "Return a logical revision of the package, i.e., a revision
- on which the next commit will be based on"
-
- | model |
-
- model := self.
- [ model notNil ] whileTrue:[
- | rev |
-
- rev := model definition hgLogicalRevision.
- rev notNil ifTrue:[ ^rev ].
- model := model parent.
- ].
-
- ^repository workingCopy changesetId
-
- "Created: / 28-11-2012 / 09:41:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 11-06-2013 / 00:23:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
temporaryRepository
self ensureTemporaryWorkingCopy.
^wc repository
@@ -117,6 +96,28 @@
"Created: / 14-11-2012 / 00:36:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!HGPackageModel methodsFor:'accessing-private'!
+
+getRevision
+ "Return a logical revision of the package, i.e., a revision
+ on which the next commit will be based on"
+
+ | model |
+
+ model := self.
+ [ model notNil ] whileTrue:[
+ | rev |
+
+ rev := model definition hgLogicalRevision.
+ rev notNil ifTrue:[ ^rev ].
+ model := model parent.
+ ].
+
+ ^repository workingCopy changesetId
+
+ "Created: / 28-02-2014 / 09:34:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!HGPackageModel methodsFor:'initialization'!
setName:aSymbolOrPackageId repository:aRepository
@@ -168,18 +169,38 @@
commited
"Sent by commit task once commited"
- | versionMethod |
+ | def oldRev newRev |
super commited.
- versionMethod := self definition class compiledMethodAt: HGSourceCodeManager nameOfVersionMethodInClasses.
- versionMethod isNil ifTrue:[
- self error:'Should not happen!!'.
+ def := self definition.
+ oldRev := def hgLogicalRevision.
+ newRev := wc changeset id.
+
+ self root yourselfAndAllChildrenDo:[:each|
+ each isVirtual ifFalse:[
+ each updateLogicalRevisionFrom: oldRev to: newRev
+ ].
].
- versionMethod annotateWith:
- (HGRevisionAnnotation revision: wc changeset id)
+
+ self assert: (def hgLogicalRevision = newRev).
"Created: / 23-11-2012 / 22:52:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-02-2014 / 23:13:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+updateLogicalRevisionFrom: oldRev to: newRev
+ "Updates package logical revision to `newRev` but
+ only if it's current logical revision is `oldRev`"
+
+ | def |
+
+ def := self definition.
+ def hgLogicalRevision = oldRev ifTrue:[
+ def hgLogicalRevision: newRev
+ ].
+
+ "Created: / 20-02-2014 / 00:09:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGPackageModel methodsFor:'utils'!
--- a/mercurial/HGStXTests.st Wed Mar 05 09:21:52 2014 +0000
+++ b/mercurial/HGStXTests.st Wed Mar 05 09:55:13 2014 +0000
@@ -161,7 +161,7 @@
(MockHGP1Bar compile:'zork ^ 1' classified:'test') package: MockHGP1Bar package.
pm := HGPackageModel named: 'mocks:hg/p1'.
ct := pm commitTask.
- self assert: ct commitingNewHead not.
+ self assert: ct isCommitingNewHead not.
ct message:'test_commit_01'.
ct do.
self dumpRepositoryLog: repo.
@@ -285,7 +285,7 @@
self deny: ((repo @ 1 / 'MockHGP1Bar.st') contents asString includesString:'zork ^ 1').
ctA := pmA commitTask.
- self assert: ctA commitingNewHead not.
+ self assert: ctA isCommitingNewHead not.
ctA message:'test_commit_03a A-1'.
ctA do.
self dumpRepositoryLog: repo.
@@ -306,7 +306,7 @@
(MockHGP1Bar compile:'zork ^ 2' classified:'test') package: MockHGP1Bar package.
ctA := pmA commitTask.
- self assert: ctA commitingNewHead not.
+ self assert: ctA isCommitingNewHead not.
ctA message:'test_commit_03a A-3'.
ctA do.
self dumpRepositoryLog: repo.
@@ -419,47 +419,6 @@
"Modified: / 27-11-2012 / 22:16:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-test_commit_04a
- "
- Two packages in single repository:
- mocks:hg/p1/n1
- mocks:hg/p2/n2
-
- 1) load both (they should be of same revision)
- 2) modify & commit n1
- 3) check that n2 has same logical revision as n1.
- "
-
- <skip> "/ not yet supported
-
- | repo pmN1 pmN2 ctN1 |
-
- ^self. "Hack for Smalltalk/X 6.2.2 whose test report runner doesn't understand <skip>"
-
- repo := self repositoryNamed: 'mocks/hg/p2'.
- self assert: (Smalltalk loadPackage:'mocks:hg/p2/n1').
- self assert: (Smalltalk loadPackage:'mocks:hg/p2/n2').
- pmN1 := HGPackageModel named: 'mocks:hg/p2/n1'.
- pmN2 := HGPackageModel named: 'mocks:hg/p2/n2'.
- self assert: pmN1 revision = pmN2 revision.
-
- "=== A modifies & commits =============================== "
- (MocksHgP2N1Foo compile:'zork ^ 2' classified:'test') package: MocksHgP2N1Foo package.
-
- ctN1 := pmN1 commitTask.
- ctN1 message:'test_commit_04a 1'.
- ctN1 do.
-
- self assert: pmN1 revision = pmN2 revision.
-
- "
- repo workingCopy browse
- "
-
- "Created: / 01-12-2012 / 17:20:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 06-07-2013 / 00:31:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
test_commit_05a
"
Setup:
@@ -567,7 +526,7 @@
ct := pm commitTask.
ct message:'test_commit_06a 1'.
ct branch:'test_commit_06a'.
- self assert: ct commitingNewHead not.
+ self assert: ct isCommitingNewHead not.
ct do.
"=== check for the branch ========================= "
@@ -676,7 +635,7 @@
pm := HGPackageModel named: #'mocks:hg/p4_empty'.
ct := pm commitTask.
- self assert: ct commitingNewHead not.
+ self assert: ct isCommitingNewHead not.
ct message:'test_commit_07'.
ct do.
@@ -708,7 +667,7 @@
pm := HGPackageModel named: 'mocks:hg/p1'.
ct := pm commitTask.
- self assert: ct commitingNewHead not.
+ self assert: ct isCommitingNewHead not.
ct message:'test_commit_08 1'.
ct do.
@@ -742,7 +701,7 @@
pm := HGPackageModel named: #'mocks:hg/p1/new'.
ct := pm commitTask.
- self assert: ct commitingNewHead not.
+ self assert: ct isCommitingNewHead not.
ct message:'test_commit_09'.
ct do.
@@ -1624,6 +1583,505 @@
"Created: / 04-03-2014 / 21:18:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!HGStXTests methodsFor:'tests - commit - nested'!
+
+test_commit_nested_01a
+ "
+ Nested packages
+ mocks:hg/p2
+ mocks:hg/p2/n1
+ mocks:hg/p2/n2
+
+ 1) load all of them
+ 2) modify & commit p1
+ 3) check that n1 & n2 has same logical revision as p1.
+ "
+
+ | repo pmP2 pmP2N1 pmP2N2 ctP2 |
+
+ repo := self repositoryNamed: 'mocks/hg/p2'.
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n1').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n2').
+ pmP2 := HGPackageModel named: 'mocks:hg/p2'.
+ pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
+ pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
+ self assert: pmP2N1 revision = pmP2N2 revision.
+
+ "=== A modifies & commits =============================== "
+ ((Smalltalk at: #MocksHgP2Foo) compile:'zork ^ 2' classified:'test') package: (Smalltalk at: #MocksHgP2Foo) package.
+
+ ctP2 := pmP2 commitTask.
+ ctP2 message:'test_commit_nested_01a 1'.
+ ctP2 do.
+
+ self assert: pmP2 revision = pmP2N1 revision.
+ self assert: pmP2 revision = pmP2N2 revision.
+
+ "
+ repo workingCopy browse
+ "
+
+ "Created: / 18-02-2014 / 20:32:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_commit_nested_01b
+ "
+ Nested packages
+ mocks:hg/p2
+ mocks:hg/p2/n1
+ mocks:hg/p2/n2
+
+ 1) load all of them
+ 2) modify & commit n1
+ 3) check that p1 & n2 has same logical revision as n1.
+ "
+
+ | repo pmP2 pmP2N1 pmP2N2 ctP2N1 |
+
+ repo := self repositoryNamed: 'mocks/hg/p2'.
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n1').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n2').
+ pmP2 := HGPackageModel named: 'mocks:hg/p2'.
+ pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
+ pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
+ self assert: pmP2N1 revision = pmP2N2 revision.
+
+ "=== A modifies & commits =============================== "
+ ((Smalltalk at: #MocksHgP2N1Foo) compile:'zork ^ 2' classified:'test') package: (Smalltalk at: #MocksHgP2N1Foo) package.
+
+ ctP2N1 := pmP2N1 commitTask.
+ ctP2N1 message:'test_commit_nested_01b 1'.
+ ctP2N1 do.
+
+ self assert: pmP2 revision = pmP2N1 revision.
+ self assert: pmP2 revision = pmP2N2 revision.
+
+ "
+ repo workingCopy browse
+ "
+
+ "Created: / 18-02-2014 / 20:35:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_commit_nested_01c
+ "
+ Nested packages
+ mocks:hg/p2
+ mocks:hg/p2/n1
+ mocks:hg/p2/n2
+
+ 1) load all of them
+ 2) modify & commit n2
+ 3) check that p1 & n1 has same logical revision as n2.
+ "
+
+ | repo pmP2 pmP2N1 pmP2N2 ctP2N2 |
+
+ repo := self repositoryNamed: 'mocks/hg/p2'.
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n1').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n2').
+ pmP2 := HGPackageModel named: 'mocks:hg/p2'.
+ pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
+ pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
+ self assert: pmP2N1 revision = pmP2N2 revision.
+
+ "=== A modifies & commits =============================== "
+ ((Smalltalk at: #MocksHgP2N2Foo) compile:'zork ^ 2' classified:'test') package: (Smalltalk at: #MocksHgP2N2Foo) package.
+
+ ctP2N2 := pmP2N2 commitTask.
+ ctP2N2 message:'test_commit_nested_01c 1'.
+ ctP2N2 do.
+
+ self assert: pmP2 revision = pmP2N1 revision.
+ self assert: pmP2 revision = pmP2N2 revision.
+
+ "
+ repo workingCopy browse
+ "
+
+ "Created: / 18-02-2014 / 20:36:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_commit_nested_02a
+ "
+ Two packages in single repository but without 'parent' package.
+ mocks:hg/p2/n1
+ mocks:hg/p2/n2
+
+ 1) load both (they should be of same revision)
+ 2) modify & commit n1
+ 3) check that n2 has same logical revision as n1.
+ "
+
+ | repo pmN1 pmN2 ctN1 |
+
+ repo := self repositoryNamed: 'mocks/hg/p2'.
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n1').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n2').
+ pmN1 := HGPackageModel named: 'mocks:hg/p2/n1'.
+ pmN2 := HGPackageModel named: 'mocks:hg/p2/n2'.
+ self assert: pmN1 revision = pmN2 revision.
+
+ "=== A modifies & commits =============================== "
+ (MocksHgP2N1Foo compile:'zork ^ 2' classified:'test') package: MocksHgP2N1Foo package.
+
+ ctN1 := pmN1 commitTask.
+ ctN1 message:'test_commit_nested_02a 1'.
+ ctN1 do.
+
+ self assert: pmN1 revision = pmN2 revision.
+
+ "
+ repo workingCopy browse
+ "
+
+ "Created: / 18-02-2014 / 20:37:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_commit_nested_03a
+ "
+ Nested packages
+ mocks:hg/p2
+ mocks:hg/p2/n1
+ mocks:hg/p2/n2
+
+ 1) load all of them
+ 2) modify & commit p1 & n1
+ 3) check that n1 & n2 has same logical revision as p1.
+ check that n1 has been commited too.
+ "
+
+ | repo pmP2 pmP2N1 pmP2N2 ctP2 |
+
+ repo := self repositoryNamed: 'mocks/hg/p2'.
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n1').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n2').
+ pmP2 := HGPackageModel named: 'mocks:hg/p2'.
+ pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
+ pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
+ self assert: pmP2N1 revision = pmP2N2 revision.
+
+ "=== A modifies & commits =============================== "
+ ((Smalltalk at: #MocksHgP2Foo) compile:'zork ^ 2' classified:'test') package: (Smalltalk at: #MocksHgP2Foo) package.
+ ((Smalltalk at: #MocksHgP2N1Foo) compile:'zork ^ 2' classified:'test') package: (Smalltalk at: #MocksHgP2N1Foo) package.
+
+ ctP2 := pmP2 commitTask.
+ ctP2 message:'test_commit_nested_01a 1'.
+ ctP2 do.
+
+ self assert: pmP2 revision = pmP2N1 revision.
+ self assert: pmP2 revision = pmP2N2 revision.
+ self assert: ((repo @ 4 / 'MocksHgP2Foo.st') contents asString includesString:'zork ^ 2').
+ self assert: ((repo @ 4 / 'n1' / 'MocksHgP2N1Foo.st') contents asString includesString:'zork ^ 2').
+
+ "
+ repo workingCopy browse
+ "
+
+ "Created: / 18-02-2014 / 20:57:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_commit_nested_03b
+ "
+ Nested packages
+ mocks:hg/p2
+ mocks:hg/p2/n1
+ mocks:hg/p2/n2
+
+ 1) load all of them
+ 2) modify p1 & n1, commit n1
+ 3) check that commit task warn about parent package
+ being changed and in need to be commited too...
+ "
+
+ | repo pmP2 pmP2N1 pmP2N2 ctP2N1 |
+
+ repo := self repositoryNamed: 'mocks/hg/p2'.
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n1').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n2').
+ pmP2 := HGPackageModel named: 'mocks:hg/p2'.
+ pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
+ pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
+ self assert: pmP2N1 revision = pmP2N2 revision.
+
+ "=== A modifies & commits =============================== "
+ ((Smalltalk at: #MocksHgP2Foo) compile:'zork ^ 2' classified:'test') package: (Smalltalk at: #MocksHgP2Foo) package.
+ ((Smalltalk at: #MocksHgP2N1Foo) compile:'zork ^ 2' classified:'test') package: (Smalltalk at: #MocksHgP2N1Foo) package.
+
+ ctP2N1 := pmP2N1 commitTask.
+ ctP2N1 message:'test_commit_nested_03b 1'.
+
+ self assert: ctP2N1 isCommitingAllChangedPackages not.
+
+ ctP2N1 do.
+
+ self assert: pmP2 revision = pmP2N1 revision.
+ self assert: pmP2 revision = pmP2N2 revision.
+ self assert: ((repo @ 4 / 'MocksHgP2Foo.st') contents asString includesString:'zork ^ 2') not.
+ self assert: ((repo @ 4 / 'n1' / 'MocksHgP2N1Foo.st') contents asString includesString:'zork ^ 2').
+
+ "
+ repo workingCopy browse
+ "
+
+ "Created: / 18-02-2014 / 21:38:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 03-03-2014 / 00:53:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_commit_nested_04a
+ "
+ Nested packages
+ mocks:hg/p2 @ 3
+ mocks:hg/p2/n1 @ 3
+ mocks:hg/p2/n2 @ 2
+
+ 1) load all of them
+ 2) modify & commit p1
+ 3) check that n1 has same logical revision as p1
+ but NOT n2
+ "
+
+ | repo pmP2 pmP2N1 pmP2N2 ctP2 |
+
+ repo := self repositoryNamed: 'mocks/hg/p2'.
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n1').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n2').
+
+ "/ Force n2 to think it comes from rev 2...
+ ((Smalltalk at: #'mocks_hg_p2_n2') class compiledMethodAt: #version_HG)
+ annotateWith: (HGRevisionAnnotation revision: (repo @ 2) id).
+
+
+
+ pmP2 := HGPackageModel named: 'mocks:hg/p2'.
+ pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
+ pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
+ self assert: pmP2 revision = pmP2N1 revision.
+ self assert: pmP2N2 revision = '84a2ca31f8d9' asHGChangesetId.
+
+ "=== A modifies & commits =============================== "
+ ((Smalltalk at: #MocksHgP2Foo) compile:'zork ^ 2' classified:'test') package: (Smalltalk at: #MocksHgP2Foo) package.
+
+ ctP2 := pmP2 commitTask.
+ ctP2 message:'test_commit_nested_01a 1'.
+ ctP2 do.
+
+ self assert: pmP2 revision = pmP2N1 revision.
+ self assert: pmP2N2 revision = '84a2ca31f8d9' asHGChangesetId.
+
+ "
+ repo workingCopy browse
+ "
+
+ "Created: / 18-02-2014 / 21:10:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 26-02-2014 / 00:11:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_commit_nested_04b
+ "
+ Nested packages
+ mocks:hg/p2 @ 3
+ mocks:hg/p2/n1 @ 3
+ mocks:hg/p2/n2 @ 2
+
+ 1) load all of them
+ 2) modify & commit n1
+ 3) check that n1 has same logical revision as p1
+ but NOT n2
+ "
+
+ | repo pmP2 pmP2N1 pmP2N2 ctP2N1 |
+
+ repo := self repositoryNamed: 'mocks/hg/p2'.
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n1').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n2').
+
+ "/ Force n2 to think it comes from rev 2...
+ ((Smalltalk at: #'mocks_hg_p2_n2') class compiledMethodAt: #version_HG)
+ annotateWith: (HGRevisionAnnotation revision: (repo @ 2) id).
+
+
+
+ pmP2 := HGPackageModel named: 'mocks:hg/p2'.
+ pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
+ pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
+ self assert: pmP2 revision = pmP2N1 revision.
+ self assert: pmP2N2 revision ='84a2ca31f8d9' asHGChangesetId.
+
+ "=== A modifies & commits =============================== "
+ ((Smalltalk at: #MocksHgP2Foo) compile:'zork ^ 2' classified:'test') package: (Smalltalk at: #MocksHgP2Foo) package.
+
+ ctP2N1 := pmP2N1 commitTask.
+ ctP2N1 message:'test_commit_nested_04b 1'.
+ ctP2N1 do.
+
+ self assert: pmP2 revision = pmP2N1 revision.
+ self assert: pmP2N2 revision = '84a2ca31f8d9' asHGChangesetId.
+
+ "
+ repo workingCopy browse
+ "
+
+ "Created: / 18-02-2014 / 21:11:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_commit_nested_04c
+ "
+ Nested packages
+ mocks:hg/p2 @ 3
+ mocks:hg/p2/n1 @ 3
+ mocks:hg/p2/n2 @ 2
+
+ 1) load all of them
+ 2) modify & commit n2
+ 3) check that n1 has same logical revision as p1
+ but NOT n2
+ "
+
+ | repo pmP2 pmP2N1 pmP2N2 ctP2N2 |
+
+ repo := self repositoryNamed: 'mocks/hg/p2'.
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n1').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n2').
+
+ "/ Force n2 to think it comes from rev 2...
+ ((Smalltalk at: #'mocks_hg_p2_n2') class compiledMethodAt: #version_HG)
+ annotateWith: (HGRevisionAnnotation revision: (repo @ 2) id).
+
+
+
+ pmP2 := HGPackageModel named: 'mocks:hg/p2'.
+ pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
+ pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
+ self assert: pmP2 revision = pmP2N1 revision.
+ self assert: pmP2N2 revision = '84a2ca31f8d9' asHGChangesetId.
+
+ "=== A modifies & commits =============================== "
+ ((Smalltalk at: #MocksHgP2Foo) compile:'zork ^ 2' classified:'test') package: (Smalltalk at: #MocksHgP2Foo) package.
+
+ ctP2N2 := pmP2N2 commitTask.
+ ctP2N2 message:'test_commit_nested_04c 1'.
+ ctP2N2 do.
+
+ self assert: pmP2 revision = pmP2N1 revision.
+ self assert: pmP2 revision = '9e9134b80dfa' asHGChangesetId.
+ self assert: pmP2N2 revision revno == 4.
+
+ "
+ repo workingCopy browse
+ "
+
+ "Created: / 18-02-2014 / 21:12:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_commit_nested_05a
+ "
+ Nested packages
+ mocks:hg/p2/n1 @ 3
+ mocks:hg/p2/n2 @ 3
+
+ 1) load both of them
+ 2) modify n1 & commit p2
+ 3) check that p2 has same logical revision as n1 and n2
+ check that no mocks_hg_p2 project definition is created
+ and commited (in this situation p2 is a virtual package)
+ "
+
+ | repo pmP2 pmP2N1 pmP2N2 ct |
+
+ repo := self repositoryNamed: 'mocks/hg/p2'.
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n1').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n2').
+
+ pmP2 := HGPackageModel named: 'mocks:hg/p2'.
+ pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
+ pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
+ self assert: pmP2 isVirtual.
+ self assert: pmP2N1 isVirtual not.
+ self assert: pmP2N2 isVirtual not.
+ self assert: pmP2 revision = pmP2N1 revision.
+ self assert: pmP2 revision = pmP2N2 revision.
+ "/ Package mocks:hg/p2 is NOT loaded
+ self assert: (Smalltalk at:#'mocks_hg_p2') isNil.
+
+ "=== A modifies & commits =============================== "
+ ((Smalltalk at: #MocksHgP2N1Foo) compile:'zork ^ 2' classified:'test') package: (Smalltalk at: #MocksHgP2N1Foo) package.
+
+ ct := pmP2 commitTask.
+ ct message:'test_commit_nested_05a 1'.
+ ct do.
+
+ self assert: pmP2 revision = pmP2N1 revision.
+ self assert: pmP2 revision = pmP2N2 revision.
+
+ self assert: pmP2 revision revno == 4.
+ "/ Package mocks:hg/p2 is NOT loaded
+ self assert: (Smalltalk at:#'mocks_hg_p2') isNil
+
+ "
+ repo workingCopy browse
+ "
+
+ "Created: / 26-02-2014 / 22:56:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 28-02-2014 / 09:40:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_commit_nested_05b
+ "
+ Nested packages
+ mocks:hg/p2/n1 @ 3
+ mocks:hg/p2/n2 @ 3
+
+ 1) load both of them
+ 2) modify n1 & commit n1 + n2
+ 3) check that n1 has same logical revision as n2
+ check that no mocks_hg_p2 project definition is created
+ and commited (in this situation p2 is a virtual package)
+ "
+
+ | repo pmP2N1 pmP2N2 ct |
+
+ repo := self repositoryNamed: 'mocks/hg/p2'.
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n1').
+ self assert: (Smalltalk loadPackage:'mocks:hg/p2/n2').
+
+ pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
+ pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
+
+ self assert: pmP2N1 isVirtual not.
+ self assert: pmP2N2 isVirtual not.
+ self assert: pmP2N1 revision = pmP2N2 revision.
+
+
+
+ "=== A modifies & commits =============================== "
+ ((Smalltalk at: #MocksHgP2N1Foo) compile:'zork ^ 2' classified:'test') package: (Smalltalk at: #MocksHgP2N1Foo) package.
+
+ ct := (pmP2N1 , pmP2N2) commitTask.
+ ct message:'test_commit_nested_05b 1'.
+ ct do.
+
+ self assert: pmP2N1 revision = pmP2N2 revision.
+ self assert: pmP2N1 revision revno == 4.
+ self assert: (Smalltalk at:#'mocks_hg_p2') isNil
+
+ "
+ repo workingCopy browse
+ "
+
+ "Created: / 26-02-2014 / 22:56:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-02-2014 / 22:57:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 28-02-2014 / 09:12:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!HGStXTests methodsFor:'tests - manager API'!
test_log_01
@@ -2123,6 +2581,88 @@
"Modified: / 16-05-2013 / 13:18:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+test_misc_packagegroup_01a
+ | repo pmP2 pmP2N1 pmP2N2 pg|
+
+ repo := self repositoryNamed: 'mocks/hg/p2'.
+ Smalltalk loadPackage:'mocks:hg/p2'.
+ Smalltalk loadPackage:'mocks:hg/p2/n1'.
+ Smalltalk loadPackage:'mocks:hg/p2/n2'.
+ pmP2 := HGPackageModel named: 'mocks:hg/p2'.
+ pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
+ pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
+
+ pg := SCMCommonPackageModelGroup with: pmP2.
+
+ self assert: (pg includes: pmP2).
+ self assert: (pg includes: pmP2N1).
+ self assert: (pg includes: pmP2N2).
+
+ "Created: / 03-03-2014 / 09:00:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_misc_packagegroup_01b
+ | repo pmP2 pmP2N1 pmP2N2 pg|
+
+ repo := self repositoryNamed: 'mocks/hg/p2'.
+ Smalltalk loadPackage:'mocks:hg/p2'.
+ Smalltalk loadPackage:'mocks:hg/p2/n1'.
+ Smalltalk loadPackage:'mocks:hg/p2/n2'.
+ pmP2 := HGPackageModel named: 'mocks:hg/p2'.
+ pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
+ pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
+
+ pg := SCMCommonPackageModelGroup with: pmP2N1.
+
+ self assert: (pg includes: pmP2) not.
+ self assert: (pg includes: pmP2N1).
+ self assert: (pg includes: pmP2N2) not.
+
+ "Created: / 03-03-2014 / 09:02:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_misc_packagegroup_02a
+ | repo pmP2 pmP2N1 pmP2N2 pg|
+
+ repo := self repositoryNamed: 'mocks/hg/p2'.
+ Smalltalk loadPackage:'mocks:hg/p2'.
+ Smalltalk loadPackage:'mocks:hg/p2/n1'.
+ Smalltalk loadPackage:'mocks:hg/p2/n2'.
+ pmP2 := HGPackageModel named: 'mocks:hg/p2'.
+ pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
+ pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
+
+ pg := SCMCommonPackageModelGroup with: pmP2N1.
+ pg add: pmP2N2.
+
+ self assert: (pg includes: pmP2) not.
+ self assert: (pg includes: pmP2N1).
+ self assert: (pg includes: pmP2N2).
+
+ "Created: / 03-03-2014 / 09:03:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_misc_packagegroup_02b
+ | repo pmP2 pmP2N1 pmP2N2 pg|
+
+ repo := self repositoryNamed: 'mocks/hg/p2'.
+ Smalltalk loadPackage:'mocks:hg/p2'.
+ Smalltalk loadPackage:'mocks:hg/p2/n1'.
+ Smalltalk loadPackage:'mocks:hg/p2/n2'.
+ pmP2 := HGPackageModel named: 'mocks:hg/p2'.
+ pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
+ pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
+
+ pg := SCMCommonPackageModelGroup with: pmP2N1.
+ pg add: pmP2.
+
+ self assert: (pg includes: pmP2).
+ self assert: (pg includes: pmP2N1).
+ self assert: (pg includes: pmP2N2).
+
+ "Created: / 03-03-2014 / 09:03:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
test_misc_packagemodel_01
| repo pm |
@@ -2138,7 +2678,7 @@
| repo pmP2 pmP2N1|
repo := self repositoryNamed: 'mocks/hg/p2'.
- Smalltalk loadPackage:'mocks:hg/p1'.
+ Smalltalk loadPackage:'mocks:hg/p2'.
pmP2 := HGPackageModel named: 'mocks:hg/p2'.
pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
@@ -2147,33 +2687,37 @@
self assert: (pmP2 construct:'n1') == pmP2N1
"Created: / 03-12-2012 / 15:46:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 28-02-2014 / 10:20:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_misc_packagemodel_03
| repo pmP2N1 pmP2N2|
repo := self repositoryNamed: 'mocks/hg/p2'.
- Smalltalk loadPackage:'mocks:hg/p1'.
+ Smalltalk loadPackage:'mocks:hg/p2'.
pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
self assert: pmP2N1 parent == pmP2N2 parent.
"Created: / 03-12-2012 / 15:48:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 28-02-2014 / 10:25:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_misc_packagemodel_03b
| repo pmP2N1 pmP2N2|
repo := self repositoryNamed: 'mocks/hg/p2'.
- Smalltalk loadPackage:'mocks:hg/p1/n1'.
- Smalltalk loadPackage:'mocks:hg/p1/n2'.
+ Smalltalk loadPackage:'mocks:hg/p2/n1'.
+ Smalltalk loadPackage:'mocks:hg/p2/n2'.
pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
self assert: pmP2N1 parent == pmP2N2 parent.
+ self assert: pmP2N1 repository == pmP2N2 repository.
"Created: / 03-12-2012 / 15:48:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 19-02-2014 / 23:17:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGStXTests methodsFor:'utilities'!
--- a/mercurial/extensions.st Wed Mar 05 09:21:52 2014 +0000
+++ b/mercurial/extensions.st Wed Mar 05 09:55:13 2014 +0000
@@ -944,6 +944,31 @@
"Modified: / 14-01-2013 / 13:42:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!ProjectDefinition class methodsFor:'accessing - hg'!
+
+hgLogicalRevision: anHGChangesetId
+ "
+ Set Mercurial revision on which is this package based on logically.
+ To be called only from Mercurial support upon commit from image.
+ "
+
+ | versionMethod |
+
+ versionMethod := self class compiledMethodAt: HGSourceCodeManager nameOfVersionMethodInClasses.
+ versionMethod isNil ifTrue:[
+ self class compile:(self class
+ versionMethodTemplateForSourceCodeManager:HGSourceCodeManager)
+ classified:'documentation'.
+ versionMethod := self class compiledMethodAt:HGSourceCodeManager nameOfVersionMethodInClasses.
+ versionMethod setPackage:self package.
+ ].
+ versionMethod annotateWith:
+ (HGRevisionAnnotation revision: anHGChangesetId)
+
+ "Created: / 20-02-2014 / 00:06:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-02-2014 / 22:16:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!ProjectDefinition class methodsFor:'description - actions - hg'!
hgPostLoad
--- a/mercurial/stx_libscm_mercurial.st Wed Mar 05 09:21:52 2014 +0000
+++ b/mercurial/stx_libscm_mercurial.st Wed Mar 05 09:55:13 2014 +0000
@@ -293,6 +293,7 @@
AbstractFileBrowser hgCloneEnabled
AbstractFileBrowser hgInit
AbstractFileBrowser hgInitEnabled
+ 'ProjectDefinition class' hgLogicalRevision:
)
! !