Commit fbb9aa59 authored by Camil Staps's avatar Camil Staps 🚀

Prepend function name to generated tests

parent 97ca0c6c
......@@ -204,7 +204,7 @@ handleModule opts fp w
opts.print_options
opts.test_options
mod
[f \\ (_,f,_) <- funs ++ macros]
[(loc,f) \\ (loc,f,_) <- funs ++ macros]
// Write properties
| nprops == 0 = w
# w = output INFO
......@@ -249,7 +249,8 @@ where
interleave _ [] = []
interleave g [x:xs] = [g,x:interleave g xs]
generatePropertyModule :: !String !String ![String] ![String] !ModuleEntry ![FunctionEntry] -> (!Int, !Real, !String)
generatePropertyModule :: !String !String ![String] ![String] !ModuleEntry
![(LocationInModule,FunctionEntry)] -> (!Int, !Real, !String)
generatePropertyModule testmodname modname print_options test_options me fes
= (length props, coverage, tests)
where
......@@ -259,6 +260,7 @@ where
[ "module " +++ testmodname
, "import Gast, Gast.CommandLine"
, "from StdString import instance toString {#Char}"
, "from Data.Func import $" // TODO: would be nice if property generation did not require this
, "import Control.GenBimap"
, "import " +++ modname
, bootstrap
......@@ -267,7 +269,7 @@ where
: [gp.gp_implementation \\ gp <- props]
]
propsets = map (generateProperties pvis generators) fes
propsets = map (uncurry $ generateProperties pvis generators) fes
where pvis = fromMaybe [] $ docPropertyTestWith <$> me.me_documentation
props = flatten propsets
......@@ -298,9 +300,10 @@ where
:: NamedTestGenerator :== (String, Type, String)
generateProperties :: ![PropertyVarInstantiation] ![NamedTestGenerator] !FunctionEntry -> [GeneratedProperty]
generateProperties pvis generators fe=:{fe_documentation=Just doc} =
[gen i p config
generateProperties :: ![PropertyVarInstantiation] ![NamedTestGenerator]
!LocationInModule !FunctionEntry -> [GeneratedProperty]
generateProperties pvis generators loc fe=:{fe_documentation=Just doc} =
[gen i (fromJust loc.LocationInModule.name) p config
\\ p <- doc.properties
, config <- configurations $ groupInstantiations $ pvis ++ docPropertyTestWith doc
& i <- [1..]]
......@@ -312,25 +315,31 @@ where
configurations [vis:viss] = [[vi`:vis`] \\ vi` <- vis, vis` <- configurations viss]
configurations [] = [[]]
gen :: !Int !Property ![(String,Type)] -> GeneratedProperty
gen i (ForAll name ts imp) vis =
{ gp_name = name`
gen :: !Int !String !Property ![(String,Type)] -> GeneratedProperty
gen i fname (ForAll name ts imp) vis =
{ gp_name = tname
, gp_implementation = join "\n"
[ name` +++ " :: " +++ toString type
, join " " [name`:map fst3 ts`] +++ " = name \"" +++ name` +++ "\""
, "\t(" +++ join " " [name` +++ "`":map snd3 ts`] +++ ")"
[ tname +++ " :: Property"
, tname +++ " = name \"" +++ fname +++ ": " +++ name` +++ "\""
, "\t(" +++ lambda +++ join " " [name` +++ "`":map snd3 ts`] +++ ")"
, "where"
, "\t" +++ join " " [name` +++ "`":map fst3 ts`] +++ " = " +++ replaceSubString "\n" "\n\t" imp
, "\t" +++ name` +++ "` :: " +++ toString type`
, "\t" +++ join " " [name` +++ "`":map fst3 ts`] +++ " = prop $\n\t\t" +++ replaceSubString "\n" "\n\t\t" imp
]
}
where
tname = fname +++ "_" +++ name` // TODO generate a different name if fname contains funny characters
name` = if (i == 1) name (name +++ "_" +++ toString i)
type = fromJust $ assignAll vis $ Func (map thd3 ts`) (Type "Property" []) []
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`) +++ " -> "
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)
generateProperties _ _ _ = []
generateProperties _ _ _ _ = []
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