Commit dd06d45a authored by Michael Hanus 's avatar Michael Hanus
Browse files

Usage of CURRYPATH added, checking of non-local module names added

parent 28b01a61
......@@ -26,7 +26,7 @@ import AbstractCurry.Transform (renameCurryModule, trCTypeExpr
,updCProg, updQNamesInCProg)
import AnsiCodes
import Distribution
import FilePath ((</>), takeDirectory)
import FilePath ((</>), pathSeparator, takeDirectory)
import qualified FlatCurry.Types as FC
import FlatCurry.Files
import qualified FlatCurry.Goodies as FCG
......@@ -35,7 +35,7 @@ import IO
import List
import Maybe (fromJust, isJust)
import ReadNumeric (readNat)
import System (system, exitWith, getArgs, getPID)
import System (system, exitWith, getArgs, getPID, getEnviron)
import CheckDetUsage (checkDetUse, containsDetOperations)
import ContractUsage
......@@ -55,7 +55,7 @@ ccBanner :: String
ccBanner = unlines [bannerLine,bannerText,bannerLine]
where
bannerText = "CurryCheck: a tool for testing Curry programs (Version " ++
packageVersion ++ " of 08/05/2017)"
packageVersion ++ " of 01/06/2017)"
bannerLine = take (length bannerText) (repeat '-')
-- Help text
......@@ -173,6 +173,10 @@ putStrIfNormal opts s = unless (isQuiet opts) (putStr s >> hFlush stdout)
putStrIfVerbose :: Options -> String -> IO ()
putStrIfVerbose opts s = when (optVerb opts > 1) (putStr s >> hFlush stdout)
--- Print second argument if verbosity level > 3:
putStrLnIfDebug :: Options -> String -> IO ()
putStrLnIfDebug opts s = when (optVerb opts > 3) (putStrLn s >> hFlush stdout)
--- use some coloring (from library AnsiCodes) if color option is on:
withColor :: Options -> (String -> String) -> String -> String
withColor opts coloring = if optColor opts then coloring else id
......@@ -752,7 +756,7 @@ analyseCurryProg opts modname orgprog = do
return .
maybe (error $ "Source file of module '"++modname++"' not found!") id
let srcdir = takeDirectory srcfilename
when (optVerb opts > 3) $ putStrLn ("Source file: " ++ srcfilename)
putStrLnIfDebug opts $ "Source file: " ++ srcfilename
prooffiles <- if optProof opts then getProofFiles srcdir else return []
unless (null prooffiles) $ putStrIfVerbose opts $
unlines ("Proof files found:" : map ("- " ++) prooffiles)
......@@ -988,7 +992,9 @@ main = do
(putStr (unlines opterrors) >> putStrLn usageText >> exitWith 1)
putStrIfNormal opts ccBanner
when (null args || optHelp opts) (putStrLn usageText >> exitWith 1)
testModules <- mapIO (analyseModule opts) (map stripCurrySuffix args)
let mods = map stripCurrySuffix args
mapIO_ checkModuleName mods
testModules <- mapIO (analyseModule opts) mods
let staticerrs = concatMap staticErrors (concat testModules)
finaltestmodules = filter testThisModule (concat testModules)
testmodname = if null (optMainProg opts)
......@@ -1005,12 +1011,17 @@ main = do
genMainTestModule opts testmodname finaltestmodules
showGeneratedModule opts "main test" testmodname
putStrIfNormal opts $ withColor opts blue $ "and compiling it...\n"
ret <- system $ unwords $ [installDir </> "bin" </> "curry"
,"--noreadline"
,":set -time"
,":set v0"
,":set parser -Wnone"
,":l "++testmodname,":eval main :q"]
currypath <- getEnviron "CURRYPATH"
let runcmd = unwords $
[ installDir </> "bin" </> "curry"
, "--noreadline"
, ":set -time"
, ":set " ++ if optVerb opts > 3 then "v1" else "v0"
, ":set parser -Wnone"
, if null currypath then "" else ":set path " ++ currypath
, ":l "++testmodname,":eval main :q" ]
putStrLnIfDebug opts $ "Executing command:\n" ++ runcmd
ret <- system runcmd
cleanup opts testmodname finaltestmodules
unless (isQuiet opts || ret /= 0) $
putStrLn $ withColor opts green $ showTestStatistics finaltestmodules
......@@ -1018,6 +1029,12 @@ main = do
where
showStaticErrors opts errs = putStrLn $ withColor opts red $
unlines (line : "STATIC ERRORS IN PROGRAMS:" : errs) ++ line
checkModuleName mn =
when (pathSeparator `elem` mn) $ do
putStrLn $ "Module names with path prefixes not allowed: " ++ mn
exitWith 1
line = take 78 (repeat '=')
showGeneratedModule :: Options -> String -> String -> IO ()
......@@ -1076,7 +1093,7 @@ generatorModule = "SearchTreeGenerators"
writeCurryProgram :: Options -> String -> CurryProg -> String -> IO ()
writeCurryProgram opts srcdir p appendix = do
let progfile = srcdir </> modNameToPath (progName p) ++ ".curry"
when (optVerb opts > 3) $ putStrLn ("Writing program: " ++ progfile)
putStrLnIfDebug opts $ "Writing program: " ++ progfile
writeFile progfile
(showCProg p ++ "\n" ++ appendix ++ "\n")
......
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