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
|
{-# LANGUAGE ScopedTypeVariables, PatternGuards #-}
module Examples.Test.Oracle(main) where
import Development.Shake
import Examples.Util
import Control.Monad
main = shaken test $ \args obj -> do
let f name lhs rhs = (,) name $
(do addOracle $ \k -> let _ = k `asTypeOf` lhs in return rhs; return ()
,let o = obj name ++ ".txt" in do want [o]; o *> \_ -> do v <- askOracleWith lhs rhs; writeFile' o $ show v)
let tbl = [f "str-bool" "" True
,f "str-int" "" (0::Int)
,f "bool-str" True ""
,f "int-str" (0::Int) ""]
forM_ args $ \a -> case a of
'+':x | Just (add,_) <- lookup x tbl -> add
'*':x | Just (_,use) <- lookup x tbl -> use
'@':key -> do addOracle $ \() -> return key; return ()
'%':name -> let o = obj "unit.txt" in do want [o]; o *> \_ -> do {askOracleWith () ""; writeFile' o name}
'!':name -> do want [obj "rerun"]; obj "rerun" *> \out -> do alwaysRerun; writeFile' out name
test build obj = do
build ["clean"]
-- check it rebuilds when it should
build ["@key","%name"]
assertContents (obj "unit.txt") "name"
build ["@key","%test"]
assertContents (obj "unit.txt") "name"
build ["@foo","%test"]
assertContents (obj "unit.txt") "test"
-- check adding/removing redundant oracles does not trigger a rebuild
build ["@foo","%newer","+str-bool"]
assertContents (obj "unit.txt") "test"
build ["@foo","%newer","+str-int"]
assertContents (obj "unit.txt") "test"
build ["@foo","%newer"]
assertContents (obj "unit.txt") "test"
-- check always run works
build ["!foo"]
assertContents (obj "rerun") "foo"
build ["!bar"]
assertContents (obj "rerun") "bar"
-- check error messages are good
let errors args err = assertException [err] $ build $ "--quiet" : args
build ["+str-int","*str-int"]
errors ["*str-int"] -- Building with an an Oracle that has been removed
"missing a call to addOracle"
errors ["*str-bool"] -- Building with an Oracle that I know nothing about
"missing a call to addOracle"
build ["+str-int","*str-int"]
errors ["+str-bool","*str-int"] -- Building with an Oracle that has changed type
"askOracle is used at the wrong type"
errors ["+str-int","+str-bool"] -- Two Oracles with the same question type
"Only one call to addOracle is allowed"
errors ["+str-int","*str-bool"] -- Using an Oracle at the wrong answer type
"askOracle is used at the wrong type"
build ["+str-int","+str-int"] -- Two Oracles work if they aren't used
errors ["+str-int","+str-int","*str-int"] -- Two Oracles fail if they are used
"Only one call to addOracle is allowed"
errors ["+str-int","+str-bool"] -- Two Oracles with the same answer type
"Only one call to addOracle is allowed"
|
