Fix for issue #26: Java extension files are removed.
"{ Encoding: utf8 }"
"
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/mercurial' }"
HGTestCase subclass:#HGStXTests
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'SCM-Mercurial-Tests'
!
!HGStXTests 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
"
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 |
^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:
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
"
| 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: / 03-07-2013 / 19:13:25 / 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')
package: (Smalltalk at: #MockHGP1Bar) package.
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>"
"Modified: / 12-09-2013 / 15:51:24 / 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>"
!
test_commit_16a
"
Test correct fileout if Java extensions
"
| repo pmN111 ctN111 java_lang_String changeset |
repo := self repositoryNamed: 'mocks/hg/p5'.
self assert: (Smalltalk loadPackage:'mocks:hg/p5').
"/ Do skipIf after package is loaded!!!!!! otherwise the
"/ Java extension is not loaded!!
self skipIf: self stxlibjavaAvailable not description: 'STX:LIBJAVA not available'.
java_lang_String := Java classForName: 'java.lang.String'.
(Compiler compile:'test_commit_16a ^ #foo' forClass: java_lang_String)
package:#'mocks:hg/p5'.
self assert: (java_lang_String methodDictionary includesKey:#test_commit_16a).
pmN111 := HGPackageModel named: #'mocks:hg/p5'.
ctN111 := pmN111 commitTask.
ctN111 message:'test_commit_16a '.
ctN111 do.
"
repo workingCopy browse
"
changeset := repo @ 2.
self assert: (changeset changes contains:[:change | change isAdded ]).
self deny: (changeset changes contains:[:change | change isRemoved ]).
self assert: (changeset / 'java' / 'extensions' / 'java' / 'lang' / 'String.st' ) notNil.
"Created: / 29-11-2013 / 16:25:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_commit_16b
"
Test covering issue #26: Java extension files are removed.
Check, that if the particular class is not loaded in the system,
extension file is kept intact.
"
| repo pmN111 ctN111 changeset |
repo := self repositoryNamed: 'mocks/hg/p5'.
self assert: (Smalltalk loadPackage:'mocks:hg/p5').
"/ Do skipIf after package is loaded!!!!!! otherwise the
"/ Java extension is not loaded!!
self skipIf: self stxlibjavaAvailable not description: 'STX:LIBJAVA not available'.
"/ Flush Java to make sure java.lang.Object is not loaded.
(Smalltalk at:#Java) flushAllJavaResources.
pmN111 := HGPackageModel named: #'mocks:hg/p5'.
ctN111 := pmN111 commitTask.
ctN111 message:'test_commit_16a '.
ctN111 do.
"
repo workingCopy browse
"
changeset := repo @ 2.
self deny: (changeset changes contains:[:change | change isAdded ]).
self deny: (changeset changes contains:[:change | change isRemoved ]).
self assert: (changeset / 'java' / 'extensions' / 'java' / 'lang' / 'Object.st' ) notNil.
"Created: / 29-11-2013 / 17:34:57 / 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_01c
| stream repo contents |
repo := self repositoryNamed: 'mocks/hg/p1'.
self assert: (Smalltalk loadPackage:'mocks:hg/p1').
stream := HGSourceCodeManager
streamForClass:MockHGP1Bar
fileName:'MockHGP1Bar.st'
revision: #newest
directory: 'hg/p1'
module:'mocks'
cache: false.
contents := stream contents.
self assert: contents first = '"{ Package: ''mocks:hg/p1'' }"'
"Created: / 09-07-2013 / 15:26:49 / 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>"
!
test_stream_04b
"
Tests of extension stream
"
| stream repo contents |
Class tryLocalSourceFirst:false.
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: / 08-07-2013 / 02:20:13 / 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>"
!
stxlibjavaAvailable
"raise an error: this method should be implemented (TODO)"
(Smalltalk at:#JavaVM) isNil ifTrue:[
Smalltalk loadPackage:'stx:libjava'.
].
(Smalltalk at:#JavaVM) isNil ifTrue:[
^ false
].
(Smalltalk at:#Java) isNil ifTrue:[
^ false
].
^ [
(Smalltalk at:#JavaVM) booted ifTrue:[
"/ Sorry, flush it...
(Smalltalk at:#Java) flushAllJavaResources.
].
"/ Opps, workaround - have to nil out Java:ExtensionsPathPackages
Smalltalk at: #'Java:ExtensionsPathPackages' put: nil.
"/ Now, initialize ot..."
(Smalltalk at:#Java) initialize.
(Smalltalk at:#JavaVM) initializeVM.
true.
] on:Error do:[:ex | false ]
"Created: / 29-11-2013 / 16:21:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 29-11-2013 / 17:30:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGStXTests class methodsFor:'documentation'!
version_HG
^ '$Changeset: <not expanded> $'
! !