Bugfixes in push parsing.
Updated parser tp handle 'remote: ' prefix when pushing
to remote repositories.
Skip mercurial_keyring extension's error output complaing on
realm quotation (the underlying python library writes to stderr, sigh)
"{ Encoding: utf8 }"
"
COPYRIGHT (c) 2012-2013 by Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libscm/mercurial' }"
HGTestCase subclass:#HGStXTests
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'SCM-Mercurial-Tests'
!
!HGStXTests class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2012-2013 by Jan Vrany
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
Tests for Mercurial-Smalltalk/X integration. Mapping packages
to Mercurial repositories, commitning packages from image
and so on...
[author:]
Jan Vrany <jan.vrany@fit.cvut.cz>
[instance variables:]
[class variables:]
[see also:]
"
! !
!HGStXTests methodsFor:'running'!
loadPackage: packageId
"A utility method to prepare a repository for package
and load package from it"
self repositoryNamed: (packageId copyReplaceAll:$: with:$/).
Smalltalk loadPackage: packageId.
"Created: / 16-11-2012 / 20:01:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
tearDown
| classes methods |
super tearDown.
"Also, wipe out all mocks"
classes := OrderedCollection new.
methods := OrderedCollection new.
Smalltalk allClassesDo:[:cls|
(cls package notNil and:[cls package startsWith:'mocks']) ifTrue:[
classes add: cls
] ifFalse:[
cls methodsDo:[:m|(m package notNil and:[m package startsWith:'mocks']) ifTrue:[methods add: m]].
cls class methodsDo:[:m|(m package notNil and:[m package startsWith:'mocks']) ifTrue:[methods add: m]].
]
].
Class withoutUpdatingChangesDo:[
classes do:[:cls|Smalltalk removeClass: cls].
methods do:[:m|m mclass removeSelector: m selector]
].
"/ Delay waitForSeconds: 1.
"/ Also, wipe out cached sources...
[
(AbstractSourceCodeManager cacheDirectoryName asFilename / 'mocks') recursiveRemove
] on: Error do:[:ex|
Delay waitForSeconds: 1.
(AbstractSourceCodeManager cacheDirectoryName asFilename / 'mocks') recursiveRemove.
]
"Created: / 16-11-2012 / 19:00:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 18-03-2013 / 19:12:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_infrastructure
"
This is kind of meta-test that tests if the
setUp/tearDown actually works. Especially, if
no mock classes/methods are left in the image
after tearDown. Also, make sure that all
HGPackageModels for mocks
"
| pm |
self loadPackage:'mocks:hg/p1'.
self assert: (Smalltalk at: #'mocks_hg_p1') notNil.
pm := HGPackageModelRegistry packageNamed:'mocks:hg/p1'.
self assert: pm notNil.
self assert: ((HGPackageModelRegistry current instVarNamed:#packages) includesKey: #'mocks:hg/p1').
pm := nil.
self cleanup.
self assert: (Smalltalk at: #'mocks_hg_p1') isNil.
self assert: repositories isNil.
self assert: ((HGPackageModelRegistry current instVarNamed:#packages) includesKey: #'mocks:hg/p1') not.
"Created: / 16-11-2012 / 19:25:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 20-11-2012 / 19:32:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 22-11-2012 / 15:31:54 / jv"
! !
!HGStXTests methodsFor:'tests - commit'!
test_commit_01
"
Simple commit
"
| repo pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage:'mocks:hg/p1').
self dumpRepositoryLog: repo.
self deny: ((repo @ 1 / 'MockHGP1Bar.st') contents asString includesString:'zork ^ 1').
(MockHGP1Bar compile:'zork ^ 1' classified:'test') package: MockHGP1Bar package.
pm := HGPackageModel named: 'mocks:hg/p1'.
ct := pm commitTask.
self assert: ct commitingNewHead not.
ct message:'test_commit_01'.
ct do.
self dumpRepositoryLog: repo.
"
repo workingCopy browse
"
self assert: ((repo @ 2 / 'MockHGP1Bar.st') contents asString includesString:'zork ^ 1').
self assert: (Smalltalk at:#mocks_hg_p1) hgLogicalRevision revno = 2.
"Created: / 16-11-2012 / 18:51:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 08-03-2013 / 20:15:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_02a
"
Repeated commit
"
| repo pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
Smalltalk loadPackage:'mocks:hg/p1'.
pm := HGPackageModel named: 'mocks:hg/p1'.
self dumpRepositoryLog: repo.
(MockHGP1Bar compile:'zork ^ 1' classified:'test') package: MockHGP1Bar package.
self deny: ((repo @ 1 / 'MockHGP1Bar.st') contents asString includesString:'zork ^ 1').
ct := pm commitTask.
ct message:'test_commit_02-1'.
ct do.
self dumpRepositoryLog: repo.
self assert: ((repo @ 2 / 'MockHGP1Bar.st') contents asString includesString:'zork ^ 1').
self assert: ((repo @ 2 ) parent1 == (repo @ 1 )).
(MockHGP1Bar compile:'zork ^ 2' classified:'test') package: MockHGP1Bar package.
ct := pm commitTask.
ct message:'test_commit_02-2'.
ct do.
self dumpRepositoryLog: repo.
self assert: (repo @ 3) message = 'test_commit_02-2'.
self assert: ((repo @ 3 / 'MockHGP1Bar.st') contents asString includesString:'zork ^ 2').
self assert: ((repo @ 3 ) parent1 == (repo @ 2 )).
"
repo workingCopy browse
"
"Created: / 20-11-2012 / 19:33:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 22-11-2012 / 11:12:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_02b
"
Repeated commit, remove the working copy between commits
"
| repo pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
Smalltalk loadPackage:'mocks:hg/p1'.
pm := HGPackageModel named: 'mocks:hg/p1'.
(MockHGP1Bar compile:'zork ^ 1' classified:'test') package: MockHGP1Bar package.
self deny: ((repo @ 1 / 'MockHGP1Bar.st') contents asString includesString:'zork ^ 1').
ct := pm commitTask.
ct message:'test_commit_02-1'.
ct do.
self assert: ((repo @ 2 / 'MockHGP1Bar.st') contents asString includesString:'zork ^ 1').
self assert: ((repo @ 2 ) parent1 == (repo @ 1 )).
(MockHGP1Bar compile:'zork ^ 2' classified:'test') package: MockHGP1Bar package.
pm temporaryWorkingCopy path recursiveRemove.
ct := pm commitTask.
ct message:'test_commit_02-2'.
ct do.
self assert: ((repo @ 3 / 'MockHGP1Bar.st') contents asString includesString:'zork ^ 2').
self assert: ((repo @ 3 ) parent1 == (repo @ 2 )).
"
repo workingCopy browse
"
"Created: / 20-11-2012 / 19:35:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-12-2012 / 00:30:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_03a
"
Two images A, B working in parallel, commiting to same repo
1) A: checkout, modify commit package (cs1)
2) B: checkout, commit change (cs2)
2) A: modify, checkout (cs3)
The changeset cs3 should have cs1 as its parent1
<skip>
"
| repo pmA ctA wcB s |
"=== A modifies & commits =============================== "
repo := self repositoryNamed: 'mocks/hg/p1'.
Smalltalk loadPackage:'mocks:hg/p1'.
self dumpRepositoryLog: repo.
pmA := HGPackageModel named: 'mocks:hg/p1'.
(MockHGP1Bar compile:'zork ^ 1' classified:'test') package: MockHGP1Bar package.
self deny: ((repo @ 1 / 'MockHGP1Bar.st') contents asString includesString:'zork ^ 1').
ctA := pmA commitTask.
self assert: ctA commitingNewHead not.
ctA message:'test_commit_03a A-1'.
ctA do.
self dumpRepositoryLog: repo.
self assert: ((repo @ 2 / 'MockHGP1Bar.st') contents asString includesString:'zork ^ 1').
self assert: ((repo @ 2 ) parent1 == (repo @ 1 )).
"=== B modifies & commits =============================== "
wcB := repo workingCopy.
s := ( wcB / 'abbrev.stc' ) appendStream.
[ s nextPutLine:'# Modification '] ensure:[s close].
wcB commit: 'test_commit_03a B-2'.
self dumpRepositoryLog: repo.
self assert: ((repo @ 3 ) parent1 == (repo @ 1 )).
"=== A modifies & commits =============================== "
(MockHGP1Bar compile:'zork ^ 2' classified:'test') package: MockHGP1Bar package.
ctA := pmA commitTask.
self assert: ctA commitingNewHead not.
ctA message:'test_commit_03a A-3'.
ctA do.
self dumpRepositoryLog: repo.
self assert: ((repo @ 4 ) parent1 == (repo @ 2 )).
"
repo workingCopy browse
"
"Created: / 20-11-2012 / 19:45:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 08-03-2013 / 20:17:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_03b
"
Two images A, B working in parallel, commiting to same repo
1) A: checkout, modify commit package (cs1)
2) B: checkout, commit change (cs2)
3) A: flushes its temp working copy
4) A: modify, checkout (cs3)
The changeset cs3 should have cs1 as its parent1
"
| repo pmA ctA wcB s |
"=== A modifies & commits =============================== "
repo := self repositoryNamed: 'mocks/hg/p1'.
Smalltalk loadPackage:'mocks:hg/p1'.
pmA := HGPackageModel named: 'mocks:hg/p1'.
(MockHGP1Bar compile:'zork ^ 1' classified:'test') package: MockHGP1Bar package.
self deny: ((repo @ 1 / 'MockHGP1Bar.st') contents asString includesString:'zork ^ 1').
ctA := pmA commitTask.
ctA message:'test_commit_03a A-1'.
ctA do.
self assert: ((repo @ 2 / 'MockHGP1Bar.st') contents asString includesString:'zork ^ 1').
self assert: ((repo @ 2 ) parent1 == (repo @ 1 )).
"=== B modifies & commits =============================== "
wcB := repo workingCopy.
s := ( wcB / 'abbrev.stc' ) appendStream.
[ s nextPutLine:'# Modification '] ensure:[s close].
wcB commit: 'test_commit_03a B-2'.
self assert: ((repo @ 3 ) parent1 == (repo @ 1 )).
"=== A flushed its working copy ========================= "
pmA temporaryWorkingCopy path recursiveRemove.
"=== A modifies & commits =============================== "
(MockHGP1Bar compile:'zork ^ 2' classified:'test') package: MockHGP1Bar package.
ctA := pmA commitTask.
ctA message:'test_commit_03a A-3'.
ctA do.
self assert: ((repo @ 4 ) parent1 == (repo @ 2 )).
"
repo workingCopy browse
"
"Created: / 20-11-2012 / 19:51:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-12-2012 / 00:30:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_03c
"
Two images A, B working in parallel, commiting to same repo
(cs1) - base changeset
2) B: checkout, modifu, commit change (cs2)
4) A: checkout, modify, commit change (cs3)
The changeset cs3 should have cs1 as its parent1
"
| repo pmA ctA wcB s |
repo := self repositoryNamed: 'mocks/hg/p1'.
Smalltalk loadPackage:'mocks:hg/p1'.
pmA := HGPackageModel named: 'mocks:hg/p1'.
"=== B modifies & commits =============================== "
wcB := repo workingCopy.
s := ( wcB / 'abbrev.stc' ) appendStream.
[ s nextPutLine:'# Modification '] ensure:[s close].
wcB commit: 'test_commit_03c B-1'.
self assert: ((repo @ 2 ) parent1 == (repo @ 1 )).
"=== A modifies & commits =============================== "
(MockHGP1Bar compile:'zork ^ 2' classified:'test') package: MockHGP1Bar package.
ctA := pmA commitTask.
ctA message:'test_commit_03c A-2'.
ctA do.
self assert: ((repo @ 3 ) parent1 == (repo @ 1 )).
"
repo workingCopy browse
"
"Created: / 20-11-2012 / 20:00:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"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 |
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>"
!
test_commit_05a
"
Setup:
Two repositories: package + upstream repo (package's default).
1) checkout, modify.
2) commit, setup autopush to default remote.
Check whether remote gets updated/
"
| path upstreamP upstream repo pm ct |
path := (self repositoryNamed: 'mocks/hg/p1') path.
upstreamP := repositories add:(Filename newTemporaryDirectory).
path moveTo: (upstreamP / 'upstream').
upstream := HGRepository on: (upstreamP / 'upstream').
repo := upstream cloneTo: path.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
"=== modifyes & commits =============================== "
(MockHGP1Foo compile:'zork ^ 2' classified:'test') package: MockHGP1Foo package.
pm := HGPackageModel named: 'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_05a 1'.
ct remote: repo remoteDefault.
ct do.
self assert: (upstream @ 2) message = 'test_commit_05a 1'.
"
repo workingCopy browse
"
"Created: / 10-12-2012 / 01:58:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_05b
"
Setup:
Two repositories: package + upstream repo (package's default).
1) checkout, modify.
2) modify & commit in upstream
3) commit, setup autopush to default remote.
Check that an exception is raised as commit would create new
head.
"
| path upstreamP upstream repo wc pm ct s |
path := (self repositoryNamed: 'mocks/hg/p1') path.
upstreamP := repositories add:(Filename newTemporaryDirectory).
path moveTo: (upstreamP / 'upstream').
upstream := HGRepository on: (upstreamP / 'upstream').
repo := upstream cloneTo: path.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
"=== modify & commit into upstream ================== "
wc := upstream workingCopy.
[
s := ( wc / 'MockHGP1Foo.st' ) appendStream.
s nextPutLine: 'Just a comment'
] ensure:[
s close
]. wc commit: 'test_commit_05b 1 into upstream'.
"=== modify & commits =============================== "
(MockHGP1Foo compile:'zork ^ 2' classified:'test') package: MockHGP1Foo package.
pm := HGPackageModel named: 'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_05b 2'.
ct remote: repo remoteDefault.
self should: [ ct do ] raise: HGPushWouldCreateNewHeadError
"
repo workingCopy browse
"
"Created: / 10-12-2012 / 02:09:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_06a
"
Test commit into new branch
"
| repo pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
"=== modify & commit =============================== "
(MockHGP1Foo compile:'zork ^ 2' classified:'test') package: MockHGP1Foo package.
pm := HGPackageModel named: 'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_06a 1'.
ct branch:'test_commit_06a'.
self assert: ct commitingNewHead not.
ct do.
"=== check for the branch ========================= "
self assert: (repo branches size == 2).
self assert: (repo @ 2) branches size == 1.
self assert: (repo @ 2) branches anElement name = 'test_commit_06a'.
self assert: (repo workingCopy branch name) = 'test_commit_06a'.
"=== update original wc ========================== "
self assert: ((repo workingCopy / 'MockHGP1Foo.st') contents asString includesString:'zork ^ 2') not.
repo workingCopy update.
self assert: ((repo workingCopy / 'MockHGP1Foo.st') contents asString includesString:'zork ^ 2').
"
repo workingCopy browse
"
"Created: / 10-12-2012 / 03:24:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 08-03-2013 / 20:19:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_06b
"
Test commit into same branch
"
| repo pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
"=== modifyes & commits =============================== "
(MockHGP1Foo compile:'zork ^ 2' classified:'test') package: MockHGP1Foo package.
pm := HGPackageModel named: 'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_06a 1'.
ct branch:'default'.
ct do.
self assert: (repo branches size == 1).
self assert: (repo @ 2) branches size == 1.
self assert: (repo @ 2) branches anElement name = 'default'.
"
repo workingCopy browse
"
"Created: / 10-12-2012 / 03:24:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_06c
"
Test commit into existing branch should raise an error
(theoretically possible, but would be tricky to support :-)
"
| repo pm ct s |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
"=== create the branch beforehand ===================== "
[
s := (repo workingCopy / 'abbrev.stc' ) appendStream.
s cr;cr;cr.
] ensure:[
s close
].
repo workingCopy branch: 'test_commit_06c'.
repo workingCopy commit: 'test_commit_06c into branch test_commit_06c'.
repo workingCopy update: 0.
"=== modify & commit ================================== "
(MockHGP1Foo compile:'zork ^ 2' classified:'test') package: MockHGP1Foo package.
pm := HGPackageModel named: 'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_06a 1'.
ct branch:'test_commit_06c'.
self should: [ ct do] raise: HGCommitError
"
repo workingCopy browse
"
"Created: / 10-12-2012 / 03:28:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 30-06-2013 / 00:51:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_07
"
Tests commit to an empty repository
"
| repo cls pm ct |
repo := self repositoryNamed: 'mocks/hg/p4_empty' unpack: false.
self dumpRepositoryLog: repo.
cls := Object subclass:#MockHGP4_EmptyFoo instanceVariableNames:'' classVariableNames:'' poolDictionaries:''.
cls package: #'mocks:hg/p4_empty'.
(cls compile:'zork ^ 1' classified:'test') package: #'mocks:hg/p4_empty'.
pm := HGPackageModel named: #'mocks:hg/p4_empty'.
ct := pm commitTask.
self assert: ct commitingNewHead not.
ct message:'test_commit_07'.
ct do.
self dumpRepositoryLog: repo.
"
repo workingCopy browse
"
self assert: ((repo @ 0 / 'MockHGP4_EmptyFoo.st') contents asString includesString:'zork ^ 1').
self assert: (Smalltalk at:#mocks_hg_p4_empty) hgLogicalRevision revno = 0.
"Created: / 14-01-2013 / 13:20:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 08-03-2013 / 20:15:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_08
"
Test commit into fresh branch created in repo (but with no
changeset yet)
"
| repo pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
repo workingCopy branch: 'branch_test_commit_08'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
"=== modifyes & commits =============================== "
(MockHGP1Foo compile:'zork ^ 2' classified:'test') package: MockHGP1Foo package.
pm := HGPackageModel named: 'mocks:hg/p1'.
ct := pm commitTask.
self assert: ct commitingNewHead not.
ct message:'test_commit_08 1'.
ct do.
self assert: (repo branches size == 2).
self assert: (repo @ 2) branches size == 1.
self assert: (repo @ 2) branches anElement name = 'branch_test_commit_08'.
"
repo workingCopy browse
pm temporaryWorkingCopy browse.
"
"Created: / 14-01-2013 / 14:14:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 08-03-2013 / 20:14:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_09a
"
Test commit of a new subpackage
"
<skip> "/Not yet supported
| repo cls pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
cls := Object subclass:#MockHGP1_New instanceVariableNames:'' classVariableNames:'' poolDictionaries:''.
cls package: #'mocks:hg/p1/new'.
(cls compile:'zork ^ 1' classified:'test') package: #'mocks:hg/p1/new'.
pm := HGPackageModel named: #'mocks:hg/p1/new'.
ct := pm commitTask.
self assert: ct commitingNewHead not.
ct message:'test_commit_09'.
ct do.
self dumpRepositoryLog: repo.
"
repo workingCopy browse
"
self assert: ((repo @ 2 / 'new' / 'MockHGP1_New.st') contents asString includesString:'zork ^ 1').
self assert: (Smalltalk at:#mocks_hg_p1_new) hgLogicalRevision revno = 2.
"/ self assert: (Smalltalk at:#mocks_hg_p1) hgLogicalRevision revno = 2.
"Created: / 18-03-2013 / 17:21:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 19-03-2013 / 10:02:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_10a
"
Test if project definition class is automatically updated when committing.
Case a: add a new class
"
| repo cls pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
cls := Object subclass:#MockHGP1Baz instanceVariableNames:'' classVariableNames:'' poolDictionaries:''.
cls package: #'mocks:hg/p1'.
(cls compile:'zork ^ 1' classified:'test') package: #'mocks:hg/p1'.
pm := HGPackageModel named: #'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_10a'.
ct doPrepareWorkingCopy.
self assert: ((Smalltalk at: #'mocks_hg_p1') classNamesAndAttributes includes: #MockHGP1Baz).
"
repo workingCopy browse
"
"/ self assert: (Smalltalk at:#mocks_hg_p1) hgLogicalRevision revno = 2.
"Created: / 18-03-2013 / 18:40:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_10b
"
Test if project definition class is automatically updated when committing.
Case b: remove a class
"
| repo pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
Smalltalk removeClass: (Smalltalk at: #MockHGP1Bar).
pm := HGPackageModel named: #'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_10b'.
ct doPrepareWorkingCopy.
self assert: ((Smalltalk at: #'mocks_hg_p1') classNamesAndAttributes includes: #MockHGP1Bar) not.
"Created: / 18-03-2013 / 18:41:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 19-03-2013 / 10:36:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_10c
"
Test if project definition class is automatically updated when committing.
Case c: add an extension
"
| repo pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
(UndefinedObject compile:'zork ^ 1' classified:'test') package: #'mocks:hg/p1'.
pm := HGPackageModel named: #'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_10c'.
ct doPrepareWorkingCopy.
self assert: ((Smalltalk at: #'mocks_hg_p1') extensionMethodNames includes: #zork).
"Created: / 18-03-2013 / 18:42:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 18-03-2013 / 23:01:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_11a
"
Test if commit task detects method protocol changes
"
| repo pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
((Smalltalk at: #MockHGP1Bar) compiledMethodAt: #qux) category: 'new category'.
pm := HGPackageModel named: #'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_11a'.
ct do.
"
repo workingCopy browse
"
self assert: ((repo @ 2 / 'MockHGP1Bar.st') contents asString includesString:'new category').
"Created: / 18-03-2013 / 18:57:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_11b
"
Test if commit task detects class category changes
"
| repo pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
(Smalltalk at: #MockHGP1Bar) category:'new category'.
pm := HGPackageModel named: #'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_11b'.
ct do.
"
repo workingCopy browse
"
self assert: ((repo @ 2 / 'MockHGP1Bar.st') contents asString includesString:'new category').
"Created: / 18-03-2013 / 18:59:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_11c
"
Test if commit task detects class removal
"
| repo pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
Smalltalk removeClass: (Smalltalk at: #MockHGP1Bar).
pm := HGPackageModel named: #'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_11c'.
ct do.
"
repo workingCopy browse
"
self should:[(repo @ 2 / 'MockHGP1Bar.st')] raise: HGError
"Created: / 18-03-2013 / 19:00:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_11d
"
Test if commit task detects method removal
"
| repo pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
(Smalltalk at: #MockHGP1Bar) removeSelector: #'qux'.
pm := HGPackageModel named: #'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_11b'.
ct do.
"
repo workingCopy browse
"
self assert: ((repo @ 2 / 'MockHGP1Bar.st') contents asString includesString:'qux') not
"Created: / 18-03-2013 / 19:01:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 18-03-2013 / 23:05:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_12a
"
Test correct fileout or class with respect to UTF8.
This checks for issue #8.
"
| repo pm ct contents |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
(Smalltalk at: #MockHGP1Bar) compile:'zork
^''Příliš žluťoučký kůň úpěl ďábelské ódy''' classified: 'utf8 methods'.
pm := HGPackageModel named: #'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_12a'.
ct do.
"
repo workingCopy browse
"
contents := (repo @ 2 / 'MockHGP1Bar.st') contents.
self assert: (contents asString includesString:'"{ Encoding: utf8 }"').
self assert: (contents asString includesString:'Příliš žluťoučký kůň úpěl ďábelské ódy') not.
contents := (repo @ 1 / 'MockHGP1Bar.st') contents.
self assert: (contents asString includesString:'"{ Encoding: utf8 }"') not.
"Created: / 22-03-2013 / 09:44:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_12b
"
Test correct fileout of extensions with respect to UTF8.
This checks for issue #8.
"
| repo pm ct contents |
"Hack for rel 6.2.2 - due to a bug in fileout,
non-UTF8 characters are not supported.
Should use 'self skipIf: ... ' but this is not
supported by 6.2.2's SUnit..."
(Smalltalk versionString = '6.2.2') ifTrue:[ ^ self ].
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
((UndefinedObject) compile:'zork
^''Příliš žluťoučký kůň úpěl ďábelské ódy''' classified: 'utf8 methods')
package: #'mocks:hg/p1'.
pm := HGPackageModel named: #'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_12b'.
ct do.
"
repo workingCopy browse
"
contents := (repo @ 2 / 'extensions.st') contents.
self assert: (contents asString includesString:'"{ Encoding: utf8 }"').
self assert: (contents asString includesString:'Příliš žluťoučký kůň úpěl ďábelské ódy') not.
"Created: / 22-03-2013 / 09:46:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_12c
"
Test correct fileout of extensions with respect to UTF8.
This checks for issue #8.
"
| repo pm ct contents |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
((UndefinedObject) compile:'zork
^''XUZ''' classified: 'utf8 methods')
package: #'mocks:hg/p1'.
pm := HGPackageModel named: #'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_12b'.
ct do.
"
repo workingCopy browse
"
contents := (repo @ 2 / 'extensions.st') contents.
self assert: (contents asString includesString:'"{ Encoding: utf8 }"') not.
"Created: / 22-03-2013 / 10:13:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_13a
"
Test commit without package model.
This checks for issue #7.
"
| repo wc ct currentcs |
repo := self repositoryNamed:'test_repo_01'.
"
UserPreferences fileBrowserClass openOn: repo directory.
"
wc := repo workingCopy.
"Modify some file"
(wc / 'f1.txt') writingFileDo:[:s | s nextPutAll:'modified from test_01a'. ].
ct := wc commitTask.
ct do.
currentcs := wc changeset.
self assert:currentcs id revno == 5.
"Created: / 01-04-2013 / 13:04:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_13b
"
Test commit without package model of a working copy after merge.
"
| repo wc ct |
repo := self repositoryNamed:'mocks/hg/p3'.
wc := repo workingCopy.
wc update: 2.
wc merge: (repo @ 1).
(wc root / 'Make.spec') markResolved.
(wc root / 'abbrev.stc') markResolved.
(wc root / 'bc,mak') markResolved.
(wc root / 'mocks_hg_p3.st') markResolved.
(wc root / 'p3.rc') markResolved.
(wc root / 'MockHGP3Foo.st') markResolved.
"
UserPreferences fileBrowserClass openOn: repo pathName.
"
ct := wc commitTask.
ct do.
"Created: / 01-04-2013 / 13:23:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_14a
"
Test if container is removed if class is removed.
"
| repo pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
Smalltalk removeClass: (Smalltalk at: #MockHGP1Bar).
pm := HGPackageModel named: #'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_14a'.
ct do.
self shouldnt: [ repo @ 1 / 'MockHGP1Bar.st' ] raise: HGError.
self should: [ repo @ 2 / 'MockHGP1Bar.st' ] raise: HGError.
"Created: / 21-05-2013 / 16:24:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_14b
"
Test if container is removed if class is removed but not if package
specifies #hgRemoveContainesForDeletedClasses
"
| repo pm ct |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage: 'mocks:hg/p1').
(Smalltalk at: #mocks_hg_p1) class compile: 'hgRemoveContainesForDeletedClasses ^false' classified: 'accessing - hg'.
Smalltalk removeClass: (Smalltalk at: #MockHGP1Bar).
pm := HGPackageModel named: #'mocks:hg/p1'.
ct := pm commitTask.
ct message:'test_commit_14b'.
ct do.
self shouldnt: [ repo @ 1 / 'MockHGP1Bar.st' ] raise: HGError.
self shouldnt: [ repo @ 2 / 'MockHGP1Bar.st' ] raise: HGError.
"Created: / 21-05-2013 / 16:47:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_15a
"
Test creation of deeply nested packages
1) load mocks:hg/p2/n2
2) create class in mocks:hg/p2/n2_2
3) commit
"
| repo pmN22 ctN22 |
repo := self repositoryNamed: 'mocks/hg/p2'.
self assert: (Smalltalk loadPackage:'mocks:hg/p2/n2').
Object subclass:#MocksHgP2N22Foo
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'* Mocks *'.
(Smalltalk at:#MocksHgP2N22Foo) package: #'mocks:hg/p2/n2/n2_2'.
pmN22 := HGPackageModel named: #'mocks:hg/p2/n2/n2_2'.
ctN22 := pmN22 commitTask.
ctN22 message:'test_commit_15a 1'.
ctN22 do.
"
repo workingCopy browse
"
"Created: / 10-06-2013 / 23:28:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_15b
"
Test creation of deeply nested packages
1) load mocks:hg/p2/n1/n1_1/n_1_1_1
2) create class in mocks:hg/p2/n1/n1_1/n_1_1_1
3) commit
"
| repo pmN111 ctN111 |
repo := self repositoryNamed: 'mocks/hg/p2'.
self assert: (Smalltalk loadPackage:'mocks:hg/p2/n1').
Object subclass:#MocksHgP2N111Foo
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'* Mocks *'.
(Smalltalk at:#MocksHgP2N111Foo) package: #'mocks:hg/p2/n1/n1_1/n_1_1_1'.
pmN111 := HGPackageModel named: #'mocks:hg/p2/n1/n1_1/n_1_1_1'.
ctN111 := pmN111 commitTask.
ctN111 message:'test_commit_15b 1'.
ctN111 do.
"
repo workingCopy browse
"
"Created: / 11-06-2013 / 00:16:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGStXTests methodsFor:'tests - manager API'!
test_log_01
| log repo |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage:'mocks:hg/p1').
log := HGSourceCodeManager
revisionLogOf:MockHGP1Bar
fromRevision:0 toRevision:0
numberOfRevisions:nil
fileName:'MockHGP1Bar.st'
directory: 'hg/p1'
module:'mocks'.
self assert: (log at: #container) = 'MockHGP1Bar.st'.
self assert: (log at: #cvsRoot) = repo pathName.
self assert: (log at: #newestRevision) = '1:e0bec585af86'.
self assert: (log at: #revisions) size == 1.
"Created: / 04-12-2012 / 01:07:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_log_02
| log repo |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage:'mocks:hg/p1').
log := HGSourceCodeManager
revisionLogOf:MockHGP1Bar
fromRevision:nil toRevision:nil
numberOfRevisions:nil
fileName:'MockHGP1Bar.st'
directory: 'hg/p1'
module:'mocks'.
self assert: (log at: #container) = 'MockHGP1Bar.st'.
self assert: (log at: #cvsRoot) = repo pathName.
self assert: (log at: #newestRevision) = '1:e0bec585af86'.
self assert: (log at: #revisions) size == 2.
self assert: ((log at: #revisions) first at:#revision) = '1:e0bec585af86'.
self assert: ((log at: #revisions) second at:#revision) = '0:99acfa83a3bf'.
"Created: / 04-12-2012 / 01:26:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_log_03
| log repo |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage:'mocks:hg/p1').
log := HGSourceCodeManager
revisionLogOf:MockHGP1Bar
fromRevision:nil toRevision:nil
numberOfRevisions:1
fileName:'MockHGP1Bar.st'
directory: 'hg/p1'
module:'mocks'.
self assert: (log at: #container) = 'MockHGP1Bar.st'.
self assert: (log at: #cvsRoot) = repo pathName.
self assert: (log at: #newestRevision) = '1:e0bec585af86'.
self assert: (log at: #revisions) size == 1.
self assert: ((log at: #revisions) first at:#revision) = '1:e0bec585af86'.
"Created: / 04-12-2012 / 01:31:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_log_04a
| log repo |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage:'mocks:hg/p1').
log := HGSourceCodeManager
revisionLogOf:MockHGP1Bar
fromRevision:'1:e0bec585af86' toRevision:nil
numberOfRevisions:nil
fileName:'MockHGP1Bar.st'
directory: 'hg/p1'
module:'mocks'.
self assert: (log at: #container) = 'MockHGP1Bar.st'.
self assert: (log at: #cvsRoot) = repo pathName.
self assert: (log at: #newestRevision) = '1:e0bec585af86'.
self assert: (log at: #revisions) size == 2.
self assert: ((log at: #revisions) first at:#revision) = '1:e0bec585af86'.
self assert: ((log at: #revisions) second at:#revision) = '0:99acfa83a3bf'.
"Created: / 04-12-2012 / 01:32:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_log_04b
| log repo |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage:'mocks:hg/p1').
log := HGSourceCodeManager
revisionLogOf:MockHGP1Bar
fromRevision:'1:e0bec585af86' toRevision:'0:99acfa83a3bf'
numberOfRevisions:nil
fileName:'MockHGP1Bar.st'
directory: 'hg/p1'
module:'mocks'.
self assert: (log at: #container) = 'MockHGP1Bar.st'.
self assert: (log at: #cvsRoot) = repo pathName.
self assert: (log at: #newestRevision) = '1:e0bec585af86'.
self assert: (log at: #revisions) size == 2.
self assert: ((log at: #revisions) first at:#revision) = '1:e0bec585af86'.
self assert: ((log at: #revisions) second at:#revision) = '0:99acfa83a3bf'.
"Created: / 04-12-2012 / 01:32:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_log_04c
| log repo |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage:'mocks:hg/p1').
log := HGSourceCodeManager
revisionLogOf:MockHGP1Bar
fromRevision:nil toRevision:'0:99acfa83a3bf'
numberOfRevisions:nil
fileName:'MockHGP1Bar.st'
directory: 'hg/p1'
module:'mocks'.
self assert: (log at: #container) = 'MockHGP1Bar.st'.
self assert: (log at: #cvsRoot) = repo pathName.
self assert: (log at: #newestRevision) = '1:e0bec585af86'.
self assert: (log at: #revisions) size == 2.
self assert: ((log at: #revisions) first at:#revision) = '1:e0bec585af86'.
self assert: ((log at: #revisions) second at:#revision) = '0:99acfa83a3bf'.
"Created: / 04-12-2012 / 01:32:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_log_04d
| log repo |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage:'mocks:hg/p1').
log := HGSourceCodeManager
revisionLogOf:MockHGP1Bar
fromRevision:'0:99acfa83a3bf' toRevision:'0:99acfa83a3bf'
numberOfRevisions:nil
fileName:'MockHGP1Bar.st'
directory: 'hg/p1'
module:'mocks'.
self assert: (log at: #container) = 'MockHGP1Bar.st'.
self assert: (log at: #cvsRoot) = repo pathName.
self assert: (log at: #newestRevision) = '1:e0bec585af86'.
self assert: (log at: #revisions) size == 1.
self assert: ((log at: #revisions) first at:#revision) = '0:99acfa83a3bf'.
"Created: / 04-12-2012 / 01:33:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_stream_01a
| stream repo contents |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage:'mocks:hg/p1').
stream := HGSourceCodeManager
streamForClass:MockHGP1Bar
fileName:'MockHGP1Bar.st'
revision: '0:99acfa83a3bf'
directory: 'hg/p1'
module:'mocks'
cache: false.
contents := stream contents.
self assert: contents first = '"{ Package: ''mocks/hg/p1'' }"'
"Created: / 04-12-2012 / 02:04:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_stream_01b
| stream repo contents |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage:'mocks:hg/p1').
stream := HGSourceCodeManager
streamForClass:MockHGP1Bar
fileName:'MockHGP1Bar.st'
revision: '1:e0bec585af86'
directory: 'hg/p1'
module:'mocks'
cache: false.
contents := stream contents.
self assert: contents first = '"{ Package: ''mocks:hg/p1'' }"'
"Created: / 04-12-2012 / 02:05:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_stream_02a
| stream repo contents |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage:'mocks:hg/p1').
stream := HGSourceCodeManager
streamForClass:MockHGP1Bar
fileName:'MockHGP1Bar.st'
revision: '0:99acfa83a3bf'
directory: 'hg/p1'
module:'mocks'
cache: true.
contents := stream contents.
self assert: contents first = '"{ Package: ''mocks/hg/p1'' }"'.
self assert: stream isFileStream.
stream := HGSourceCodeManager
streamForClass:MockHGP1Bar
fileName:'MockHGP1Bar.st'
revision: '0:99acfa83a3bf'
directory: 'hg/p1'
module:'mocks'
cache: true.
contents := stream contents.
self assert: contents first = '"{ Package: ''mocks/hg/p1'' }"'.
self assert: stream isFileStream.
"Created: / 04-12-2012 / 02:08:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-12-2012 / 10:12:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_stream_02b
| stream repo contents |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage:'mocks:hg/p1').
stream := HGSourceCodeManager
streamForClass:MockHGP1Bar
fileName:'MockHGP1Bar.st'
revision: '1:e0bec585af86'
directory: 'hg/p1'
module:'mocks'
cache: true.
[
contents := stream contents.
] ensure: [
stream close
].
self assert: contents first = '"{ Package: ''mocks:hg/p1'' }"'
"Created: / 04-12-2012 / 10:11:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_stream_02c
| stream repo |
repo := self repositoryNamed: 'mocks/hg/p1'.
(repo pathName asFilename / '.hg' ) recursiveRemove.
self assert: (Smalltalk loadPackage:'mocks:hg/p1').
stream := HGSourceCodeManager
streamForClass:MockHGP1Bar
fileName:'MockHGP1Bar.st'
revision: '0:99acfa83a3bf'
directory: 'hg/p1'
module:'mocks'
cache: true.
self assert: stream isNil.
"Created: / 27-03-2013 / 11:11:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_stream_03a
| stream repo contents |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage:'mocks:hg/p1').
(Smalltalk at:#MockHGP1Bar) setBinaryRevision: '$Changeset: e0bec585af86b3ee98047baa69530b2b2484c9c0 $ SCM=HG'.
stream := HGSourceCodeManager getSourceStreamFor:(Smalltalk at:#MockHGP1Bar).
[
contents := stream contents.
] ensure: [
stream close
].
self assert: contents first = '"{ Package: ''mocks:hg/p1'' }"'
"Created: / 18-03-2013 / 16:58:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_stream_04a
"
Tests of extension stream
"
| stream repo contents |
repo := self repositoryNamed: 'mocks/hg/p4'.
self assert: (Smalltalk loadPackage:'mocks:hg/p4').
stream := HGSourceCodeManager streamForExtensionFile:'extensions.st' package: 'mocks:hg/p4' directory: 'hg/p4' module: 'mocks' cache: false.
[
contents := stream contents.
] ensure: [
stream close
].
self assert: contents first = '"{ Package: ''mocks:hg/p4'' }"!!'
"Created: / 27-03-2013 / 11:37:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGStXTests methodsFor:'tests - misc'!
test_misc_fileReleaseAndRevisionNr
"
ProjectDefinition>>fileReleaseNr and ProjectDefinition>>fileRevisionNr
are used to generate package.rc used on Windows.
String returned must be an integer and must be a valid short value
- otherwise, BCC won't compile/link the library.
If this test fail it means that implementation fileReleaseNr/fileRevisionNr
is rubbish. As of 2012-11-23, it uses 'self revision' and expects
(but does not check!!) the resulting string is in X.Y form. In mercurial,
#revision returns node id (SHA1 hash string).
It has to be fixed there!!
"
| repo |
repo := self repositoryNamed: 'mocks/hg/p1'.
Smalltalk loadPackage:'mocks:hg/p1'.
self assert: ((Smalltalk at:#'mocks_hg_p1') fileReleaseNr allSatisfy:[:c|c isDigit]).
self assert: ((Smalltalk at:#'mocks_hg_p1') fileReleaseNr asInteger < 16r7FFF).
self assert: ((Smalltalk at:#'mocks_hg_p1') fileRevisionNr allSatisfy:[:c|c isDigit]).
self assert: ((Smalltalk at:#'mocks_hg_p1') fileRevisionNr asInteger < 16r7FFF).
"Created: / 23-11-2012 / 11:02:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_misc_hgRevision_01
| repo |
repo := self repositoryNamed: 'mocks/hg/p1'.
Smalltalk loadPackage:'mocks:hg/p1'.
self dumpRepositoryLog: repo.
self assert: (Smalltalk at:#'mocks_hg_p1') hgLogicalRevision = (HGChangesetId fromString: '1:e0bec585af86').
"Created: / 23-11-2012 / 11:00:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 16-05-2013 / 13:18:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_misc_packagemodel_01
| repo pm |
repo := self repositoryNamed: 'mocks/hg/p1'.
Smalltalk loadPackage:'mocks:hg/p1'.
pm := HGPackageModel named: 'mocks:hg/p1'.
self assert: pm parent == nil.
"Created: / 03-12-2012 / 15:45:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_misc_packagemodel_02
| repo pmP2 pmP2N1|
repo := self repositoryNamed: 'mocks/hg/p2'.
Smalltalk loadPackage:'mocks:hg/p1'.
pmP2 := HGPackageModel named: 'mocks:hg/p2'.
pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
self assert: pmP2 parent isNil.
self assert: pmP2N1 parent == pmP2.
self assert: (pmP2 construct:'n1') == pmP2N1
"Created: / 03-12-2012 / 15:46:55 / 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'.
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>"
!
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'.
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:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGStXTests methodsFor:'utilities'!
cleanup
"Wipeout all mock package leftovers. Could be used
to simulate work from another fresh image"
self tearDown
"Created: / 20-11-2012 / 19:32:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGStXTests class methodsFor:'documentation'!
version_HG
^ '$Changeset: <not expanded> $'
! !