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

HGTestCase subclass:#HGTests

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'SCM-Mercurial-Tests'

!

!HGTests class methodsFor:'documentation'!

documentation

"

    Tests for core Mercurial code - no Smalltalk/X specific code.

    Commiting, cloning, walking history and so on...

    [author:]

        Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

"

! !

!HGTests methodsFor:'tests - basic workflow'!

test_basic_01a

    "Test modification of working copy and commit back"

    | repo  wc  f1_txt  oldcs  currentcs |

    repo := self repositoryNamed:'test_repo_01'.

     "

     UserPreferences fileBrowserClass openOn: repo directory.

    "

    wc := repo workingCopy.

    oldcs := wc changeset.

    self assert:oldcs id revno == 4.

     "Modify some file"

    f1_txt := wc / 'f1.txt'.

    self assert:f1_txt isModified not.

    f1_txt writingFileDo:[:s | s nextPutAll:'modified from test_01a'. ].

    self assert:f1_txt isModified.

    wc commit:'test_01a commit 1'.

    currentcs := wc changeset.

    self assert:f1_txt isModified not.

    self assert:currentcs id revno == 5.

    self assert:currentcs parent1 = oldcs.

    self assert:currentcs author = 'test_basic_01a <test_basic_01a@HGTests>'

    "Created: / 19-09-2012 / 23:06:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 22-11-2012 / 11:42:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGTests methodsFor:'tests - branches'!

test_branches_01

    "

    Test listing branches

    "

    | repo branches |

    repo := self repositoryNamed:'test_repo_02'.

    branches := repo branches.

    self assert: branches first name = 'default'.

    self assert: branches first isActive.

    self assert: branches first isClosed not.

    self assert: branches second name = 'branch1'.

    self assert: branches second isActive not.

    self assert: branches second isClosed not.

    self assert: branches third name = 'branch2'.

    self assert: branches third isActive.

    self assert: branches third isClosed.

    "Created: / 27-11-2012 / 19:50:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_branches_02

    "

    Test getting current branch (branch of currently checked-out working copy)

    "

    | repo wc branch |

    repo := self repositoryNamed:'test_repo_02'.

    wc := repo workingCopy.

    branch := wc branch.

    self assert: branch name = 'default'.

    self assert: wc changeset branch == branch.

    "Created: / 27-11-2012 / 20:44:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_branches_03

    "

    Test listing branches

    "

    | repo branches |

    repo := self repositoryNamed:'test_repo_02'.

    branches := repo branches.

    self assert: branches first heads size == 1.

    self assert: branches first heads anElement id revno == 5.

    self assert: branches second heads size == 1.

    self assert: branches second heads anElement id revno == 4.

    "Created: / 27-11-2012 / 21:40:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_branches_04

    "

    Change branch & commit. Check whether commited changeset

    has the branch set.

    "

    | repo wc |

    repo := self repositoryNamed:'test_repo_01'.

    wc := repo workingCopy.

    self assert: repo branches size == 1.

    wc branch: 'test_branches_04'.

    "Modify some file"

    (wc / 'f1.txt') writingFileDo:[:s | s nextPutAll:'modified...' ].

    wc commit:'test_branches_04 1'.

    self assert: wc changeset branches size == 1.

    self assert: wc changeset branches anElement name = 'test_branches_04'.

    self assert: repo branches size == 2.

    "Created: / 10-12-2012 / 03:10:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_branches_05

    "

    Freshly created repository should have 'default' branch

    "

    | repo branches |

    repo := self repositoryNamed:'test_repo_empty' unpack: false.

    branches := repo branches.

    self assert: branches size == 1.

    self assert: branches anElement name = 'default'

    "Created: / 14-01-2013 / 14:08:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGTests methodsFor:'tests - changesets'!

test_changeset_01

    "

    Test accessing changesets

    "

    | repo cs |

    repo := self repositoryNamed:'test_repo_01'.

    cs := repo @ 4.

    self assert: cs id printString = '4:6f88e1f44d9e'.

    cs := repo @ '4:6f88e1f44d9eb86e0b56ca15e30e5d786acd83c7'.

    self assert: cs id printString = '4:6f88e1f44d9e'.

    cs := repo @ '4:6f88e1f44d9e'.

    self assert: cs id printString = '4:6f88e1f44d9e'.

    "Created: / 16-11-2012 / 21:03:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 30-11-2012 / 23:34:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_changeset_02

    "

    Tests identity if changesets (cacheing)

    "    

    | repo cs1 cs2 |

    repo := self repositoryNamed:'test_repo_01'.

    cs1 := repo @ 4.

    cs2 := repo @ 4.

    self assert: cs1 == cs2.

    cs2 := repo @ '4:6f88e1f44d9eb86e0b56ca15e30e5d786acd83c7'.

    self assert: cs1 == cs2.

    cs2 := repo @ '4:6f88e1f44d9e'.

    self assert: cs1 == cs2.

    "Created: / 16-11-2012 / 22:10:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_changeset_03

    "

    Test walking history though parents

    "

    | repo cs0 cs1 cs2 cs3 |

    repo := self repositoryNamed:'test_repo_01'.

    cs0 := repo @ 0.

    cs1 := repo @ 1.

    cs2 := repo @ 2.

    cs3 := repo @ 3.

    self assert: cs3 parent1 == cs2.

    self assert: cs3 parent2 isNil.

    self assert: cs2 parent1 == cs1.

    self assert: cs2 parent2 isNil.

    self assert: cs1 parent1 == cs0.

    self assert: cs1 parent2 isNil.

    self assert: cs0 parent1 isNil.

    self assert: cs0 parent2 isNil.

    "Created: / 16-11-2012 / 22:14:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_changeset_04

    "

    Test access to changeset contents

    "

    | repo cs |

    repo := self repositoryNamed:'test_repo_01'.

    cs := repo @ 1.

    self assert: cs root children size == 2.

    self assert: (cs root / 'b') children size == 2.

    self assert: (cs root / 'b') parent == cs root.

    self assert: (cs root / 'f1.txt') children size == 0.

    self should: [cs root / 'abraka'] raise: HGError.

    self should: [cs root / 'c' / 'abraka'] raise: HGError.

    "Created: / 16-11-2012 / 22:38:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 17-11-2012 / 00:23:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_changeset_05

    "

    Test access to changeset contents

    "

    | repo |

    repo := self repositoryNamed:'test_repo_01'.

    self assert: (repo @ 0 / 'f1.txt') contents asString = 'f1-C0

