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

Specifications are checked as equivalent to implementations, ground equivalence testing added

parent 570544cb
...@@ -473,81 +473,6 @@ or we simply reuse the old definition by ...@@ -473,81 +473,6 @@ or we simply reuse the old definition by
sumUpIsCorrectOnNonNeg = sumUpIsCorrect . nonNeg sumUpIsCorrectOnNonNeg = sumUpIsCorrect . nonNeg
\end{curry} \end{curry}
\subsection{Checking Contracts and Specifications}
\label{sec:currycheck:contracts}
The expressive power of Curry supports
writing high-level specifications
as well as efficient implementations for a given problem
in the same programming language,
as discussed in \cite{AntoyHanus12PADL}.
If a specification or contract is provided for some function,
then CurryCheck automatically generates properties
to test this specification or contract.
Following the notation proposed in \cite{AntoyHanus12PADL},
a \emph{specification}\index{specification}
for an operation $f$ is an operation \code{$f$'spec}
of the same type as $f$.
A \emph{contract}\index{constract} consists
of a pre- and a postcondition, where the precondition could be omitted.
A \emph{precondition}\index{precondition} for an operation $f$
of type $\tau \to \tau'$ is an operation
\begin{curry}
$f$'pre :: $\tau$ ->$~$Bool
\end{curry}
whereas
a \emph{postcondition}\index{postcondition} for $f$
is an operation
\begin{curry}
$f$'post :: $\tau$ ->$~\tau'$ ->$~$Bool
\end{curry}
which relates input and output values
(the generalization to operations with more than one argument
is straightforward).
As a concrete example, consider again the problem of sorting a list.
We can write a postcondition and a specification for
a sort operation \code{sort} and an implementation via quicksort
as follows (where \code{sorted} and \code{perm}
are defined as above):
\begin{curry}
-- Postcondition: input and output lists should have the same length
sort'post xs ys = length xs == length ys
-- Specification:
-- A correct result is a permutation of the input which is sorted.
sort'spec :: [Int] -> [Int]
sort'spec xs | ys == perm xs && sorted ys = ys where ys free
-- An implementation of sort with quicksort:
sort :: [Int] -> [Int]
sort [] = []
sort (x:xs) = sort (filter (<x) xs) ++ [x] ++ sort (filter (>=x) xs)
\end{curry}
%
If we process this program with CurryCheck,
properties to check the specification and postcondition
are automatically generated. For instance,
a specification is satisfied if it yields the same values as
the implementation, and a postcondition is satisfied
if each value computed for some input satisfies the postcondition
relation between input and output. For our example, CurryCheck generates
the following properties (if there are also
preconditions for some operation, these preconditions are used
to restrict the test cases via the condition operater \ccode{==>}):
\begin{curry}
sortSatisfiesPostCondition :: [Int] -> Prop
sortSatisfiesPostCondition x =
let r = sort x
in (r == r) ==> always (sort'post x r)
sortSatisfiesSpecification :: [Int] -> Prop
sortSatisfiesSpecification x = sort x <~> sort'spec x
\end{curry}
\subsection{Checking Equivalence of Operations} \subsection{Checking Equivalence of Operations}
CurryCheck supports also equivalence tests for operations. CurryCheck supports also equivalence tests for operations.
...@@ -673,9 +598,99 @@ Otherwise, the equivalence property is \emph{not} tested. ...@@ -673,9 +598,99 @@ Otherwise, the equivalence property is \emph{not} tested.
Thus, this mode is useful if one wants to ensure that all Thus, this mode is useful if one wants to ensure that all
equivalence tests always terminate (provided that the additional equivalence tests always terminate (provided that the additional
user annotations are correct). user annotations are correct).
\item[\code{ground}:]
In this mode, only ground equivalence is tested, i.e.,
each equivalence property
\begin{curry}
g1_equiv_g2 = g1 <=> g2
\end{curry}
is transformed into a property which states that both
operations must deliver the same values on same input values, i.e.,
\begin{curry}
g1_equiv_g2 x1 ... xn = g1 x1 ... xn <~> g2 x1 ... xn
\end{curry}
Note this property is more restrictive than contextual equivalence.
For instance, the non-equivalence of \code{g1} and \code{g2}
as shown above cannot be detected by testing ground equivalence only.
\end{description} \end{description}
\subsection{Checking Contracts and Specifications}
\label{sec:currycheck:contracts}
The expressive power of Curry supports
writing high-level specifications
as well as efficient implementations for a given problem
in the same programming language,
as discussed in \cite{AntoyHanus12PADL}.
If a specification or contract is provided for some function,
then CurryCheck automatically generates properties
to test this specification or contract.
Following the notation proposed in \cite{AntoyHanus12PADL},
a \emph{specification}\index{specification}
for an operation $f$ is an operation \code{$f$'spec}
of the same type as $f$.
A \emph{contract}\index{constract} consists
of a pre- and a postcondition, where the precondition could be omitted.
A \emph{precondition}\index{precondition} for an operation $f$
of type $\tau \to \tau'$ is an operation
\begin{curry}
$f$'pre :: $\tau$ ->$~$Bool
\end{curry}
whereas
a \emph{postcondition}\index{postcondition} for $f$
is an operation
\begin{curry}
$f$'post :: $\tau$ ->$~\tau'$ ->$~$Bool
\end{curry}
which relates input and output values
(the generalization to operations with more than one argument
is straightforward).
As a concrete example, consider again the problem of sorting a list.
We can write a postcondition and a specification for
a sort operation \code{sort} and an implementation via quicksort
as follows (where \code{sorted} and \code{perm}
are defined as above):
\begin{curry}
-- Postcondition: input and output lists should have the same length
sort'post xs ys = length xs == length ys
-- Specification:
-- A correct result is a permutation of the input which is sorted.
sort'spec :: [Int] -> [Int]
sort'spec xs | ys == perm xs && sorted ys = ys where ys free
-- An implementation of sort with quicksort:
sort :: [Int] -> [Int]
sort [] = []
sort (x:xs) = sort (filter (<x) xs) ++ [x] ++ sort (filter (>=x) xs)
\end{curry}
%
If we process this program with CurryCheck,
properties to check the specification and postcondition
are automatically generated. For instance,
a specification is satisfied if it is equivalent to its
implementation, and a postcondition is satisfied
if each value computed for some input satisfies the postcondition
relation between input and output. For our example, CurryCheck generates
the following properties (if there are also
preconditions for some operation, these preconditions are used
to restrict the test cases via the condition operater \ccode{==>}):
\begin{curry}
sortSatisfiesPostCondition :: [Int] -> Prop
sortSatisfiesPostCondition x =
let r = sort x
in (r == r) ==> always (sort'post x r)
sortSatisfiesSpecification :: Prop
sortSatisfiesSpecification = sort <=> sort'spec
\end{curry}
\subsection{Checking Usage of Specific Operations} \subsection{Checking Usage of Specific Operations}
In addition to testing dynamic properties of programs, In addition to testing dynamic properties of programs,
......
...@@ -20,7 +20,8 @@ sort'post xs ys = length xs == length ys ...@@ -20,7 +20,8 @@ sort'post xs ys = length xs == length ys
-- Specification of sort: -- Specification of sort:
-- A list is a sorted result of an input if it is a permutation and sorted. -- A list is a sorted result of an input if it is a permutation and sorted.
sort'spec :: [Int] -> [Int] sort'spec :: [Int] -> [Int]
sort'spec xs | ys == perm xs && sorted ys = ys where ys free sort'spec xs | sorted ys = ys
where ys = perm xs
-- An implementation of sort with quicksort: -- An implementation of sort with quicksort:
sort :: [Int] -> [Int] sort :: [Int] -> [Int]
......
--- Example stating the equivalence of an iterative implementation
--- of the factorial function and its recursive specification.
import Test.Prop
-- Recursive definition of factorial.
-- Requires precondition to avoid infinite loops.
fac'spec :: Int -> Int
fac'spec n = if n==0 then 1 else n * fac (n-1)
fac'spec'pre :: Int -> Bool
fac'spec'pre n = n >= 0
-- An iterative implementation of the factorial function.
-- Note that this implementation delivers 1 for negative numbers.
fac :: Int -> Int
fac n = fac' 1 1
where
fac' m p = if m>n then p else fac' (m+1) (m*p)
\ No newline at end of file
...@@ -26,7 +26,8 @@ sort'post xs ys = length xs == length ys && sorted ys ...@@ -26,7 +26,8 @@ sort'post xs ys = length xs == length ys && sorted ys
-- Specification of sort: -- Specification of sort:
-- A list is a sorted result of an input if it is a permutation and sorted. -- A list is a sorted result of an input if it is a permutation and sorted.
sort'spec :: [Int] -> [Int] sort'spec :: [Int] -> [Int]
sort'spec xs | ys == perm xs && sorted ys = ys where ys free sort'spec xs | sorted ys = ys
where ys = perm xs
-- An implementation of sort with quicksort: -- An implementation of sort with quicksort:
sort :: [Int] -> [Int] sort :: [Int] -> [Int]
......
...@@ -26,14 +26,18 @@ ...@@ -26,14 +26,18 @@
{ "src-dir": "examples", { "src-dir": "examples",
"options": "-m70", "options": "-m70",
"modules": [ "DefaultRulesTest", "DetOperations", "ExampleTests", "modules": [ "DefaultRulesTest", "DetOperations", "ExampleTests",
"ExamplesFromManual", "FloatTest", "ListSpecifications", "ExamplesFromManual", "FloatTest",
"Nats", "SEBF", "Sum", "SortSpec", "Tree" ] "Nats", "SEBF", "Sum", "SortSpec", "Tree" ]
}, },
{ "src-dir": "examples",
"options": "-m70 -e ground",
"modules": [ "ListSpecifications" ]
},
{ "src-dir": "examples/withVerification", { "src-dir": "examples/withVerification",
"modules": [ "ListProp", "SortSpec" ] "modules": [ "ListProp", "SortSpec" ]
}, },
{ "src-dir": "examples/equivalent_operations", { "src-dir": "examples/equivalent_operations",
"modules": [ "SortISortEquiv" ] "modules": [ "Fac", "SortISortEquiv" ]
} }
], ],
"documentation": { "documentation": {
......
...@@ -53,7 +53,7 @@ defaultOptions = Options ...@@ -53,7 +53,7 @@ defaultOptions = Options
} }
--- Options for equivalence tests. --- Options for equivalence tests.
data EquivOption = Safe | Autoselect | Manual data EquivOption = Safe | Autoselect | Manual | Ground
deriving Eq deriving Eq
-- Definition of actual command line options. -- Definition of actual command line options.
...@@ -79,7 +79,7 @@ options = ...@@ -79,7 +79,7 @@ options =
"type for defaulting polymorphic tests:\nBool | Int | Char | Ordering (default)" "type for defaulting polymorphic tests:\nBool | Int | Char | Ordering (default)"
, Option "e" ["equivalence"] , Option "e" ["equivalence"]
(ReqArg checkEquivOption "<e>") (ReqArg checkEquivOption "<e>")
"option for equivalence tests:\nsafe | autoselect | manual (default)" "option for equivalence tests:\nsafe | autoselect | manual (default) | ground"
, Option "t" ["time"] (NoArg (\opts -> opts { optTime = True })) , Option "t" ["time"] (NoArg (\opts -> opts { optTime = True }))
"show run time for executing each property test" "show run time for executing each property test"
, Option "" ["nosource"] , Option "" ["nosource"]
...@@ -126,6 +126,7 @@ options = ...@@ -126,6 +126,7 @@ options =
| ls `isPrefixOf` "SAFE" = opts { optEquiv = Safe } | ls `isPrefixOf` "SAFE" = opts { optEquiv = Safe }
| ls `isPrefixOf` "AUTOSELECT" = opts { optEquiv = Autoselect } | ls `isPrefixOf` "AUTOSELECT" = opts { optEquiv = Autoselect }
| ls `isPrefixOf` "MANUAL" = opts { optEquiv = Manual } | ls `isPrefixOf` "MANUAL" = opts { optEquiv = Manual }
| ls `isPrefixOf` "GROUND" = opts { optEquiv = Ground }
| otherwise = error "Illegal equivalence option (try `-h' for help)" | otherwise = error "Illegal equivalence option (try `-h' for help)"
where ls = map toUpper s where ls = map toUpper s
......
...@@ -14,7 +14,7 @@ ...@@ -14,7 +14,7 @@
--- (together with possible preconditions). --- (together with possible preconditions).
--- ---
--- @author Michael Hanus, Jan-Patrick Baye --- @author Michael Hanus, Jan-Patrick Baye
--- @version August 2018 --- @version October 2018
------------------------------------------------------------------------- -------------------------------------------------------------------------
import AnsiCodes import AnsiCodes
...@@ -56,7 +56,7 @@ ccBanner :: String ...@@ -56,7 +56,7 @@ ccBanner :: String
ccBanner = unlines [bannerLine,bannerText,bannerLine] ccBanner = unlines [bannerLine,bannerText,bannerLine]
where where
bannerText = "CurryCheck: a tool for testing Curry programs (Version " ++ bannerText = "CurryCheck: a tool for testing Curry programs (Version " ++
packageVersion ++ " of 24/08/2018)" packageVersion ++ " of 08/10/2018)"
bannerLine = take (length bannerText) (repeat '-') bannerLine = take (length bannerText) (repeat '-')
-- Help text -- Help text
...@@ -149,18 +149,20 @@ genTestName test = ...@@ -149,18 +149,20 @@ genTestName test =
-- * test operations -- * test operations
-- * name of generators defined in this module (i.e., starting with "gen" -- * name of generators defined in this module (i.e., starting with "gen"
-- and of appropriate result type) -- and of appropriate result type)
-- * the names of functions with preconditions defined in the test module
data TestModule = TestModule data TestModule = TestModule
{ orgModuleName :: String { orgModuleName :: String
, testModuleName :: String , testModuleName :: String
, staticErrors :: [String] , staticErrors :: [String]
, propTests :: [Test] , propTests :: [Test]
, generators :: [QName] , generators :: [QName]
, preConditions :: [QName]
} }
-- A test module with only static errors. -- A test module with only static errors.
staticErrorTestMod :: String -> [String] -> TestModule staticErrorTestMod :: String -> [String] -> TestModule
staticErrorTestMod modname staterrs = staticErrorTestMod modname staterrs =
TestModule modname modname staterrs [] [] TestModule modname modname staterrs [] [] []
-- Is this a test module that should be tested? -- Is this a test module that should be tested?
testThisModule :: TestModule -> Bool testThisModule :: TestModule -> Bool
...@@ -250,9 +252,10 @@ genTestFuncs opts terminating productivity mainmod tm = ...@@ -250,9 +252,10 @@ genTestFuncs opts terminating productivity mainmod tm =
pvalOfFunc = ctype2pvalOf mainmod "pvalOf" (resultType texp) pvalOfFunc = ctype2pvalOf mainmod "pvalOf" (resultType texp)
in propOrEquivBody (map (\t -> (t,True)) (argTypes texp)) test in propOrEquivBody (map (\t -> (t,True)) (argTypes texp)) test
(cLambda (map CPVar xvars) (cLambda (map CPVar xvars)
(applyF (easyCheckModule,"<~>") (addPreCond (preConditions tm) [f1,f2] xvars
[applyE pvalOfFunc [applyF f1 (map CVar xvars)], (applyF (easyCheckModule,"<~>")
applyE pvalOfFunc [applyF f2 (map CVar xvars)]])) [applyE pvalOfFunc [applyF f1 (map CVar xvars)],
applyE pvalOfFunc [applyF f2 (map CVar xvars)]])))
-- Operation equivalence test for arbitrary operations: -- Operation equivalence test for arbitrary operations:
equivBodyAny f1 f2 texp test = equivBodyAny f1 f2 texp test =
...@@ -264,9 +267,10 @@ genTestFuncs opts terminating productivity mainmod tm = ...@@ -264,9 +267,10 @@ genTestFuncs opts terminating productivity mainmod tm =
[(ctype2BotType mainmod (resultType texp), False)]) [(ctype2BotType mainmod (resultType texp), False)])
test test
(CLambda (map CPVar xvars ++ [CPVar pvar]) (CLambda (map CPVar xvars ++ [CPVar pvar])
(applyF (easyCheckModule,"<~>") (addPreCond (preConditions tm) [f1,f2] xvars
[applyE pvalOfFunc [applyF f1 (map CVar xvars), CVar pvar], (applyF (easyCheckModule,"<~>")
applyE pvalOfFunc [applyF f2 (map CVar xvars), CVar pvar]])) [applyE pvalOfFunc [applyF f1 (map CVar xvars), CVar pvar],
applyE pvalOfFunc [applyF f2 (map CVar xvars), CVar pvar]])))
propBody qname texp test = propBody qname texp test =
propOrEquivBody (map (\t -> (t,False)) (argTypes texp)) propOrEquivBody (map (\t -> (t,False)) (argTypes texp))
...@@ -408,30 +412,29 @@ makeAllPublic (CurryProg modname imports dfltdecl clsdecls instdecls ...@@ -408,30 +412,29 @@ makeAllPublic (CurryProg modname imports dfltdecl clsdecls instdecls
makePublic (CmtFunc cmt name arity _ typeExpr rules) = makePublic (CmtFunc cmt name arity _ typeExpr rules) =
CmtFunc cmt name arity Public typeExpr rules CmtFunc cmt name arity Public typeExpr rules
-- classify the tests as either PropTest or IOTest -- Classify the test represented by a function declaration
classifyTests :: Options -> CurryProg -> [CFuncDecl] -> [Test] -- as either PropTest or IOTest.
classifyTests opts prog = map makeProperty classifyTest :: Options -> CurryProg -> CFuncDecl -> Test
classifyTest opts prog test =
if isPropIOType (typeOfQualType (funcType test))
then IOTest tname 0
else maybe (PropTest tname (typeOfQualType (funcType test)) 0)
expsToEquivTest
(isEquivProperty test)
where where
makeProperty test = tname = funcName test
if isPropIOType (typeOfQualType (funcType test))
then IOTest tname 0 expsToEquivTest exps = case exps of
else maybe (PropTest tname (typeOfQualType (funcType test)) 0) (CSymbol f1,CSymbol f2) ->
expsToEquivTest EquivTest tname f1 f2 (defaultingType (funcTypeOf f1)) 0
(isEquivProperty test) (CTyped (CSymbol f1) qtexp, CSymbol f2) ->
where EquivTest tname f1 f2 (defaultingType qtexp) 0
tname = funcName test (CSymbol f1, CTyped (CSymbol f2) qtexp) ->
EquivTest tname f1 f2 (defaultingType qtexp) 0
expsToEquivTest exps = case exps of (CTyped (CSymbol f1) qtexp, CTyped (CSymbol f2) _) ->
(CSymbol f1,CSymbol f2) -> EquivTest tname f1 f2 (defaultingType qtexp) 0
EquivTest tname f1 f2 (defaultingType (funcTypeOf f1)) 0 (e1,e2) -> error $ "Illegal equivalence property:\n" ++
(CTyped (CSymbol f1) qtexp, CSymbol f2) -> showCExpr e1 ++ " <=> " ++ showCExpr e2
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 opts . typeOfQualType . defaultQualType defaultingType = poly2defaultType opts . typeOfQualType . defaultQualType
...@@ -441,10 +444,12 @@ classifyTests opts prog = map makeProperty ...@@ -441,10 +444,12 @@ classifyTests opts prog = map makeProperty
-- Extracts all tests from a given Curry module and transforms -- Extracts all tests from a given Curry module and transforms
-- all polymorphic tests into tests on a base type. -- all polymorphic tests into tests on a base type.
-- The result contains a triple consisting of all actual tests, -- The result contains a tuple consisting of all actual tests,
-- all ignored tests, and the public version of the original module. -- all ignored tests, the name of all operations with defined preconditions
-- (needed to generate meaningful equivalence tests),
-- and the public version of the original module.
transformTests :: Options -> String -> CurryProg transformTests :: Options -> String -> CurryProg
-> IO ([CFuncDecl],[CFuncDecl],CurryProg) -> IO ([CFuncDecl],[CFuncDecl],[QName],CurryProg)
transformTests opts srcdir transformTests opts srcdir
prog@(CurryProg mname imps dfltdecl clsdecls instdecls prog@(CurryProg mname imps dfltdecl clsdecls instdecls
typeDecls functions opDecls) = do typeDecls functions opDecls) = do
...@@ -459,7 +464,8 @@ transformTests opts srcdir ...@@ -459,7 +464,8 @@ transformTests opts srcdir
-- generate post condition tests: -- generate post condition tests:
postCondTests = concatMap (genPostCondTest preCondOps postCondOps) funcs postCondTests = concatMap (genPostCondTest preCondOps postCondOps) funcs
-- generate specification tests: -- generate specification tests:
specOpTests = concatMap (genSpecTest preCondOps specOps) funcs specOpTests = concatMap (genSpecTest opts preCondOps specOps) funcs
grSpecOpTests = if optEquiv opts == Ground then specOpTests else []
(realtests,ignoredtests) = partition fst $ (realtests,ignoredtests) = partition fst $
if not (optProp opts) if not (optProp opts)
...@@ -468,9 +474,11 @@ transformTests opts srcdir ...@@ -468,9 +474,11 @@ transformTests opts srcdir
-- ignore already proved properties: -- ignore already proved properties:
filter (\fd -> funcName fd `notElem` map funcName theofuncs) filter (\fd -> funcName fd `notElem` map funcName theofuncs)
usertests ++ usertests ++
(if optSpec opts then postCondTests ++ specOpTests else []) (if optSpec opts then grSpecOpTests ++ postCondTests else [])
return (map snd realtests, return (map snd realtests ++
(if optSpec opts && optEquiv opts /= Ground then specOpTests else []),
map snd ignoredtests, map snd ignoredtests,
preCondOps,
CurryProg mname CurryProg mname
(nub (easyCheckModule:imps)) (nub (easyCheckModule:imps))
dfltdecl clsdecls instdecls dfltdecl clsdecls instdecls
...@@ -478,8 +486,28 @@ transformTests opts srcdir ...@@ -478,8 +486,28 @@ transformTests opts srcdir
(simpfuncs ++ map snd (realtests ++ ignoredtests)) (simpfuncs ++ map snd (realtests ++ ignoredtests))
opDecls) opDecls)
where where
(usertests, funcs) = partition isProperty functions (rawusertests, funcs) = partition isProperty functions
usertests = if optEquiv opts == Ground
then map equivProp2Ground rawusertests
else rawusertests
-- transform an equivalence property (f1 <=> f2) into a property
-- testing ground equivalence, i.e., f1 x1...xn <~> f2 x1...xn
equivProp2Ground fdecl =
maybe fdecl
(\ _ -> case classifyTest opts prog fdecl of
EquivTest _ f1 f2 texp _ ->
let ar = arityOfType texp
cvars = map (\i -> (i,"x"++show i)) [1 .. ar]
in stFunc (funcName fdecl) ar Public (propResultType texp)
[simpleRule (map CPVar cvars)
(applyF (easyCheckModule,"<~>")
[applyF f1 (map CVar cvars),
applyF f2 (map CVar cvars)])]
_ -> error "transformTests: internal error"
)
(isEquivProperty fdecl)
-- Extracts all determinism tests from a given Curry module and -- Extracts all determinism tests from a given Curry module and
-- transforms deterministic operations back into non-deterministic operations -- transforms deterministic operations back into non-deterministic operations
...@@ -540,18 +568,14 @@ propResultType te = case te of ...@@ -540,18 +568,14 @@ propResultType te = case te of
-- fSatisfiesPostCondition x1...xn y = always (f'post x1...xn (f x1...xn)) -- fSatisfiesPostCondition x1...xn y = always (f'post x1...xn (f x1...xn))
genPostCondTest :: [QName] -> [QName] -> CFuncDecl -> [CFuncDecl] genPostCondTest :: [QName] -> [QName] -> CFuncDecl -> [CFuncDecl]
genPostCondTest prefuns postops (CmtFunc _ qf ar vis texp rules) = genPostCondTest prefuns postops (CmtFunc _ qf ar vis texp rules) =
genSpecTest prefuns postops (CFunc qf ar vis texp rules) genPostCondTest prefuns postops (CFunc qf ar vis texp rules)
genPostCondTest prefuns postops genPostCondTest prefuns postops
(CFunc qf@(mn,fn) _ _ (CQualType clscon texp) _) = (CFunc qf@(mn,fn) _ _ (CQualType clscon texp) _) =
if qf `notElem` postops then [] else if qf `notElem` postops then [] else
[CFunc (mn, fn ++ postCondSuffix) ar Public [CFunc (mn, fn ++ postCondSuffix) ar Public
(CQualType clscon (propResultType texp)) (CQualType clscon (propResultType texp))
[simpleRule (map CPVar cvars) $ [simpleRule (map CPVar cvars) $
if qf `elem` prefuns addPreCond prefuns [qf] cvars postprop ]]
then applyF (easyCheckModule,"==>")
[applyF (mn,toPreCondName fn) (map CVar cvars), postprop]
else postprop
]]
where where
ar = arityOfType texp ar = arityOfType texp
cvars = map (\i -> (i,"x"++show i)) [1 .. ar] cvars = map (\i -> (i,"x"++show i)) [1 .. ar]
...@@ -562,29 +586,57 @@ genPostCondTest prefuns postops ...@@ -562,29 +586,57 @@ genPostCondTest prefuns postops
-- Transforms a function declaration into a specification test if -- Transforms a function declaration into a specification test if
-- there is a specification for this function (i.e., an operation named -- there is a specification for this function (i.e., an operation named
-- f'spec). The specification test is of the form -- f'spec). The generated specification test has the form
-- fSatisfiesSpecification = f <=> f'spec
genSpecTest :: Options -> [QName] -> [QName] -> CFuncDecl -> [CFuncDecl]
genSpecTest opts prefuns specops (CmtFunc _ qf ar vis texp rules) =
genSpecTest opts prefuns specops (CFunc qf ar vis texp rules)
genSpecTest opts prefuns specops
(CFunc qf@(mn,fn) _ _ (CQualType clscon texp) _)
| qf `notElem` specops
= []
| optEquiv opts == Ground
= [genSpecGroundEquivTest prefuns qf clscon texp]
| otherwise
= [CFunc (mn, fn ++ satSpecSuffix) 0 Public
(emptyClassType (propResultType unitType))
[simpleRule [] (applyF (easyCheckModule,"<=>")
[constF qf, constF (mn,toSpecName fn)])]]
-- Transforms a function declaration into a ground equivalence test
-- against the specification (i.e., an operation named `f'spec` exists).
-- The generated specification test is of the form
-- fSatisfiesSpecification x1...xn = -- fSatisfiesSpecification x1...xn =
-- f'pre x1...xn ==> (f x1...xn <~> f'spec x1...xn) -- f'pre x1...xn ==> (f x1...xn <~> f'spec x1...xn)
genSpecTest :: [QName] -> [QName] -> CFuncDecl -> [CFuncDecl] genSpecGroundEquivTest :: [QName] -> QName -> CContext -> CTypeExpr -> CFuncDecl
genSpecTest prefuns specops (CmtFunc _ qf ar vis texp rules) = genSpecGroundEquivTest prefuns qf@(mn,fn) clscon texp =
genSpecTest prefuns specops (CFunc qf ar vis texp rules) CFunc (mn, fn ++ satSpecSuffix) ar Public
genSpecTest prefuns specops
(CFunc qf@(mn,fn) _ _ (CQualType clscon texp) _) =
if qf `notElem` specops then [] else
[CFunc (mn, fn ++ satSpecSuffix) ar Public
(CQualType (addShowContext clscon) (propResultType texp)) (CQualType (addShowContext clscon) (propResultType texp))
[simpleRule (map CPVar cvars) $ [simpleRule (map CPVar cvars) $
addPreCond (applyF (easyCheckModule,"<~>") addPreCond prefuns [qf,qfspec] cvars
[applyF qf (map CVar cvars), (applyF (easyCheckModule,"<~>")
applyF (mn,toSpecName fn) (map CVar cvars)])]] [applyF qf (map CVar cvars),
applyF (mn,toSpecName fn) (map CVar cvars)])]
where where
cvars = map (\i -> (i,"x"++show i)) [1 .. ar] ar = arityOfType texp
ar = arityOfType texp cvars = map (\i -> (i,"x"++show i)) [1 .. ar]
qfspec = (mn, toSpecName fn)
addPreCond exp = if qf `elem` prefuns
then applyF (easyCheckModule,"==>") -- Adds the preconditions of operations (second argument), if they are
[applyF (mn,toPreCondName fn) (map CVar cvars), exp]