Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
curry-packages
currycheck
Commits
dd06d45a
Commit
dd06d45a
authored
Jun 02, 2017
by
Michael Hanus
Browse files
Usage of CURRYPATH added, checking of non-local module names added
parent
28b01a61
Changes
1
Hide whitespace changes
Inline
Side-by-side
src/CurryCheck.curry
View file @
dd06d45a
...
...
@@ -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 0
8
/0
5
/2017)"
packageVersion ++ " of 0
1
/0
6
/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")
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment