Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Contribute to GitLab
Sign in
Toggle navigation
C
cloud-orbit
Project
Project
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
Katerina Roukounaki
cloud-orbit
Commits
0cb2d574
Commit
0cb2d574
authored
Nov 24, 2014
by
Aggelos Giantsios
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Use HUnit to test the sequential orbit
parent
87c50149
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
97 additions
and
20 deletions
+97
-20
Tests.hs
Tests.hs
+97
-20
No files found.
Tests.hs
View file @
0cb2d574
import
Control.Concurrent.MVar
(
MVar
,
putMVar
,
newEmptyMVar
,
takeMVar
)
import
Control.Distributed.Process
import
Control.Distributed.Process.Node
import
qualified
Network.Transport
as
NT
(
Transport
)
import
Network.Transport.TCP
import
Prelude
hiding
(
seq
)
import
Test.HUnit
import
Test.Framework
(
defaultMain
,
testGroup
)
import
Test.Framework.Providers.HUnit
import
Test.Framework
(
Test
,
testGroup
,
defaultMain
)
import
Test.Framework.Providers.HUnit
(
testCase
)
import
Test.HUnit
(
Assertion
,
assertFailure
)
import
Test.HUnit.Base
(
assertBool
)
import
Bench
(
seq
)
import
Utils
(
g13
,
g124
,
g1245
)
import
MasterWorker
(
__remoteTable
)
import
Utils
main
=
defaultMain
t
ests
-- Sequential T
ests
tests
=
[
testGroup
"Sequential tests"
[
testCase
"short"
test1
,
testCase
"intermediate"
test2
,
testCase
"long"
test3
testSeqShort
::
TestResult
String
->
Process
()
testSeqShort
result
=
do
r
<-
seq
gg13
11
stash
result
r
testSeqIntermediate
::
TestResult
String
->
Process
()
testSeqIntermediate
result
=
do
r
<-
seq
gg124
157
stash
result
r
testSeqLong
::
TestResult
String
->
Process
()
testSeqLong
result
=
do
r
<-
seq
gg1245
157
stash
result
r
-- Batch the tests
tests
::
LocalNode
->
[
Test
]
tests
localNode
=
[
testGroup
"Sequential Tests"
[
testCase
"testSeqShort"
(
delayedAssertion
"short"
localNode
"{size,10}"
testSeqShort
)
,
testCase
"testSeqIntermediate"
(
delayedAssertion
"intermediate"
localNode
"{size,133}"
testSeqIntermediate
)
,
testCase
"testSeqLong"
(
delayedAssertion
"long"
localNode
"{size,134}"
testSeqLong
)
]
]
test1
=
assertEqual
"g13 11"
"{size,10}"
(
seq
g13
11
)
test2
=
assertEqual
"g124 157"
"{size,133}"
(
seq
g124
157
)
test3
=
assertEqual
"g1245 157"
"{size,134}"
(
seq
g1245
157
)
-- Run the tests
orbitTests
::
NT
.
Transport
->
IO
[
Test
]
orbitTests
transport
=
do
localNode
<-
newLocalNode
transport
rtable
let
testData
=
tests
localNode
return
testData
where
rtable
::
RemoteTable
rtable
=
MasterWorker
.
__remoteTable
initRemoteTable
main
::
IO
()
main
=
testMain
$
orbitTests
-- Auxiliary functions
-------------------------------------------------------------------
-- | A mutable cell containing a test result.
type
TestResult
a
=
MVar
a
-- | Stashes a value in our 'TestResult' using @putMVar@
stash
::
TestResult
a
->
a
->
Process
()
stash
mvar
x
=
liftIO
$
putMVar
mvar
x
-- | Run the supplied @testProc@ using an @MVar@ to collect and assert
-- against its result. Uses the supplied @note@ if the assertion fails.
delayedAssertion
::
(
Eq
a
)
=>
String
->
LocalNode
->
a
->
(
TestResult
a
->
Process
()
)
->
Assertion
delayedAssertion
note
localNode
expected
testProc
=
do
result
<-
newEmptyMVar
_
<-
forkProcess
localNode
$
testProc
result
assertComplete
note
result
expected
-- | Takes the value of @mv@ (using @takeMVar@) and asserts that it matches @a@
assertComplete
::
(
Eq
a
)
=>
String
->
MVar
a
->
a
->
IO
()
assertComplete
msg
mv
a
=
do
b
<-
takeMVar
mv
assertBool
msg
(
a
==
b
)
-- | Given a @builder@ function, make and run a test suite on a single transport
testMain
::
(
NT
.
Transport
->
IO
[
Test
])
->
IO
()
testMain
builder
=
do
Right
(
transport
,
_
)
<-
createTransportExposeInternals
"127.0.0.1"
"10501"
defaultTCPParameters
testData
<-
builder
transport
defaultMain
testData
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment