|
definition:
|
analyseCurryProg :: Options -> String -> CurryProg -> IO [TestModule]
analyseCurryProg opts modname orgprog = do
-- First we rename all references to Test.Prop into Test.EasyCheck
let prog = renameProp2EasyCheck orgprog
(topdir,srcfilename) <- lookupModuleSourceInLoadPath modname >>=
return .
maybe (error $ "Source file of module '" ++ modname ++ "' not found!")
id
let srcdir = takeDirectory srcfilename
putStrLnIfDebug opts $ "Source file: " ++ srcfilename
prooffiles <- if optProof opts
then getModuleProofFiles srcdir modname
else return []
unless (null prooffiles) $ putStrIfDetails opts $
unlines ("Proof files found:" : map ("- " ++) prooffiles)
progtxt <- readFile srcfilename
(missingCPP,staticoperrs) <- staticProgAnalysis opts modname progtxt prog
let words = map firstWord (lines progtxt)
staticerrs = missingCPP ++ map (showOpError words) staticoperrs
putStrIfDetails opts "Generating property tests...\n"
theofuncs <- if optProof opts then getTheoremFunctions srcdir prog
else return []
-- compute already proved theorems for public module:
let pubmodname = modname++"_PUBLIC"
rnm2pub mn@(mod,n) | mod == modname = (pubmodname,n)
| otherwise = mn
theopubfuncs = map (updQNamesInCFuncDecl rnm2pub) theofuncs
(rawTests,ignoredTests,preCondOps,pubmod) <-
transformTests opts prooffiles theopubfuncs
. renameCurryModule pubmodname . makeAllPublic $ prog
let (rawDetTests,ignoredDetTests,pubdetmod) =
transformDetTests opts prooffiles
. renameCurryModule (modname ++ "_PUBLICDET")
. makeAllPublic $ prog
unless (not (null staticerrs) || null rawTests && null rawDetTests) $
putStrIfNormal opts $
"Properties to be tested:\n" ++
unwords (map (snd . funcName) (rawTests ++ rawDetTests)) ++ "\n"
unless (not (null staticerrs) || null ignoredTests && null ignoredDetTests) $
putStrIfNormal opts $
"Properties ignored for testing:\n" ++
unwords (map (snd . funcName) (ignoredTests ++ ignoredDetTests)) ++ "\n"
let tm = TestModule modname
(progName pubmod)
staticerrs
(addLinesNumbers words
(map (classifyTest opts pubmod) rawTests))
(generatorsOfProg pubmod)
preCondOps
dettm = TestModule modname
(progName pubdetmod)
[]
(addLinesNumbers words
(map (classifyTest opts pubdetmod) rawDetTests))
(generatorsOfProg pubmod)
[]
when (testThisModule tm) $ writeCurryProgram opts topdir pubmod ""
when (testThisModule dettm) $ writeCurryProgram opts topdir pubdetmod ""
return (if testThisModule dettm then [tm,dettm] else [tm])
where
showOpError words (qf,err) =
snd qf ++ showModuleLine modname (getLineNumber words qf) ++ ": " ++ err
addLinesNumbers words = map (addLineNumber words)
addLineNumber :: [String] -> Test -> Test
addLineNumber words (PropTest name texp _) =
PropTest name texp $ getLineNumber words (orgTestName name)
addLineNumber words (IOTest name _) =
IOTest name $ getLineNumber words (orgTestName name)
addLineNumber words (EquivTest name f1 f2 texp _) =
EquivTest name f1 f2 texp $ getLineNumber words (orgTestName name)
getLineNumber :: [String] -> QName -> Int
getLineNumber words (_, name) = maybe 0 (+1) (elemIndex name words)
|