|
|
|
@ -5,6 +5,7 @@ module APL.Tests
|
|
|
|
|
where
|
|
|
|
|
|
|
|
|
|
import APL.AST (Exp (..), subExp, VName, printExp)
|
|
|
|
|
import APL.Eval (eval, runEval)
|
|
|
|
|
import APL.Parser (parseAPL, keywords)
|
|
|
|
|
import APL.Error (isVariableError, isDomainError, isTypeError)
|
|
|
|
|
import APL.Check (checkExp)
|
|
|
|
@ -22,6 +23,7 @@ import Test.QuickCheck
|
|
|
|
|
, listOf
|
|
|
|
|
, suchThat
|
|
|
|
|
, resize
|
|
|
|
|
, withMaxSuccess
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
genString :: Gen String
|
|
|
|
@ -33,6 +35,8 @@ varTest s = (not (s `elem` keywords)) && ((length s) > 1)
|
|
|
|
|
genVar :: Gen String
|
|
|
|
|
genVar = suchThat (genString) (varTest)
|
|
|
|
|
|
|
|
|
|
genInt :: Gen Integer
|
|
|
|
|
genInt = suchThat arbitrary (\i -> i >= 0)
|
|
|
|
|
|
|
|
|
|
instance Arbitrary Exp where
|
|
|
|
|
arbitrary = sized (genExp [])
|
|
|
|
@ -62,10 +66,10 @@ instance Arbitrary Exp where
|
|
|
|
|
shrink _ = []
|
|
|
|
|
|
|
|
|
|
genExp :: [VName] -> Int -> Gen Exp
|
|
|
|
|
genExp _ 0 = oneof [CstInt <$> arbitrary, CstBool <$> arbitrary]
|
|
|
|
|
genExp _ 0 = oneof [CstInt <$> genInt, CstBool <$> arbitrary]
|
|
|
|
|
genExp vars size =
|
|
|
|
|
frequency
|
|
|
|
|
[ (1, CstInt <$> arbitrary)
|
|
|
|
|
[ (1, CstInt <$> genInt)
|
|
|
|
|
, (1, CstBool <$> arbitrary)
|
|
|
|
|
, (1, Add <$> genExp vars halfSize <*> genExp vars halfSize)
|
|
|
|
|
, (1, Sub <$> genExp vars halfSize <*> genExp vars halfSize)
|
|
|
|
@ -74,7 +78,7 @@ genExp vars size =
|
|
|
|
|
, (1, Pow <$> genExp vars halfSize <*> genExp vars halfSize)
|
|
|
|
|
, (1, Eql <$> genExp vars halfSize <*> genExp vars halfSize)
|
|
|
|
|
, (1, If <$> genExp vars thirdSize <*> genExp vars thirdSize <*> genExp vars thirdSize)
|
|
|
|
|
, (1, Var <$> arbitrary)
|
|
|
|
|
, (1, Var <$> genVar)
|
|
|
|
|
, (if (length vars) > 0 then 50 else 0, Var <$> elements vars)
|
|
|
|
|
, (25, do
|
|
|
|
|
var <- genVar
|
|
|
|
@ -111,11 +115,13 @@ parsePrinted e = case (parseAPL "input" (printExp e)) of
|
|
|
|
|
Right e' -> e == e'
|
|
|
|
|
|
|
|
|
|
onlyCheckedErrors :: Exp -> Bool
|
|
|
|
|
onlyCheckedErrors _ = undefined
|
|
|
|
|
onlyCheckedErrors e = case runEval (eval e) of
|
|
|
|
|
Right _ -> True
|
|
|
|
|
Left err -> err `elem` (checkExp e)
|
|
|
|
|
|
|
|
|
|
properties :: [(String, Property)]
|
|
|
|
|
properties =
|
|
|
|
|
[ ("expCoverage", property expCoverage)
|
|
|
|
|
, ("parsePrinted", property parsePrinted)
|
|
|
|
|
, ("onlyCheckedErrors", property onlyCheckedErrors)
|
|
|
|
|
, ("parsePrinted", property (withMaxSuccess 10000 parsePrinted))
|
|
|
|
|
, ("onlyCheckedErrors", property (withMaxSuccess 1000000 onlyCheckedErrors))
|
|
|
|
|
]
|
|
|
|
|