"

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

TestCase subclass:#HGTestCase

	instanceVariableNames:'repositories hgScmEnabled scm scmPerPackage tryLocalSourceFirst'

	classVariableNames:'Verbose'

	poolDictionaries:''

	category:'SCM-Mercurial-Tests'

!

!HGTestCase 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

"

    An anbstract base class for Mercurial tests

    [author:]

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

    [instance variables:]

    [class variables:]

    [see also:]

"

! !

!HGTestCase class methodsFor:'accessing'!

resources

    ^Array with: HGRepositoriesResource

    "Created: / 19-09-2012 / 18:55:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 17-10-2012 / 13:01:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGTestCase class methodsFor:'testing'!

isAbstract

    ^self == HGTestCase

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

! !

!HGTestCase methodsFor:'asserting'!

should: block raise: error withMessage: msg

    <resource: #skipInDebuggersWalkBack>

    ^self should: block raise: error suchThat: [:ex|

	ex description = msg

	].

    "Created: / 04-02-2013 / 11:13:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (format): / 04-02-2013 / 12:35:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGTestCase methodsFor:'debugging'!

dumpRepositoryLog: repo

    ^self dumpRepositoryLog: repo on: Transcript sender: thisContext sender

    "Created: / 22-11-2012 / 11:08:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

dumpRepositoryLog: repo on: stream

    self dumpRepositoryLog: repo on: stream sender: thisContext sender.

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

!

dumpRepositoryLog: repo on: stream sender: sender

    Verbose == true ifFalse:[ ^ self ].

    stream cr.

    stream nextPutAll: '+-- hg log '; nextPutAll: repo pathName; nextPutAll:' -- '; cr.

    stream nextPutAll: '+-- sender: '; nextPutAll: sender printString ; nextPutAll:' -- '; cr.

    (OperatingSystem getFullCommandOutputFrom:'hg log ', repo pathName) do:[:line|

	stream nextPutAll:'| '; nextPutAll: line; cr.

    ].

    stream nextPutAll: '+------------- '; cr.

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

! !

!HGTestCase methodsFor:'private'!

performTest

    HGAuthorQuery answer: (testSelector , ' <', testSelector , '@', self class name, '>') do:[

    ].

    "Created: / 30-09-2012 / 10:02:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGTestCase methodsFor:'running'!

setUp

    scm := false.

    hgScmEnabled := HGSourceCodeManager shownInBrowserMenus.

    scm := (Smalltalk at:#SourceCodeManager).

    scmPerPackage := AbstractSourceCodeManager managerPerMatchingModuleDefinitions.

    AbstractSourceCodeManager managerPerMatchingModuleDefinitions: scmPerPackage copy.

    AbstractSourceCodeManager managerPerMatchingModuleDefinitions addFirst:

        (AbstractSourceCodeManager::PackageAndManager package:'mocks:hg*' manager:HGSourceCodeManager).

    scm isNil ifTrue:[ Smalltalk at: #SourceCodeManager put: HGSourceCodeManager].            

    tryLocalSourceFirst := Class tryLocalSourceFirst.

    Class tryLocalSourceFirst:true.

    HGSourceCodeManager shownInBrowserMenus: true.

    repositories:= OrderedCollection new.

    "Created: / 19-09-2012 / 19:01:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 09-07-2013 / 15:12:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

tearDown

    HGSourceCodeManager shownInBrowserMenus: hgScmEnabled.

    Smalltalk at: #SourceCodeManager put: scm.

    AbstractSourceCodeManager managerPerMatchingModuleDefinitions: scmPerPackage.

    Class tryLocalSourceFirst: tryLocalSourceFirst.

    HGPackageModelRegistry current flush:'mocks*'.

    HGRepositoriesResource current directoryForRepositories directoryContentsAsFilenames do:[:e|

            [

                Verbose == true ifTrue:[

                    Transcript cr; show: '+-- removing '; showCR: e pathName.

                ].

                e asFilename recursiveRemove.

            ] on: Error do:[:ex|

                "Stupid windows"

                OperatingSystem isMSWINDOWSlike ifTrue:[

                    Delay waitForSeconds: 3.

                    e asFilename recursiveRemove.

                ] ifFalse:[

                    ex pass

                ].

            ]

        ].

    repositories := nil.

    "Created: / 19-09-2012 / 19:03:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 30-09-2012 / 05:26:48 / jv"

    "Modified: / 08-07-2013 / 02:19:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGTestCase methodsFor:'utilities'!

repositoryNamed: nm

    ^self repositoryNamed: nm unpack: true

    "Created: / 19-09-2012 / 19:04:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 14-01-2013 / 13:20:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

repositoryNamed: nm init: init

    | dir |

    dir := HGRepositoriesResource current directoryForRepositoryNamed: nm init: init.

    repositories add:  dir.

    ^HGRepository on: dir.

    "Created: / 04-02-2013 / 11:04:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

repositoryNamed: nm unpack: unpack

    | dir |

    dir := HGRepositoriesResource current directoryForRepositoryNamed: nm unpack: unpack.

    repositories add:  dir.

    ^HGRepository on: dir.

    "Created: / 14-01-2013 / 13:20:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGTestCase class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'

! !