From 7d69967fff8ea84da33d65a52ed15376489d423a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Buckwalter?= Date: Sun, 14 Jul 2019 18:50:08 +0200 Subject: [PATCH 1/3] Avoid QuickCheck for properties without free variables Properties that have no free variables and have type `Bool` can be checked to be `True` without using QuickCheck. Properties with free variables need QuickCheck. Some properties may not have free variables but if the type is not `Bool` we use QuickCheck on the assumption that they are of some other `Test.QuickCheck.Testable` instance. --- src/Property.hs | 53 +++++++++++++++++++++++++++++++++++++------- test/PropertySpec.hs | 20 +++++++++++------ 2 files changed, 58 insertions(+), 15 deletions(-) diff --git a/src/Property.hs b/src/Property.hs index a6970f73..91c422bb 100644 --- a/src/Property.hs +++ b/src/Property.hs @@ -1,10 +1,12 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE LambdaCase #-} module Property ( runProperty , PropertyResult (..) #ifdef TEST -, freeVariables +, PropertyType (..) +, propertyType , parseNotInScope #endif ) where @@ -17,6 +19,7 @@ import Util import Interpreter (Interpreter) import qualified Interpreter import Parse +import Runner.Example -- | The result of evaluating an interaction. data PropertyResult = @@ -25,14 +28,38 @@ data PropertyResult = | Error String deriving (Eq, Show) +-- | The type (not in the "type system" sense) of a property +data PropertyType = Simple | QuickCheck [String] | Unknown + deriving (Eq, Show) + runProperty :: Interpreter -> Expression -> IO PropertyResult runProperty repl expression = do + propertyType repl expression >>= \case + Simple -> runSimpleProperty repl expression + QuickCheck vs -> runQuickCheckProperty repl expression vs + Unknown -> runQuickCheckProperty repl expression [] + +-- | Run a property with no free variables (that is, no QuickCheck +-- required). +runSimpleProperty :: Interpreter -> Expression -> IO PropertyResult +runSimpleProperty repl expression = do + r <- fmap lines <$> Interpreter.safeEval repl expression + case r of + Left err -> return (Error err) + Right actual -> case mkResult expected actual of + NotEqual err -> return $ Failure (unlines err) + Equal -> return Success + where + expected = [ExpectedLine [LineChunk "True"]] + +-- | Run a property with one or more free variables using QuickCheck. +runQuickCheckProperty :: Interpreter -> Expression -> [String] -> IO PropertyResult +runQuickCheckProperty repl expression vs = do _ <- Interpreter.safeEval repl "import Test.QuickCheck ((==>))" _ <- Interpreter.safeEval repl "import Test.QuickCheck.All (polyQuickCheck)" _ <- Interpreter.safeEval repl "import Language.Haskell.TH (mkName)" _ <- Interpreter.safeEval repl ":set -XTemplateHaskell" - r <- freeVariables repl expression >>= - (Interpreter.safeEval repl . quickCheck expression) + r <- Interpreter.safeEval repl $ quickCheck expression vs case r of Left err -> do return (Error err) @@ -46,13 +73,23 @@ runProperty repl expression = do "let doctest_prop " ++ unwords vars ++ " = " ++ term ++ "\n" ++ "$(polyQuickCheck (mkName \"doctest_prop\"))" --- | Find all free variables in given term. + +-- | Determing what type of property a term corresponds to. +-- +-- GHCi is used to determing the type. -- --- GHCi is used to detect free variables. -freeVariables :: Interpreter -> String -> IO [String] -freeVariables repl term = do +-- If the type is Bool the property is simple and does not need QuickCheck. +-- +-- Otherwise we assume QuickCheck will be needed. If GHCi reported any free +-- variables they are extracted for passing to QuickCheck. +propertyType :: Interpreter -> String -> IO PropertyType +propertyType repl term = do r <- Interpreter.safeEval repl (":type " ++ term) - return (either (const []) (nub . parseNotInScope) r) + case r of + Left _ -> return Unknown + Right s -> if " :: Bool\n" `isSuffixOf` s + then return Simple + else return $ QuickCheck (parseNotInScope s) -- | Parse and return all variables that are not in scope from a ghc error -- message. diff --git a/test/PropertySpec.hs b/test/PropertySpec.hs index 29c934f8..fc27d7b7 100644 --- a/test/PropertySpec.hs +++ b/test/PropertySpec.hs @@ -58,21 +58,27 @@ spec = do it "defaults ambiguous type variables to Integer" $ withInterpreter [] $ \repl -> do runProperty repl "reverse xs == xs" >>= (`shouldSatisfy` isFailure) - describe "freeVariables" $ do - it "finds a free variables in a term" $ withInterpreter [] $ \repl -> do - freeVariables repl "x" `shouldReturn` ["x"] + describe "propertyType" $ do + it "finds free variables in a term" $ withInterpreter [] $ \repl -> do + propertyType repl "x" `shouldReturn` QuickCheck ["x"] it "ignores duplicates" $ withInterpreter [] $ \repl -> do - freeVariables repl "x == x" `shouldReturn` ["x"] + propertyType repl "x == x" `shouldReturn` QuickCheck ["x"] it "works for terms with multiple names" $ withInterpreter [] $ \repl -> do - freeVariables repl "\\z -> x + y + z == foo 23" `shouldReturn` ["x", "y", "foo"] + propertyType repl "\\z -> x + y + z == foo 23" `shouldReturn` QuickCheck ["x", "y", "foo"] it "works for names that contain a prime" $ withInterpreter [] $ \repl -> do - freeVariables repl "x' == y''" `shouldReturn` ["x'", "y''"] + propertyType repl "x' == y''" `shouldReturn` QuickCheck ["x'", "y''"] it "works for names that are similar to other names that are in scope" $ withInterpreter [] $ \repl -> do - freeVariables repl "length_" `shouldReturn` ["length_"] + propertyType repl "length_" `shouldReturn` QuickCheck ["length_"] + + it "identifies simple properties without free variables" $ withInterpreter [] $ \repl -> do + propertyType repl "True" `shouldReturn` Simple + + it "identifies QuickCheck properties without free variables" $ withInterpreter [] $ \repl -> do + propertyType repl "Just True" `shouldReturn` QuickCheck [] describe "parseNotInScope" $ do context "when error message was produced by GHC 7.4.1" $ do From 0d737804ea87c978aef2cf02f68044430d795a9e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Buckwalter?= Date: Mon, 15 Jul 2019 11:04:09 +0200 Subject: [PATCH 2/3] Fix `runProperty` failure test case. --- test/PropertySpec.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/test/PropertySpec.hs b/test/PropertySpec.hs index fc27d7b7..575aed23 100644 --- a/test/PropertySpec.hs +++ b/test/PropertySpec.hs @@ -18,7 +18,10 @@ spec :: Spec spec = do describe "runProperty" $ do it "reports a failing property" $ withInterpreter [] $ \repl -> do - runProperty repl "False" `shouldReturn` Failure "*** Failed! Falsified (after 1 test):" + runProperty repl "const False (x :: Int)" `shouldReturn` Failure "*** Failed! Falsified (after 1 test):\n0" + + it "reports a failing simple property" $ withInterpreter [] $ \repl -> do + runProperty repl "False" `shouldReturn` Failure "expected: True\n but got: False\n" it "runs a Bool property" $ withInterpreter [] $ \repl -> do runProperty repl "True" `shouldReturn` Success From 6d23ad91f319f48102537c04425513a1c6b97a5f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Buckwalter?= Date: Mon, 15 Jul 2019 11:24:59 +0200 Subject: [PATCH 3/3] Avoid <$> for GHC-7 compatibilty In this case with a single use it seems more appropriate to `fmap` rather than CPP the import. --- src/Property.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Property.hs b/src/Property.hs index 91c422bb..4e674e99 100644 --- a/src/Property.hs +++ b/src/Property.hs @@ -43,7 +43,7 @@ runProperty repl expression = do -- required). runSimpleProperty :: Interpreter -> Expression -> IO PropertyResult runSimpleProperty repl expression = do - r <- fmap lines <$> Interpreter.safeEval repl expression + r <- fmap lines `fmap` Interpreter.safeEval repl expression case r of Left err -> return (Error err) Right actual -> case mkResult expected actual of