Commit f8d27619 authored by Michael Hanus 's avatar Michael Hanus

Updates w.r.t. new packages

parent a6bb628f
import Test.Prop
import SearchTreeGenerators
import Control.SearchTree.Generators
rev :: [a] -> [a]
rev [] = []
......
-- Add numbers and define a specific generator for non-negative integers
import SearchTreeGenerators
import Control.SearchTree.Generators
import Test.Prop
sumUp n = if n==0 then 0 else n + sumUp (n-1)
......
......@@ -2,7 +2,7 @@
-- Here are some examples for problems to be detected by CurryCheck
---------------------------------------------------------------------------
import SetFunctions
import Control.SetFunctions
---------------------------------------------------------------------------
-- Detection of unintended uses of set functions and functional pattern unif.
......
......@@ -13,11 +13,11 @@ runPropertyTests withcolor withtime props = do
>>= return . Maybe.catMaybes
if null failedmsgs
then return 0
else do putStrLn $ ({- if withcolor then AnsiCodes.red else -} id) $
line ++
"\nFAILURES OCCURRED IN SOME TESTS:\n" ++
unlines failedmsgs ++ line
return 1
else do
putStrLn $ (if withcolor then System.Console.ANSI.Codes.red else id) $
line ++ "\nFAILURES OCCURRED IN SOME TESTS:\n" ++
unlines failedmsgs ++ line
return 1
where
line = take 78 (repeat '=')
......@@ -49,17 +49,19 @@ instance (Show a, Show b) => Show (Func a b) where
--- Generates a search tree for functions represented by non-empty(!)
--- pair list values where the search trees for the arguments and results
--- are given as a parameter.
genFunc :: SearchTree.SearchTree a -> SearchTree.SearchTree b
-> SearchTree.SearchTree (Func a b)
genFunc :: Control.SearchTree.SearchTree a -> Control.SearchTree.SearchTree b
-> Control.SearchTree.SearchTree (Func a b)
genFunc gena genb =
SearchTreeGenerators.genCons1 Func
(genNEList (SearchTreeGenerators.genPair gena genb))
Control.SearchTree.Generators.genCons1 Func
(genNEList (Control.SearchTree.Generators.genPair gena genb))
-- Generates a search tree for non-empty list values where the search tree
-- for the elements is given as a parameter.
genNEList :: SearchTree.SearchTree a -> SearchTree.SearchTree [a]
genNEList :: Control.SearchTree.SearchTree a
-> Control.SearchTree.SearchTree [a]
genNEList genx =
SearchTreeGenerators.genCons2 (:) genx (SearchTreeGenerators.genList genx)
Control.SearchTree.Generators.genCons2 (:) genx
(Control.SearchTree.Generators.genList genx)
--- Transforms a function in list presentation into a real function.
list2Func :: Eq a => Func a b -> (a -> b)
......@@ -71,11 +73,12 @@ list2Func (Func abs) x = maybe (if null abs then failed else snd (head abs))
--- Generates a search tree for functions represented by non-empty(!)
--- pair list values where the search trees for the arguments and results
--- are given as a parameter.
genFunction :: Eq a => SearchTree.SearchTree a -> SearchTree.SearchTree b
-> SearchTree.SearchTree (a -> b)
genFunction :: Eq a => Control.SearchTree.SearchTree a
-> Control.SearchTree.SearchTree b
-> Control.SearchTree.SearchTree (a -> b)
genFunction gena genb =
SearchTreeGenerators.genCons1 l2f
(genNEList (SearchTreeGenerators.genPair gena genb))
Control.SearchTree.Generators.genCons1 l2f
(genNEList (Control.SearchTree.Generators.genPair gena genb))
where
l2f abs x = maybe (if null abs then failed else snd (head abs))
id
......
......@@ -11,9 +11,11 @@
"cass-analysis" : ">= 2.0.0",
"cass" : ">= 2.0.0",
"currypath" : ">= 0.0.1",
"easycheck" : ">= 0.0.1",
"flatcurry" : ">= 2.0.0",
"frontend-exec" : ">= 0.0.1",
"rewriting" : ">= 2.0.0",
"setfunctions" : ">= 0.0.1",
"wl-pprint" : ">= 0.0.1"
},
"compilerCompatibility": {
......
------------------------------------------------------------------------------
-- Some auxiliary operations for CurryCheck
------------------------------------------------------------------------------
module CC.Helpers ( ccLoadPath )
where
import FilePath ( splitSearchPath )
import List ( intercalate, isInfixOf )
import System ( getEnviron )
import CC.Config ( packageLoadPath )
--- Computes the load path for executing the
--- generated program that executes all checks.
--- The load path consists of the standard load path (defined by `CURRYPATH`)
--- and the additional load path for packages required by CurryCheck.
ccLoadPath :: IO String
ccLoadPath = do
ecurrypath <- getEnviron "CURRYPATH"
let ecurrypath' = case ecurrypath of ':':_ -> '.':ecurrypath
_ -> ecurrypath
return $ intercalate ":"
(if null ecurrypath' then ccExecLoadPath
else ecurrypath' : ccExecLoadPath)
--- Computes the additional load path for executing the
--- generated program that executes all checks.
ccExecLoadPath :: [String]
ccExecLoadPath =
filter isRequiredPackage (splitSearchPath packageLoadPath)
where
isRequiredPackage dir =
any (`isInfixOf` dir)
["ansi-terminal", "easycheck", "random", "searchtree", "setfunctions"]
......@@ -23,7 +23,7 @@ import FilePath ( (</>), pathSeparator, takeDirectory )
import GetOpt
import List
import Maybe ( fromJust, isJust )
import System ( system, exitWith, getArgs, getPID, getEnviron )
import System ( system, exitWith, getArgs, getPID, setEnviron )
import AbstractCurry.Types
import AbstractCurry.Files ( readCurryWithParseOptions, readUntypedCurry )
......@@ -45,6 +45,7 @@ import Text.Pretty ( pPrint )
import CC.AnalysisHelpers ( getTerminationInfos, getProductivityInfos
, getUnsafeModuleInfos, dropPublicSuffix )
import CC.Config ( packagePath, packageVersion )
import CC.Helpers ( ccLoadPath )
import CC.Options
import CheckDetUsage ( checkDetUse, containsDetOperations)
import ContractUsage
......@@ -60,7 +61,7 @@ ccBanner :: String
ccBanner = unlines [bannerLine,bannerText,bannerLine]
where
bannerText = "CurryCheck: a tool for testing Curry programs (Version " ++
packageVersion ++ " of 31/10/2018)"
packageVersion ++ " of 30/12/2018)"
bannerLine = take (length bannerText) (repeat '-')
-- Help text
......@@ -1364,7 +1365,7 @@ genMainTestModule opts mainmod orgtestmods = do
imports = nub $ [ easyCheckModule, easyCheckExecModule
, searchTreeModule, generatorModule
, "List", "Char", "Maybe", "System", "Profile"
] ++ -- TODO: import also System.Console.ANSI.Codes
, "System.Console.ANSI.Codes" ] ++
map (fst . fst) testtypes ++
map testModuleName testmods
appendix <- readFile (packagePath </> "include" </> "TestAppendix.curry")
......@@ -1591,6 +1592,9 @@ main = do
when (null args || optHelp opts) (putStrLn usageText >> exitWith 1)
let mods = map stripCurrySuffix args
mapIO_ checkModuleName mods
currypath <- ccLoadPath
--putStrLn $ "export CURRYPATH=" ++ currypath
setEnviron "CURRYPATH" currypath
testModules <- mapIO (analyseModule opts) mods
let staticerrs = concatMap staticErrors (concat testModules)
finaltestmodules = filter testThisModule (concat testModules)
......@@ -1609,9 +1613,6 @@ main = do
finaltests <- genMainTestModule opts testmodname finaltestmodules
showGeneratedModule opts "main test" testmodname
putStrIfNormal opts $ withColor opts blue $ "and compiling it...\n"
ecurrypath <- getEnviron "CURRYPATH"
let currypath = case ecurrypath of ':':_ -> '.':ecurrypath
_ -> ecurrypath
let runcmd = unwords $
[ installDir </> "bin" </> "curry"
, "--noreadline"
......@@ -1679,7 +1680,7 @@ arityOfType = length . argTypes
--- Name of the SearchTree module.
searchTreeModule :: String
searchTreeModule = "SearchTree"
searchTreeModule = "Control.SearchTree"
--- Name of SearchTree type constructor.
searchTreeTC :: QName
......@@ -1687,7 +1688,7 @@ searchTreeTC = (searchTreeModule,"SearchTree")
--- Name of the SearchTreeGenerator module.
generatorModule :: String
generatorModule = "SearchTreeGenerators"
generatorModule = "Control.SearchTree.Generators"
choiceGen :: QName
choiceGen = (generatorModule,"|||")
......
......@@ -60,5 +60,5 @@ easyCheckModule = "Test.EasyCheck"
--- Name of the EasyCheckExec module.
easyCheckExecModule :: String
easyCheckExecModule = "Test.EasyCheckExec"
easyCheckExecModule = "Test.EasyCheck.Exec"
......@@ -8,18 +8,20 @@
--- See example program `Examples/UsageErrors.curry` for some examples.
---
--- @author Michael Hanus
--- @version October 2016
--- @version December 2018
---------------------------------------------------------------------------
module UsageCheck(checkSetUse, checkBlacklistUse) where
import Char(isDigit)
import Read(readNat)
import qualified AbstractCurry.Types as AC
import AbstractCurryMatch
import Char(isDigit)
import FlatCurry.Types
import FlatCurryMatch
import Read(readNat)
import SetFunctions
import Control.SetFunctions
---------------------------------------------------------------------
--- Returns messages about unintended uses of set functions in a
......@@ -41,8 +43,10 @@ checkSetUse (Prog _ _ _ fdecls _) = do
--- To provide a simple implementation, we exploit functional patterns
--- with the function `funWithinExp`.
setUse :: [FuncDecl] -> (QName, String)
--setUse (_ ++ [funWithExp qf (Comb ct ("SetFunctions","set"++n) args)] ++ _)
setUse (_++ [funWithinExp qf _ _ (Comb ct ("SetFunctions","set"++n) args)] ++_)
--setUse (_ ++ [funWithExp qf (Comb ct ("Control.SetFunctions","set"++n) args)] ++ _)
setUse (_ ++
[funWithinExp qf _ _ (Comb ct ("Control.SetFunctions","set"++n) args)]
++ _)
| not (validSetFunCall ct n args) = (qf,n)
--- Checks whether an application of a set function is as intended.
......
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