"

 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 |