Verified Commit 73dc9e7c authored by Camil Staps's avatar Camil Staps 🚀

Support list test generators (closes #8)

parent 549e854a
Pipeline #18179 failed with stage
in 6 minutes and 17 seconds
......@@ -341,14 +341,17 @@ where
argtypes = map snd args
generators = [("gast_generator_" <+ i,type,imp) \\ i <- [0..]
& PropertyTestGenerator type imp <- fromMaybe [] (docPropertyTestGenerators <$> mod_doc)]
generators = [("gast_generator_" <+ i,ptg) \\ i <- [0..] & ptg <- fromMaybe [] (docPropertyTestGenerators <$> mod_doc)]
generators_string = join "\n\n" $ map makeGenerator $ generators
where
makeGenerator :: NamedTestGenerator -> String
makeGenerator (name, t, imp) = join "\n"
[ name +++ " :: " <+ t
, name +++ imp % (3, size imp - 1)
makeGenerator (name, ptg) = case ptg of
PTG_Function t imp -> mkgen name t (imp % (3, size imp-1))
PTG_List t imp -> mkgen name (Type "_List" [t]) (" = " +++ imp)
mkgen name type imp = join "\n"
[ name +++ " :: " <+ type
, name +++ imp
]
start = join "\n\t"
......@@ -364,7 +367,13 @@ where
, gp_implementation :: !String
}
:: NamedTestGenerator :== (String, Type, String)
:: NamedTestGenerator :== (String, PropertyTestGenerator)
:: GeneratedArgument =
{ ga_name :: !String // argument name
, ga_expr :: !String // expression (for PTG_Function)
, ga_ptg :: !Maybe NamedTestGenerator // the generator used
}
generateProperties :: ![PropertyVarInstantiation] ![NamedTestGenerator] !String !FunctionDoc -> [GeneratedProperty]
generateProperties pvis generators fname doc =
......@@ -394,10 +403,10 @@ where
, gp_implementation = join "\n"
[ tname +++ " :: Property"
, tname +++ " = name \"" +++ fname +++ ": " +++ name` +++ "\""
, "\t(" +++ lambda +++ join " " [name`` +++ "`":map snd3 ts`] +++ ")"
, "\t(" +++ join " " lambdas +++ join " " [name`` +++ "`":[ga.ga_expr \\ ga <- gas]] +++ {')' \\ _ <- lambdas} +++ ")"
, "where"
, "\t" +++ name`` +++ "` :: " +++ toString type`
, "\t" +++ join " " [name`` +++ "`":map fst3 ts`] +++ " = (True" +++ concat [" /\\ _pre" <+ i \\ i <- [1..] & pre <- preconditions] +++ ") ==> _p"
, "\t" +++ join " " [name`` +++ "`":[ga.ga_name \\ ga <- gas]] +++ " = (True" +++ concat [" /\\ _pre" <+ i \\ i <- [1..] & pre <- preconditions] +++ ") ==> _p"
, "\twhere"
, "\t\t_p = " +++ replaceSubString "\n" "\n\t\t\t" imp
: ["\t\t_pre" <+ i <+ " = " +++ s \\ s <- preconditions & i <- [1..]]
......@@ -407,18 +416,37 @@ where
tname = fname +++ "_" +++ name``
name`` = fixname name`
name` = if (i == 1) name (name +++ "_" +++ toString i)
type = fromJust $ assignAll vis $ Func (map thd3 ts`) (Type "Property" []) []
type` = fromJust $ assignAll vis $ Func (map snd ts) (Type "Property" []) []
ts` = map resolveGenerators ts
lambda = case ts` of
[] -> ""
_ -> "\\" +++ join " " (map fst3 ts`) +++ " -> "
gas = map resolveGenerators ts
where
resolveGenerators :: (String,Type) -> GeneratedArgument
resolveGenerators (arg,t) =
case [(n,i,ntg) \\ ntg=:(n,PTG_Function (Func [i] r _) _) <- generators | r == t] of
[(n,i,ntg):_] ->
{ ga_name = arg
, ga_expr = "(" +++ n +++ " " +++ arg +++ ")"
, ga_ptg = Just ntg
}
[] -> case [(n,ntg) \\ ntg=:(n,PTG_List r _) <- generators | r == t] of
[(n,ntg):_] ->
{ ga_name = arg
, ga_expr = arg
, ga_ptg = Just ntg
}
[] ->
{ ga_name = arg
, ga_expr = arg
, ga_ptg = Nothing
}
resolveGenerators :: (String,Type) -> (String,String,Type)
resolveGenerators (arg,t) = case [(n,i) \\ (n,Func [i] r _,_) <- generators | r == t] of
[(n,i):_] -> (arg,"(" +++ n +++ " " +++ arg +++ ")",i)
[] -> (arg,arg,t)
lambdas = map makeLambda gas
where
makeLambda :: GeneratedArgument -> String
makeLambda ga = case ga.ga_ptg of
Just (gen,PTG_List _ _)
-> "ForEach " +++ gen +++ " (\\" +++ ga.ga_name +++ "->"
-> "\\" +++ ga.ga_name +++ "->("
fixname :: String -> String
fixname s = {if (isAlphanum c) c '_' \\ c <-: s}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment