/
PropertySpec.hs
99 lines (76 loc) · 4.23 KB
/
PropertySpec.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
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
module PropertySpec (main, spec) where
import Test.Hspec
import Data.String.Builder
import Property
import Type
import Location
import Interpreter (withInterpreter)
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
describe "runProperty" $ do
it "reports a failing property" $ withInterpreter [] $ \repl -> do
let expression = noLocation "False"
runProperty repl expression `shouldReturn` PropertyFailure expression "Falsifiable (after 1 test):"
it "runs a Bool property" $ withInterpreter [] $ \repl -> do
runProperty repl (noLocation "True") `shouldReturn` Success
it "runs a Bool property with an explicit type signature" $ withInterpreter [] $ \repl -> do
runProperty repl (noLocation "True :: Bool") `shouldReturn` Success
it "runs an implicitly quantified property" $ withInterpreter [] $ \repl -> do
runProperty repl (noLocation "(reverse . reverse) xs == (xs :: [Int])") `shouldReturn` Success
it "runs an implicitly quantified property even with GHC 7.4" $ withInterpreter [] $ \repl -> do
-- ghc will include a suggestion (did you mean `id` instead of `is`) in
-- the error message
runProperty repl (noLocation "foldr (+) 0 is == sum (is :: [Int])") `shouldReturn` Success
it "runs an explicitly quantified property" $ withInterpreter [] $ \repl -> do
runProperty repl (noLocation "\\xs -> (reverse . reverse) xs == (xs :: [Int])") `shouldReturn` Success
it "allows to mix implicit and explicit quantification" $ withInterpreter [] $ \repl -> do
runProperty repl (noLocation "\\x -> x + y == y + x") `shouldReturn` Success
it "reports the value for which a property fails" $ withInterpreter [] $ \repl -> do
let expression = noLocation "x == 23"
runProperty repl expression `shouldReturn` PropertyFailure expression "Falsifiable (after 1 test): \n0"
it "reports the values for which a property that takes multiple arguments fails" $ withInterpreter [] $ \repl -> do
let vals x = case x of (PropertyFailure _ r) -> tail (lines r); _ -> error "Property did not fail!"
vals `fmap` runProperty repl (noLocation "x == True && y == 10 && z == \"foo\"") `shouldReturn` ["False", "0", show ("" :: String)]
describe "freeVariables" $ do
it "finds a free variables in a term" $ withInterpreter [] $ \repl -> do
freeVariables repl "x" `shouldReturn` ["x"]
it "ignores duplicates" $ withInterpreter [] $ \repl -> do
freeVariables repl "x == x" `shouldReturn` ["x"]
it "works for terms with multiple names" $ withInterpreter [] $ \repl -> do
freeVariables repl "\\z -> x + y + z == foo 23" `shouldReturn` ["x", "y", "foo"]
it "works for names that contain a prime" $ withInterpreter [] $ \repl -> do
freeVariables repl "x' == y''" `shouldReturn` ["x'", "y''"]
it "works for names that are similar to other names that are in scope" $ withInterpreter [] $ \repl -> do
-- ghc will include a suggestion (did you mean `id` instead of `is`) in
-- the error message
freeVariables repl "length_" `shouldReturn` ["length_"]
describe "parseNotInScope" $ do
context "when error message was produced by GHC 7.4.1" $ do
it "extracts a variable name of variable that is not in scope from error an message" $ do
parseNotInScope . build $ do
"<interactive>:4:1: Not in scope: `x'"
""
"<interactive>:4:6: Not in scope: `x'"
`shouldBe` ["x"]
it "ignores duplicates" $ do
parseNotInScope . build $ do
"<interactive>:4:1: Not in scope: `x'"
""
"<interactive>:4:6: Not in scope: `x'"
`shouldBe` ["x"]
it "works for error messages with suggestions" $ do
parseNotInScope . build $ do
"<interactive>:1:1:"
" Not in scope: `is'"
" Perhaps you meant `id' (imported from Prelude)"
`shouldBe` ["is"]
it "works for variable names that contain a prime" $ do
parseNotInScope . build $ do
"<interactive>:2:1: Not in scope: x'"
""
"<interactive>:2:7: Not in scope: y'"
`shouldBe` ["x'", "y'"]