Commit 28b99bd6 authored by Michael Hanus 's avatar Michael Hanus

Support to check equivalence of operations added (combinator <=>)

parent 2f5335b4
......@@ -12,7 +12,7 @@ and, thus, they are also useful to document the code.
The tool can be directly installed by the command
> cpm installbin currycheck
> cypm install currycheck
This installs the executable `curry-check` in the bin directory of CPM.
......
......@@ -548,6 +548,97 @@ sortSatisfiesSpecification :: [Int] -> Prop
sortSatisfiesSpecification x = sort x <~> sort'spec x
\end{curry}
\subsection{Checking Equivalence of Operations}
CurryCheck supports also equivalence checks for operations.
Two operations are considered as \emph{equivalent} if they
can be replaced by each other in any possible context
without changing the computed values (see \cite{AntoyHanus12PADL}
for a precise definition).
For instance, the Boolean operations
\begin{curry}
f1 :: Bool -> Bool f2 :: Bool -> Bool
f1 x = not (not x) f2 x = x
\end{curry}
are equivalent, whereas
\begin{curry}
g1 :: Bool -> Bool g2 :: Bool -> Bool
g1 False = True g2 x = True
g1 True = True
\end{curry}
are not equivalent: \code{g1 failed} has no value but
\code{g2 failed} evaluates to \code{True}.
To check the equivalence of operations, one can use the
property combinator \code{<=>}:
\begin{curry}
f1_equiv_f2 = f1 <=> f2
g1_equiv_g2 = g1 <=> g2
\end{curry}
Each argument of this combinator must be a defined operation
or a defined operation with a type annotation in order to specify
the argument types used for checking this property.
CurryCheck transforms such properties into properties
where both operations are compared w.r.t.\ all partial
values and partial results.
The details are described in an upcoming paper.
It should be noted that CurryCheck can also check
the equivalence of non-terminating operations provided
that they are \emph{productive}, i.e., always generate
(outermost) constructors after a finite number of steps
(otherwise, the test of CurryCheck might not terminate).
For instance, CurryCheck reports a counter-example to
the equivalence of the following non-terminating operations:
\begin{curry}
ints1 n = n : ints1 (n+1)$\listline$
ints2 n = n : ints2 (n+2)
-- This property will be falsified by CurryCheck:
ints1_equiv_ints2 = ints1 <=> ints2
\end{curry}
This is done by guessing depth-bounds and comparing the results
of both operations up to this depth-bound.
Since this might be a long process, CurryCheck supports
a faster comparison of operations when it is known
that they are terminating.
If the name of a test contains the suffix \code{'TERMINATE},
then CurryCheck does not iterate over depth-bounds
but evaluates operations completely.
For instance, consider the following definition of
permutation sort (the operations \code{perm} and \code{sorted}
are defined above):
\begin{curry}
psort :: Ord a => [a] -> [a]
psort xs | sorted ys = ys
where ys = perm xs
\end{curry}
A different definition can be obtained by defining
a partial identity on sorted lists:
\begin{curry}
isort :: Ord a => [a] -> [a]
isort xs = idSorted (perm xs)
where idSorted [] = []
idSorted [x] = [x]
idSorted (x:y:ys) | x<=y = x : idSorted (y:ys)
\end{curry}
We can check the equivalence of both operations by
specializing both operations on some ground type (otherwise,
the type checker reports an error due to an unspecified
type \code{Ord} context):
\begin{curry}
psort_equiv_isort = psort <=> (isort :: [Int] -> [Int])
\end{curry}
CurryCheck reports a counter example by the 274th test.
Since both operations are terminating, we can also check
the following property:
\begin{curry}
psort_equiv_isort'TERMINATE = psort <=> (isort :: [Int] -> [Int])
\end{curry}
Now a counter example is found by the 21th test.
\subsection{Checking Usage of Specific Operations}
In addition to testing dynamic properties of programs,
......@@ -567,8 +658,7 @@ Set functions \cite{AntoyHanus09} are used to encapsulate
all non-deterministic results of some function in a set structure.
Hence, for each top-level function $f$ of arity $n$,
the corresponding set function can be expressed in Curry
(via operations defined in the module
\code{SetFunctions}, see Section~\ref{Library:SetFunctions})
(via operations defined in the library \code{SetFunctions})
by the application \ccode{set$n$ $f$} (this application is used
in order to extend the syntax of Curry with a specific notation
for set functions).
......@@ -580,3 +670,8 @@ Hence, CurryCheck reports such unintended uses of set functions.
% LocalWords: CurryCheck
%%% Local Variables:
%%% mode: latex
%%% TeX-master: "main"
%%% End:
-- Testing the equivalence of non-terminating operations:
import Nat
import Test.Prop
-- Two different infinite lists:
ints1 :: Int -> [Int]
ints1 n = n : ints1 (n+1)
ints2 :: Int -> [Int]
ints2 n = n : ints2 (n+2)
-- Falsified by 47th test:
ints1_equiv_ints2 = ints1 <=> ints2
This directory contains some examples for the use
of CurryCheck to check the equivalence of operations.
Since most of these are examples to test whether CurryCheck
is able to report counter-examples, their test fails intentionally.
The module `SortISortEquiv` contains a successful equivalence test.
import Test.EasyCheck
revrev :: [a] -> [a]
revrev xs = reverse (reverse xs)
-- Test: is double reverse equivalent to the identity?
-- This is not the case if both are applied to the context
-- head (... (1:failed))
revrevid'TERMINATE = revrev <=> id
import Test.Prop
-- This is an example which shows the "non-referentiality" of Curry (according
-- to [Bacci et al. PPDP'12]), i.e., it shows that two operations, which
-- compute the same values, might compute different results in larger
-- contexts:
data AB = A | B
deriving (Eq,Show)
data C = C AB
deriving (Eq,Show)
h A = A
g x = C (h x)
g' A = C A
-- The computed result equivalence of g and g' on ground values
-- always holds, i.e., g and g' always compute same values:
g_and_g' :: AB -> Prop
g_and_g' x = g x <~> g' x
-- The contextual equivalence of g and g' does not hold:
g_equiv_g' = g <=> g'
import Test.Prop
-- Permutation sort:
psort :: Ord a => [a] -> [a]
psort xs | sorted ys = ys where ys = perm xs
perm [] = []
perm (x:xs) = ndinsert x (perm xs)
where ndinsert x ys = x : ys
ndinsert x (y:ys) = y : ndinsert x ys
sorted [] = True
sorted [_] = True
sorted (x:y:ys) = x<=y & sorted (y:ys)
-- Permutation sort in a different formulation (which is actually not
-- equivalent to psort):
isort :: Ord a => [a] -> [a]
isort xs = idSorted (perm xs)
where idSorted [] = []
idSorted [x] = [x]
idSorted (x:y:ys) | x<=y = x : idSorted (y:ys)
-- The equality of psort and isort on ground values (which always succeeds
-- when tested with CurryCheck):
--psort_and_isort x = psort x <~> isort x
-- Actually, psort and isort are not equivalent, as can be seen by evaluating
-- `head (isort [2,3,1])`.
-- Thus, we check the equivalence with CurryCheck (and provide type annotations
-- to avoid error message w.r.t. polymorphic types with unspecifed type class
-- contexts):
-- In PAKCS, the counter example is reported by the 274th test:
psort_equiv_isort = psort <=> (isort :: [Int] -> [Int])
-- In PAKCS, the counter example is reported by the 21th test:
psort_equiv_isort'TERMINATE = psort <=> (isort :: [Int] -> [Int])
import Test.Prop
-- Permutation sort:
psort :: Ord a => [a] -> [a]
psort xs | sorted ys = ys where ys = perm xs
perm [] = []
perm (x:xs) = ndinsert x (perm xs)
where ndinsert x ys = x : ys
ndinsert x (y:ys) = y : ndinsert x ys
sorted [] = True
sorted [_] = True
sorted (x:y:ys) = x<=y & sorted (y:ys)
-- Insertion sort: The list is sorted by repeated sorted insertion
-- of the elements into the already sorted part of the list.
insSort :: Ord a => [a] -> [a]
insSort [] = []
insSort (x:xs) = insert (insSort xs)
where
insert [] = [x]
insert (y:ys) = if x<=y then x : y : ys
else y : insert ys
-- Test equivalence of psort and isort (and provide type annotations
-- to avoid error message w.r.t. polymorphic types with unspecifed type class
-- contexts):
psort_equiv_insSort'TERMINATE = psort <=> (insSort :: [Int] -> [Int])
......@@ -5,9 +5,11 @@
"synopsis": "A tool to support automatic testing of Curry programs",
"category": [ "Testing" ],
"dependencies": {
"base" : ">= 1.0.0, < 2.0.0",
"abstract-curry": ">= 2.0.0",
"flatcurry" : ">= 2.0.0",
"rewriting" : ">= 2.0.0"
"rewriting" : ">= 2.0.0",
"wl-pprint" : ">= 0.0.1"
},
"compilerCompatibility": {
"pakcs": ">= 2.0.0",
......@@ -27,6 +29,9 @@
},
{ "src-dir": "examples/withVerification",
"modules": [ "ListProp", "SortSpec" ]
},
{ "src-dir": "examples/equivalent_operations",
"modules": [ "SortISortEquiv" ]
}
],
"documentation": {
......
......@@ -14,22 +14,13 @@
--- (together with possible preconditions).
---
--- @author Michael Hanus, Jan-Patrick Baye
--- @version February 2017
--- @version December 2017
-------------------------------------------------------------------------
import AbstractCurry.Types
import AbstractCurry.Files
import AbstractCurry.Select
import AbstractCurry.Build
import AbstractCurry.Pretty (showCProg)
import AbstractCurry.Transform (renameCurryModule, trCTypeExpr
,updCProg, updQNamesInCProg)
import AnsiCodes
import Char (toUpper)
import Distribution
import FilePath ((</>), pathSeparator, takeDirectory)
import qualified FlatCurry.Types as FC
import FlatCurry.Files
import qualified FlatCurry.Goodies as FCG
import GetOpt
import IO
import List
......@@ -37,6 +28,18 @@ import Maybe (fromJust, isJust)
import ReadNumeric (readNat)
import System (system, exitWith, getArgs, getPID, getEnviron)
import AbstractCurry.Types
import AbstractCurry.Files
import AbstractCurry.Select
import AbstractCurry.Build
import AbstractCurry.Pretty as ACPretty
import AbstractCurry.Transform (renameCurryModule, trCTypeExpr
,updCProg, updQNamesInCProg)
import qualified FlatCurry.Types as FC
import FlatCurry.Files
import qualified FlatCurry.Goodies as FCG
import Text.Pretty (pPrint)
import CheckDetUsage (checkDetUse, containsDetOperations)
import ContractUsage
import CurryCheckConfig (packagePath, packageVersion)
......@@ -55,7 +58,7 @@ ccBanner :: String
ccBanner = unlines [bannerLine,bannerText,bannerLine]
where
bannerText = "CurryCheck: a tool for testing Curry programs (Version " ++
packageVersion ++ " of 01/06/2017)"
packageVersion ++ " of 15/12/2017)"
bannerLine = take (length bannerText) (repeat '-')
-- Help text
......@@ -76,6 +79,7 @@ data Options = Options
, optSpec :: Bool
, optDet :: Bool
, optProof :: Bool
, optTime :: Bool
, optColor :: Bool
, optMainProg :: String
}
......@@ -94,6 +98,7 @@ defaultOptions = Options
, optSpec = True
, optDet = True
, optProof = True
, optTime = False
, optColor = True
, optMainProg = ""
}
......@@ -119,6 +124,8 @@ options =
, Option "d" ["deftype"]
(ReqArg checkDefType "<t>")
"type for defaulting polymorphic tests:\nBool | Int | Char | Ordering (default)"
, Option "t" ["time"] (NoArg (\opts -> opts { optTime = True }))
"show run time for executing each property test"
, Option "" ["nosource"]
(NoArg (\opts -> opts { optSource = False }))
"do not perform source code checks"
......@@ -198,9 +205,14 @@ isDetSuffix = "IsDeterministic"
-------------------------------------------------------------------------
-- Internal representation of tests extracted from a Curry module.
-- A test is either a property test (with a name, type, source line number)
-- or an IO test (with a name and source line number).
data Test = PropTest QName CTypeExpr Int | IOTest QName Int
-- A test is
-- * a property test (with a name, type, source line number),
-- * an IO test (with a name and source line number), or
-- * an operation equivalence test (with a name, the names of both operations,
-- and their type, and the source line number).
data Test = PropTest QName CTypeExpr Int
| IOTest QName Int
| EquivTest QName QName QName CTypeExpr Int
-- Is the test an IO test?
isIOTest :: Test -> Bool
......@@ -216,15 +228,22 @@ isPropTest :: Test -> Bool
isPropTest t = case t of PropTest _ texp _ -> not (null (argTypes texp))
_ -> False
-- Is the test an equivalence test?
isEquivTest :: Test -> Bool
isEquivTest t = case t of EquivTest _ _ _ _ _ -> True
_ -> False
-- The name of a test:
getTestName :: Test -> QName
getTestName (PropTest n _ _) = n
getTestName (IOTest n _) = n
getTestName (PropTest n _ _) = n
getTestName (IOTest n _) = n
getTestName (EquivTest n _ _ _ _) = n
-- The line number of a test:
getTestLine :: Test -> Int
getTestLine (PropTest _ _ n) = n
getTestLine (IOTest _ n) = n
getTestLine (PropTest _ _ n) = n
getTestLine (IOTest _ n) = n
getTestLine (EquivTest _ _ _ _ n) = n
-- Generates a useful error message for tests (with module and line number)
genTestMsg :: String -> Test -> String
......@@ -258,29 +277,48 @@ testThisModule :: TestModule -> Bool
testThisModule tm = null (staticErrors tm) && not (null (propTests tm))
-- Extracts all user data types used as test data generators.
userTestDataOfModule :: TestModule -> [QName]
-- Each type has a flag which is `True` if the test data should contain
-- partial values (for checking equivalence of operations).
userTestDataOfModule :: TestModule -> [(QName,Bool)]
userTestDataOfModule testmod = concatMap testDataOf (propTests testmod)
where
testDataOf (IOTest _ _) = []
testDataOf (PropTest _ texp _) = unionOn userTypesOf (argTypes texp)
userTypesOf (CTVar _) = []
userTypesOf (CFuncType from to) = union (userTypesOf from) (userTypesOf to)
userTypesOf (CTCons (mn,tc)) = if mn == preludeName then [] else [(mn,tc)]
userTypesOf (CTApply tc ta) = union (userTypesOf tc) (userTypesOf ta)
unionOn f = foldr union [] . map f
testDataOf (PropTest _ texp _) =
map (\t -> (t,False)) (filter (\ (mn,_) -> mn /= preludeName)
(unionOn tconsOf (argTypes texp)))
testDataOf (EquivTest _ _ _ texp _) =
map (\t -> (t,True)) (unionOn tconsOf (argTypes texp))
-- Extracts all result data types used in equivalence properties.
equivPropTypes :: TestModule -> [QName]
equivPropTypes testmod = concatMap equivTypesOf (propTests testmod)
where
equivTypesOf (IOTest _ _) = []
equivTypesOf (PropTest _ _ _) = []
equivTypesOf (EquivTest _ _ _ texp _) = tconsOf (resultType texp)
-------------------------------------------------------------------------
-- Transform all tests of a module into an appropriate call of EasyCheck:
-- Transform all tests of a module into operations that perform
-- appropriate calls to EasyCheck:
createTests :: Options -> String -> TestModule -> [CFuncDecl]
createTests opts mainmodname tm = map createTest (propTests tm)
createTests opts mainmod tm = map createTest (propTests tm)
where
createTest test =
cfunc (mainmodname, (genTestName $ getTestName test)) 0 Public
cfunc (mainmod, (genTestName $ getTestName test)) 0 Public
(emptyClassType (ioType (maybeType stringType)))
(case test of PropTest name t _ -> propBody name (argTypes t) test
IOTest name _ -> ioTestBody name test)
(case test of
PropTest name t _ -> propBody name t test
IOTest name _ -> ioTestBody name test
EquivTest name f1 f2 t _ ->
-- if test name has suffix "'TERMINATE", the test for terminating
-- operations is used, otherwise the test for arbitrary
-- operations (which limits the size of computed results
-- but might find counter-examples later)
-- (TODO: automatic selection by using CASS)
if "'TERMINATE" `isSuffixOf` map toUpper (snd name)
then equivBodyTerm f1 f2 t test
else equivBodyAny f1 f2 t test
)
msgOf test = string2ac $ genTestMsg (orgModuleName tm) test
......@@ -294,26 +332,55 @@ createTests opts mainmodname tm = map createTest (propTests tm)
" parameters are currently not supported!"
else (easyCheckExecModule,"checkWithValues" ++ show arity)
propBody (_, name) argtypes test =
-- Operation equivalence test for terminating operations:
equivBodyTerm f1 f2 texp test =
let xvar = (1,"x")
pvalOfFunc = ctype2pvalOf mainmod "pvalOf" (resultType texp)
in propOrEquivBody (map (\t -> (t,True)) (argTypes texp)) test
(CLambda [CPVar xvar]
(applyF (easyCheckModule,"<~>")
[applyE pvalOfFunc [applyF f1 [CVar xvar]],
applyE pvalOfFunc [applyF f2 [CVar xvar]]]))
-- Operation equivalence test for arbitrary operations:
equivBodyAny f1 f2 texp test =
let xvar = (1,"x")
pvar = (2,"p")
pvalOfFunc = ctype2pvalOf mainmod "peval" (resultType texp)
in propOrEquivBody
(map (\t -> (t,True)) (argTypes texp) ++
[(ctype2BotType mainmod (resultType texp), False)])
test
(CLambda [CPVar xvar, CPVar pvar]
(applyF (easyCheckModule,"<~>")
[applyE pvalOfFunc [applyF f1 [CVar xvar], CVar pvar],
applyE pvalOfFunc [applyF f2 [CVar xvar], CVar pvar]]))
propBody qname texp test =
propOrEquivBody (map (\t -> (t,False)) (argTypes texp))
test (CSymbol (testmname,snd qname))
propOrEquivBody argtypes test propexp =
[simpleRule [] $
CLetDecl [CLocalPat (CPVar msgvar) (CSimpleRhs (msgOf test) [])]
(applyF (easyCheckExecModule, "checkPropWithMsg")
[CVar msgvar
,applyF (easyCheckFuncName (length argtypes)) $
CLetDecl [CLocalPat (CPVar msgvar) (CSimpleRhs (msgOf test) [])]
(applyF (easyCheckExecModule, "checkPropWithMsg")
[ CVar msgvar
, applyF (easyCheckFuncName (length argtypes)) $
[configOpWithMaxFail, CVar msgvar] ++
(map (\t ->
(map (\ (t,genpart) ->
applyF (easyCheckModule,"valuesOfSearchTree")
[if isPAKCS || useUserDefinedGen t || isFloatType t
then type2genop mainmodname tm t
then type2genop mainmod tm genpart t
else applyF (searchTreeModule,"someSearchTree")
[constF (pre "unknown")]])
argtypes) ++
[CSymbol (testmname,name)]
])]
[propexp]
])]
where
useUserDefinedGen texp = case texp of
CTVar _ -> error "No polymorphic generator!"
CFuncType _ _ -> error "No generator for functional types!"
CFuncType _ _ -> error $ "No generator for functional types:\n" ++
showCTypeExpr texp
CTApply _ _ ->
maybe (error "No generator for type applications!")
(\ ((_,tc),_) -> isJust
......@@ -351,41 +418,54 @@ easyCheckConfig opts =
else "easyConfig")
-- Translates a type expression into calls to generator operations.
type2genop :: String -> TestModule -> CTypeExpr -> CExpr
type2genop _ _ (CTVar _) = error "No polymorphic generator!"
type2genop _ _ (CFuncType _ _) = error "No generator for functional types!"
type2genop mainmod tm (CTCons qt) =
constF (typename2genopname mainmod (generators tm) qt)
type2genop mainmod tm te@(CTApply _ _) =
-- If the third argument is `True`, calls to partial generators are used.
type2genop :: String -> TestModule -> Bool -> CTypeExpr -> CExpr
type2genop _ _ _ (CTVar _) = error "No polymorphic generator!"
type2genop _ _ _ te@(CFuncType _ _) =
error $ "No generator for functional types:\n" ++ showCTypeExpr te
type2genop mainmod tm genpart (CTCons qt) =
constF (typename2genopname mainmod (generators tm) genpart qt)
type2genop mainmod tm genpart te@(CTApply _ _) =
maybe (error "No generator for type applications!")
(\ (qt,targs) -> applyF (typename2genopname mainmod (generators tm) qt)
(map (type2genop mainmod tm) targs))
(\ (qt,targs) ->
applyF (typename2genopname mainmod (generators tm) genpart qt)
(map (type2genop mainmod tm genpart) targs))
(tconsArgsOfType te)
isFloatType :: CTypeExpr -> Bool
isFloatType texp = case texp of CTCons tc -> tc == (preludeName,"Float")
_ -> False
typename2genopname :: String -> [QName] -> QName -> QName
typename2genopname mainmod definedgenops (mn,tc)
-- Translates the name of a type constructor into the name of the
-- generator operation for values of this type.
-- The first argument is the name of the main module.
-- The second argument contains the user-defined generator operations.
-- If the third argument is `True`, generators for partial values are used.
typename2genopname :: String -> [QName] -> Bool -> QName -> QName
typename2genopname mainmod definedgenops genpart (mn,tc)
| genpart -- we use our own generator for partial values:
= (mainmod, "gen_" ++ modNameToId mn ++ "_" ++ transQN tc ++ "_PARTIAL")
| isJust maybeuserdefined -- take user-defined generator:
= fromJust maybeuserdefined
| mn==preludeName &&
tc `elem` ["Bool","Int","Float","Char","Maybe","Either","Ordering"]
= (generatorModule, "gen" ++ tc)
| mn==preludeName && tc `elem` ["[]","()","(,)","(,,)","(,,,)","(,,,,)"]
= (generatorModule, "gen" ++ transTC tc)
| mn==preludeName
= (generatorModule, "gen" ++ transQN tc)
| otherwise -- we use our own generator:
= (mainmod, "gen_" ++ modNameToId mn ++ "_" ++ tc)
= (mainmod, "gen_" ++ modNameToId mn ++ "_" ++ transQN tc ++
if genpart then "_PARTIAL" else "")
where
maybeuserdefined = find (\qn -> "gen"++tc == snd qn) definedgenops
transTC tcons | tcons == "[]" = "List"
| tcons == "()" = "Unit"
| tcons == "(,)" = "Pair"
| tcons == "(,,)" = "Triple"
| tcons == "(,,,)" = "Tuple4"
| tcons == "(,,,,)" = "Tuple5"
-- Transform a qualified (typ) constructor name into a name
-- with alpha-numeric characters.
transQN :: String -> String
transQN tcons | tcons == "[]" = "List"
| tcons == ":" = "Cons"
| tcons == "()" = "Unit"
| tcons == "(,)" = "Pair"
| tcons == "(,,)" = "Triple"
| tcons == "(,,,)" = "Tuple4"
| tcons == "(,,,,)" = "Tuple5"
| otherwise = tcons
-------------------------------------------------------------------------
-- Turn all functions into public ones.
......@@ -417,13 +497,36 @@ makeAllPublic (CurryProg modname imports dfltdecl clsdecls instdecls
CmtFunc cmt name arity Public typeExpr rules
-- classify the tests as either PropTest or IOTest
classifyTests :: [CFuncDecl] -> [Test]
classifyTests = map makeProperty
classifyTests :: Options -> CurryProg -> [CFuncDecl] -> [Test]
classifyTests opts prog = map makeProperty
where
makeProperty test = if isPropIOType ftype
then IOTest (funcName test) 0
else PropTest (funcName test) ftype 0
where ftype = typeOfQualType (funcType test)
makeProperty test =
if isPropIOType (typeOfQualType (funcType test))
then IOTest tname 0
else maybe (PropTest tname (typeOfQualType (funcType test)) 0)
expsToEquivTest
(isEquivProperty test)
where
tname = funcName test
expsToEquivTest exps = case exps of
(CSymbol f1,CSymbol f2) ->
EquivTest tname f1 f2 (defaultingType (funcTypeOf f1)) 0
(CTyped (CSymbol f1) qtexp, CSymbol f2) ->
EquivTest tname f1 f2 (defaultingType qtexp) 0
(CSymbol f1, CTyped (CSymbol f2) qtexp) ->
EquivTest tname f1 f2 (defaultingType qtexp) 0
(CTyped (CSymbol f1) qtexp, CTyped (CSymbol f2) _) ->
EquivTest tname f1 f2 (defaultingType qtexp) 0
(e1,e2) -> error $ "Illegal equivalence property:\n" ++
showCExpr e1 ++ " <=> " ++ showCExpr e2
defaultingType = poly2defaultType (optDefType opts) . typeOfQualType
. defaultQualType
funcTypeOf f = maybe (error $ "Cannot find type of " ++ show f ++ "!")
funcType
(find (\fd -> funcName fd == f) (functions prog))
-- Extracts all tests from a given Curry module and transforms
-- all polymorphic tests into tests on a base type.
......@@ -626,7 +729,7 @@ poly2default dt fdecl@(CFunc (mn,fname) arity vis qftype rs)
| isPolyType ftype
= [(False,fdecl)
,(True, CFunc (mn,fname++defTypeSuffix) arity vis
(emptyClassType (p2dt ftype))
(emptyClassType (poly2defaultType dt ftype))
[simpleRule [] (applyF (mn,fname) [])])
]
| otherwise
......@@ -634,6 +737,9 @@ poly2default dt fdecl@(CFunc (mn,fname) arity vis qftype rs)
where
CQualType clscon ftype = defaultQualType qftype
poly2defaultType :: String -> CTypeExpr -> CTypeExpr
poly2defaultType dt texp = p2dt texp
where
p2dt (CTVar _) = baseType (pre dt)
p2dt (CFuncType t1 t2) = CFuncType (p2dt t1) (p2dt t2)
p2dt (CTApply t1 t2) = CTApply (p2dt t1) (p2dt t2)
......@@ -783,12 +889,14 @@ analyseCurryProg opts modname orgprog = do
let tm = TestModule modname
(progName pubmod)
staticerrs
(addLinesNumbers words (classifyTests rawTests))
(addLinesNumbers words
(classifyTests opts pubmod rawTests))
(generatorsOfProg pubmod)
dettm = TestModule modname
(progName pubdetmod)