"{ Package: 'stx:libscm/mercurial' }"

HGTestCase subclass:#HGStXTests

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'SCM-Mercurial-Tests'

!

!HGStXTests class methodsFor:'documentation'!

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: cls]].

            cls class methodsDo:[:m|(m package notNil and:[m package startsWith:'mocks']) ifTrue:[methods add: cls]].

        ]

    ].

    Class withoutUpdatingChangesDo:[ 

        classes do:[:cls|Smalltalk removeClass: cls].

        methods do:[:m|m mclass removeSelector: m selector]

    ].

    "Created: / 16-11-2012 / 19:00:24 / 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').

    self tearDown.

    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>"

! !

!HGStXTests methodsFor:'tests - commit'!

test_commit_01

    "

        Simple commit

    "

    | repo pm ct |

    repo := self repositoryNamed: 'mocks/hg/p1'.

    Smalltalk loadPackage:'mocks:hg/p1'.

    MockHGP1Bar compile:'zork ^ 1' classified:'test'.

    pm := HGPackageModel named: 'mocks:hg/p1'.

    ct := pm commitTask.

    ct message:'test_commit_01'.

    ct do.

    "Created: / 16-11-2012 / 18:51:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 16-11-2012 / 20:26:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGStXTests class methodsFor:'documentation'!

version_HG

    "Never, ever change this method. Ask JV or CG why"

    ^thisContext method mclass theNonMetaclass instVarNamed: #revision

! !