forked from advancedtelematic/quickcheck-state-machine
-
Notifications
You must be signed in to change notification settings - Fork 11
/
Copy pathSpec.hs
227 lines (216 loc) · 11.4 KB
/
Spec.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
{-# LANGUAGE ScopedTypeVariables #-}
module Main (main) where
import Control.Exception
(catch)
import Prelude
import System.Exit
(ExitCode(..))
import System.Process
(StdStream(CreatePipe), proc, std_out,
waitForProcess, withCreateProcess)
import Test.DocTest
(doctest)
import Test.Tasty
(TestTree, defaultMain, testGroup, withResource)
import Test.Tasty.HUnit
(testCase)
import Test.Tasty.QuickCheck
(expectFailure, testProperty, withMaxSuccess)
import Bookstore as Store
import CircularBuffer
import Cleanup
import qualified CrudWebserverDb as WS
import DieHard
import Echo
import ErrorEncountered
import Hanoi
import IORefs
import MemoryReference
import Mock
import Overflow
-- import ProcessRegistry
import qualified ShrinkingProps
import SQLite
import TicketDispenser
import qualified UnionFind
------------------------------------------------------------------------
tests :: Bool -> TestTree
tests docker0 = testGroup "Tests"
[ testCase "Doctest"
(doctest [ "src/Test/StateMachine/Z.hs"
, "src/Test/StateMachine/Logic.hs"
])
, ShrinkingProps.tests
, testProperty "TowersOfHanoi"
(expectFailure (prop_hanoi 3))
, testProperty "DieHard"
(expectFailure (withMaxSuccess 2000 prop_dieHard))
, testGroup "MemoryReference"
[testProperty "NoBugSeq" (prop_sequential MemoryReference.None)
, testProperty "LogicBug" (expectFailure (prop_sequential Logic))
, testProperty "RaceBugSequential" (prop_sequential Race)
, testProperty "NoBugParallel" (prop_parallel MemoryReference.None)
, testProperty "RaceBugParallel" (expectFailure (prop_parallel Race))
, testProperty "CrashBugParallel" (prop_parallel' Crash)
, testProperty "CrashAndLogicBugParallel"
(expectFailure (withMaxSuccess 10000 (prop_parallel' CrashAndLogic)))
, testProperty "PreconditionFailed" prop_precondition
, testProperty "ExistsCommands" prop_existsCommands
, testProperty "NoBug 1 thread" (prop_nparallel MemoryReference.None 1)
, testProperty "NoBug 2 threads" (prop_nparallel MemoryReference.None 2)
, testProperty "NoBug 3 threads" (withMaxSuccess 80 $ prop_nparallel MemoryReference.None 3)
, testProperty "NoBug 4 threads" (withMaxSuccess 40 $ prop_nparallel MemoryReference.None 4)
, testProperty "RaceBugParalleel 1 thread" (prop_nparallel Race 1)
, testProperty "RaceBugParalleel 2 threads" (expectFailure (prop_nparallel Race 2))
, testProperty "RaceBugParalleel 3 threads" (expectFailure (prop_nparallel Race 3))
, testProperty "RaceBugParalleel 4 threads" (expectFailure (prop_nparallel Race 4))
, testProperty "ShrinkParallelEquivalence" prop_pairs_shrink_parallel_equivalence
, testProperty "ShrinkAndValidateParallelEquivalence" prop_pairs_shrinkAndValidate_equivalence
, testProperty "ShrinkPairsEquialence" prop_pairs_shrink_parallel
]
, testGroup "Overflow"
[ testProperty "2-threads" prop_parallel_overflow
, testProperty "3-threads" $ prop_nparallel_overflow 3
, testProperty "4-threads" $ expectFailure
$ withMaxSuccess 500
$ prop_nparallel_overflow 4
]
, testGroup "Cleanup"
[ testProperty "seqRegularNoOp" $ prop_sequential_clean Regular Cleanup.NoBug NoOp
, testProperty "seqRegular" $ prop_sequential_clean Regular Cleanup.NoBug ReDo
, testProperty "seqRegularExcNoOp"
$ expectFailure $ prop_sequential_clean Regular Cleanup.Exception NoOp
, testProperty "seqRegularExc"
$ expectFailure $ prop_sequential_clean Regular Cleanup.Exception ReDo
, testProperty "seqFilesNoOp" $ prop_sequential_clean Files Cleanup.NoBug NoOp
, testProperty "seqFiles" $ prop_sequential_clean Files Cleanup.NoBug ReDo
, testProperty "seqFilesExcNoOp" $ prop_sequential_clean Files Cleanup.Exception NoOp
, testProperty "seqFilesExc" $ prop_sequential_clean Files Cleanup.Exception ReDo
, testProperty "seqFilesExcAfterNoOp" $ prop_sequential_clean Files Cleanup.ExcAfter NoOp
, testProperty "seqFilesExcAfterReDo" $ prop_sequential_clean Files Cleanup.ExcAfter ReDo
, testProperty "seqEquivNoOp" $ prop_sequential_clean (Eq False) Cleanup.NoBug NoOp
, testProperty "2-threadsRegularExc"
$ expectFailure $ prop_parallel_clean Regular Cleanup.Exception NoOp
, testProperty "2-threadsRegularExc"
$ expectFailure $ prop_parallel_clean Regular Cleanup.Exception ReDo
, testProperty "2-threadsFilesExc"
$ expectFailure $ withMaxSuccess 1000 $ prop_parallel_clean Files Cleanup.Exception ReDo
, testProperty "2-threadsEquivFailingNoOp"
$ expectFailure $ withMaxSuccess 1000 $ prop_parallel_clean (Eq True) Cleanup.NoBug NoOp
, testProperty "3-threadsRegularNoOp" $ prop_nparallel_clean 3 Regular Cleanup.NoBug NoOp
, testProperty "3-threadsRegular" $ prop_nparallel_clean 3 Regular Cleanup.NoBug ReDo
, testProperty "3-threadsRegularExc" $ expectFailure
$ prop_nparallel_clean 3 Regular Cleanup.Exception NoOp
, testProperty "3-threadsRegularExc"
$ expectFailure $ prop_nparallel_clean 3 Regular Cleanup.Exception ReDo
, testProperty "3-threadsFilesNoOp" $ prop_nparallel_clean 3 Files Cleanup.NoBug NoOp
, testProperty "3-threadsFiles" $ prop_nparallel_clean 3 Files Cleanup.NoBug ReDo
, testProperty "3-threadsFilesExcNoOp" $ prop_nparallel_clean 3 Files Cleanup.Exception NoOp
, testProperty "3-threadsFilesExc"
$ expectFailure $ withMaxSuccess 1000 $ prop_nparallel_clean 3 Files Cleanup.Exception ReDo
, testProperty "3-threadsFilesExcAfter" $ prop_nparallel_clean 3 Files Cleanup.ExcAfter NoOp
, testProperty "3-threadsEquivNoOp" $ prop_nparallel_clean 3 (Eq False) Cleanup.NoBug NoOp
, testProperty "3-threadsEquivFailingNoOp"
$ expectFailure $ withMaxSuccess 1000 $ prop_nparallel_clean 3 (Eq True) Cleanup.NoBug NoOp
]
, testGroup "SQLite"
[ testProperty "Parallel" prop_parallel_sqlite
]
, testGroup "ErrorEncountered"
[ testProperty "Sequential" prop_error_sequential
, testProperty "Parallel" prop_error_parallel
, testProperty "2-Parallel" $ prop_error_nparallel 2
, testProperty "3-Parallel" $ prop_error_nparallel 3
, testProperty "4-Parallel" $ prop_error_nparallel 4
]
, testGroup "CrudWebserver"
[ webServer docker0 WS.None 8800 "NoBug" WS.prop_crudWebserverDb
, webServer docker0 WS.Logic 8801 "LogicBug" (expectFailure . WS.prop_crudWebserverDb)
, webServer docker0 WS.Race 8802 "NoRaceBug" WS.prop_crudWebserverDb
, webServer docker0 WS.Race 8803 "RaceBug" (expectFailure . WS.prop_crudWebserverDbParallel)
]
, testGroup "Bookstore"
[ dataBase docker0 "NoBug" (Store.prop_bookstore Store.NoBug)
, dataBase docker0 "SqlStatementBug"
$ expectFailure
. withMaxSuccess 500
. Store.prop_bookstore Bug
, dataBase docker0 "InputValidationBug"
$ expectFailure
. withMaxSuccess 500
. Store.prop_bookstore Injection
]
, testGroup "TicketDispenser"
[ testProperty "Sequential" prop_ticketDispenser
, testProperty "ParallelWithExclusiveLock" (withMaxSuccess 30
prop_ticketDispenserParallelOK)
, testProperty "ParallelWithSharedLock" (expectFailure
prop_ticketDispenserParallelBad)
, testProperty "2-ParallelWithExclusiveLock" (prop_ticketDispenserNParallelOK 2)
, testProperty "3-ParallelWithExclusiveLock" (prop_ticketDispenserNParallelOK 3)
, testProperty "4-ParallelWithExclusiveLock" (prop_ticketDispenserNParallelOK 4)
, testProperty "3-ParallelWithSharedLock" (expectFailure $
prop_ticketDispenserNParallelBad 3)
]
, testGroup "Mock"
[ testProperty "sequential" prop_sequential_mock
, testProperty "parallel" prop_parallel_mock
, testProperty "nparallel" prop_nparallel_mock
]
, testGroup "CircularBuffer"
[ testProperty "unpropNoSizeCheck"
(expectFailure (withMaxSuccess 1000 unpropNoSizeCheck))
, testProperty "unpropFullIsEmpty"
(expectFailure (withMaxSuccess 1000 unpropFullIsEmpty))
, testProperty "unpropBadRem"
(expectFailure (withMaxSuccess 1000 unpropBadRem))
, testProperty "unpropStillBadRem"
(expectFailure (withMaxSuccess 1000 unpropStillBadRem))
, testProperty "prop_circularBuffer"
prop_circularBuffer
]
, testGroup "Echo"
[ testProperty "Sequential" prop_echoOK
, testProperty "Parallel" prop_echoParallelOK
, testProperty "2-Parallel" (prop_echoNParallelOK 2)
, testProperty "3-Parallel" (prop_echoNParallelOK 3)
]
-- XXX: The generator function needs to be reimplemented.
-- , testGroup "ProcessRegistry"
-- [ testProperty "Sequential" prop_processRegistry
-- ]
, testGroup "UnionFind"
[ testProperty "Sequential" UnionFind.prop_unionFindSequential ]
, testGroup "Lockstep"
[ testProperty "IORefs_Sequential" prop_IORefs_sequential
]
]
where
webServer docker bug port test prop
| docker = withResource (WS.setup bug WS.connectionString port) WS.cleanup
(const (testProperty test (prop port)))
| otherwise = testCase ("No docker or running on CI, skipping: " ++ test) (return ())
dataBase docker test prop
| docker = withResource Store.setup
Store.cleanup
(\io -> testProperty test (prop (snd <$> io)))
| otherwise = testCase ("No docker, skipping: " ++ test) (return ())
-- Currently unused, see #14
-- whenDocker docker test prop
-- | docker = prop
-- | otherwise = testCase ("No docker, skipping: " ++ test) (return ())
------------------------------------------------------------------------
main :: IO ()
main = do
-- Check if docker is avaiable.
ec <- rawSystemNoStdout "docker" ["version"]
`catch` (\(_ :: IOError) -> return (ExitFailure 127))
let docker = case ec of
ExitSuccess -> True
ExitFailure _ -> False
defaultMain (tests docker)
where
rawSystemNoStdout cmd args =
withCreateProcess
(proc cmd args) { std_out = CreatePipe }
(\_ _ _ -> waitForProcess)