'.

    self assert: (repo @ 1 / 'f1.txt') contents asString = 'f1-C0

f1-C1

'

    "Created: / 17-11-2012 / 00:19:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_changeset_06

    "

    Test access to changeset contents

    "

    | repo cs |

    repo := self repositoryNamed:'test_repo_02'.

    cs := repo @ 5.

    self assert: cs parent1 id revno = 0.

    self assert: cs parent2 id revno = 4.

    "Created: / 27-11-2012 / 20:54:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_changeset_07

    "

    Test accessing changesets

    "

    | repo cs0 cs1 |

    repo := self repositoryNamed:'test_repo_01'.

    cs0 := repo @ 0.

    cs1 := repo @ 1.

    self assert: cs0 children size == 1.

    self assert: (cs0 children includesIdentical: cs1).

    "Created: / 05-12-2012 / 17:41:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGTests methodsFor:'tests - commit'!

test_commit_02

    "

                    base    (r4)

        1) modify & commit  (r5)

        2) update wc to r4

        3) modifty & commit (r6)

        check:  i) before 1) only one head r4

                ii) after 3) two heads r5, r6, both with parent r4

    "

    | repo wc heads |

    repo := self repositoryNamed:'test_repo_01'.

    wc := repo workingCopy. 

    heads := wc heads.

    self assert: wc changeset id revno == 4.

    self assert: heads size == 1.

    self assert: heads anElement id revno = 4.

    ( wc / 'f1.txt' ) writingFileDo:[:s | s nextPutAll:'modified from test_commit_02 1'. ].

    wc commit:'test_commit_02 commit 1'.

    wc update: 4.

    self assert: wc changeset id revno == 4.

    ( wc / 'f1.txt' ) writingFileDo:[:s | s nextPutAll:'modified from test_commit_02 2'. ].

    wc commit:'test_commit_02 commit 2'.

    heads := wc heads.

    self assert: heads size == 2.

    self assert: heads first parent1 == (repo @ 4).

    self assert: heads second parent1 == (repo @ 4).

     "

     UserPreferences fileBrowserClass openOn: repo directory.

    "

    "Created: / 27-11-2012 / 10:36:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 27-11-2012 / 21:53:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_commit_03

    "

    Commit without configured author should raise an error

    "

    | repo wc |

    repo := self repositoryNamed:'test_repo_01'.

    wc := repo workingCopy. 

    ( wc / 'f1.txt' ) writingFileDo:[:s | s nextPutAll:'modified from test_commit_02 2'. ].

    "Now, fake missing ui.username config entry"

    (repo config root includesKey: #ui) ifTrue:[

        (repo config get:#ui) removeKey: #username ifAbsent:[nil].

    ].

    "Try commit"

    HGAuthorQuery answer: nil do:["/See HGtestCase>>performCase

    self should:[wc commit:'test_commit_03 commit 1'] raise: HGCommitError

    ]

     "

     UserPreferences fileBrowserClass openOn: repo directory.

    "

    "Created: / 07-12-2012 / 15:42:52 / jv"

    "Modified (comment): / 10-12-2012 / 03:08:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGTests methodsFor:'tests - misc'!

test_config_01

    "

    Test listing repository heads

    "

    | repo1 repo2  |

    repo1 := self repositoryNamed:'test_repo_02'.

    repo2 := repo1 cloneTo: (repositories add: (Filename newTemporaryDirectory / 'repo') pathName).

    self assert: ((repo2 config get: 'paths') get: 'default') = repo1 pathName.

    "Created: / 06-12-2012 / 21:42:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_config_02

    "

    Test listing repository heads

    "

    | repo1 |

    repo1 := self repositoryNamed:'test_repo_02'.

    self assert: (repo1 config get: #('foo' 'bar') default: nil) isNil.

    Delay waitForSeconds: 1.

    (repo1 path / '.hg' / 'hgrc') appendingFileDo:[:s|

        s nextPutLine:'[foo]'.

        s nextPutLine:'bar = baz'.

    ].

    self assert: (repo1 config get: #('foo' 'bar') default: nil) = 'baz'.

    "Created: / 09-12-2012 / 23:01:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_heads_01

    "

    Test listing repository heads

    "

    | repo heads |

    repo := self repositoryNamed:'test_repo_02'.

    heads := repo heads.