Commit 4c36b254 authored by Michael Hanus 's avatar Michael Hanus

CPM updated

parent ff28616c
......@@ -126,7 +126,7 @@ to pull down a copy of the central package index to your system.
You can use the same command to update later
your copy of the central package index to the newest version.
Afterwards, you can show a short list of all packages in this index by
Afterwards, you can show a list of all packages in this index by
%
\begin{lstlisting}
> cypm list
......@@ -474,10 +474,18 @@ changes when compared to the previous version $1.2.6$, you can use the
CPM will then check the types of all public functions and data types in all
exported modules of both versions (see the \code{exportedModules} field of the
package specification) and report any differences and whether they violate
semantic versioning. It will also generate a CurryCheck program that will
compare the behavior of all exported functions in all exported modules whose
types have not changed and execute that program. Note that not all functions
can be compared via CurryCheck.
semantic versioning.
CPM will also compare the behavior of all exported functions
in all exported modules whose types have not changed.
Actually, this part is performed by CurryCheck \cite{Hanus16LOPSTR},
a property-based test tool for Curry.
For this purpose, CPM generates a Curry program containing
properties stating the equivalence
of two operations with the same name but defined in two different
versions of a package.
The ideas and scheme of this generation process are
described in \cite{Hanus17ICLP}.
Note that not all functions can be compared via CurryCheck.
In particular, functions taking other functions as arguments
(there are a few other minor restrictions)
can not be checked so that CPM automatically excludes them from checking.
......@@ -537,6 +545,27 @@ In this case, one can mark those functions with the compiler pragma
\verb|{-# NOCOMPARE -#}|
so that CPM will not generate tests for them.
Note that there are different ways to state the equivalence of operations
(e.g., see the discussion in \cite{BacciEtAl12}).
CPM offers two kinds of equivalence tests:
\begin{itemize}
\item
\emph{Ground equivalence} means that two operations are considered
as equivalent if they yield identical values for identical input values.
\item
\emph{Contextual or full equivalence} means that two operations
are considered as equivalent if they produce the same results
in all possible contexts.
\end{itemize}
%
Since contextual equivalence is more meaningful in the context
of semantic versioning, CPM tests this kind of
equivalence in the default case, based on the techniques
described in \cite{AntoyHanus18FLOPS}.
However, using the option \code{--ground} of the \code{diff} command,
one can also enfore the checking of ground equivalence
as described in \cite{Hanus17ICLP}.
\subsection{Adding Packages to the Central Package Index}
\label{sec:adding-a-package}
......@@ -963,9 +992,10 @@ If the version option is missing, the latest version of the current package
found in the repository is used for comparison.
If the options \code{--api-only} or \code{--behavior-only} are added,
then only the API or the behavior are compared, respectively.
Using the option \code{--modules}, one can also specify a comma-separated
list of module names to be compared. Without this option,
all exported modules are compared.
In the default case, all modules commonly exported by both
versions of the package are compared.
Using the option \code{--modules}, one can restrict this comparison
to a list of modules specified by a comma-separated list of module names.
As described in Section~\ref{sec:semantic-versioning},
CPM uses property tests to compare the behavior
......@@ -977,6 +1007,12 @@ but then you have to ensure that all operations are terminating
(or you can annotate them by pragmas,
see Section~\ref{sec:semantic-versioning}).
In the default case, CPM tests the contextual equivalence of
operations (see Section~\ref{sec:semantic-versioning}).
With the option \code{--ground}, the ground equivalence of operations
is tested.
\item[\fbox{\code{exec $command$}}] Executes an arbitrary command with the
\code{CURRYPATH} environment variable set to the paths of all dependencies of
the current package.
......@@ -1374,6 +1410,36 @@ You can simply re-install the newest version of this index
by the command \code{cypm update}.
\end{description}
\newpage
\begin{thebibliography}{1}
\bibitem{AntoyHanus18FLOPS}
S.~Antoy and M.~Hanus.
\newblock Equivalence Checking of Non-deterministic Operations.
\newblock In {\em Proc. of the 14th International Symposium on Functional and
Logic Programming (FLOPS 2018)}, pp. 149--165. Springer LNCS 10818, 2018.
\bibitem{BacciEtAl12}
G.~Bacci, M.~Comini, M.A. Feli{\'u}, and A.~Villanueva.
\newblock Automatic Synthesis of Specifications for First Order {Curry}.
\newblock In {\em Principles and Practice of Declarative Programming
(PPDP'12)}, pp. 25--34. ACM Press, 2012.
\bibitem{Hanus16LOPSTR}
M.~Hanus.
\newblock {CurryCheck}: Checking Properties of {Curry} Programs.
\newblock In {\em Proceedings of the 26th International Symposium on
Logic-Based Program Synthesis and Transformation (LOPSTR 2016)}, pp.
222--239. Springer LNCS 10184, 2017.
\bibitem{Hanus17ICLP}
M.~Hanus.
\newblock Semantic Versioning Checking in a Declarative Package Manager.
\newblock In {\em Technical Communications of the 33rd International Conference
on Logic Programming (ICLP 2017)}, OpenAccess Series in Informatics (OASIcs),
pp. 6:1--6:16. Schloss Dagstuhl - Leibniz-Zentrum fuer Informatik, 2017.
\end{thebibliography}
\end{document}
......
......@@ -67,7 +67,18 @@ readAbstractCurryFromPackagePath pkg pkgDir deps modname = do
acyName <- return $ case src of
Nothing -> error $ "Module not found: " ++ modname
Just (_, file) -> replaceExtension (inCurrySubdirModule modname file) ".acy"
readAbstractCurryFile acyName
readAbstractCurryFile acyName >>= return . addPrimTypes
where
-- work-around for missing Prelude.Char|Int|Float declarations:
addPrimTypes p@(CurryProg mname imports dfltdecl clsdecls instdecls
typedecls funcdecls opdecls)
| mname == pre && primType "Int" `notElem` typedecls
= CurryProg mname imports dfltdecl clsdecls instdecls
(map primType ["Int","Float","Char"] ++ typedecls)
funcdecls opdecls
| otherwise = p
where pre = "Prelude"
primType n = CType ("Prelude",n) Public [] [] []
--- Reads an AbstractCurry module from a package or one of its dependencies.
---
......
......@@ -97,18 +97,20 @@ compareModulesFromPackageAndDir cfg repo gc dirA nameB verB onlyMods =
compareModulesInDirs :: Config -> Repository -> GC.GlobalCache -> String
-> String -> Maybe [String]
-> IO (ErrorLogger [(String, Differences)])
compareModulesInDirs cfg repo gc dirA dirB onlyMods = loadPackageSpec dirA |>=
\pkgA -> loadPackageSpec dirB |>=
\pkgB -> resolveAndCopyDependencies cfg repo gc dirA |>=
\depsA -> resolveAndCopyDependencies cfg repo gc dirB |>=
\depsB -> mapEL (compareApiModule pkgA dirA depsA pkgB dirB depsB)
(allMods pkgA pkgB) |>=
\diffs -> let modsWithDiffs = zip (allMods pkgA pkgB) diffs in
succeedIO $ case onlyMods of
Nothing -> modsWithDiffs
Just ms -> filter ((`elem` ms) . fst) modsWithDiffs
where
allMods a b = nub $ (exportedModules a) ++ (exportedModules b)
compareModulesInDirs cfg repo gc dirA dirB onlyMods =
loadPackageSpec dirA |>= \pkgA ->
loadPackageSpec dirB |>= \pkgB ->
resolveAndCopyDependencies cfg repo gc dirA |>= \depsA ->
resolveAndCopyDependencies cfg repo gc dirB |>= \depsB ->
let cmpmods = nub (exportedModules pkgA ++ exportedModules pkgB) in
if null cmpmods
then log Info "No exported modules to compare" |> succeedIO []
else
mapEL (compareApiModule pkgA dirA depsA pkgB dirB depsB) cmpmods |>=
\diffs -> let modsWithDiffs = zip cmpmods diffs in
succeedIO $ case onlyMods of
Nothing -> modsWithDiffs
Just ms -> filter ((`elem` ms) . fst) modsWithDiffs
--- Compares a single module from two package versions.
---
......
--------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--- This module contains functions that compare the behavior of two versions of
--- a package.
---
--- For this purpose, copies of these packages and a main "comparison"
--- module (with name "Compare") are generated in the temporary
--- directory `/tmp/CPM/bdiff` and then CurryCheck is executed on `Compare`.
--------------------------------------------------------------------------------
module CPM.Diff.Behavior
......@@ -128,16 +132,16 @@ data ComparisonInfo = ComparisonInfo
--- Create temporary directory for the behavior diff.
createBaseTemp :: IO (ErrorLogger String)
createBaseTemp = getTemporaryDirectory >>=
\tmpDir ->
let
tmp = tmpDir </> "CPM" </> "bdiff"
in recreateDirectory tmp >> succeedIO tmp
createBaseTemp = do
tmpDir <- getTemporaryDirectory
let tmp = tmpDir </> "CPM" </> "bdiff"
recreateDirectory tmp >> succeedIO tmp
--- Get temporary directory for the behavior diff.
getBaseTemp :: IO (ErrorLogger String)
getBaseTemp = getTemporaryDirectory >>=
\tmpDir -> succeedIO $ tmpDir </> "CPM" </> "bdiff"
getBaseTemp = do
tmpDir <- getTemporaryDirectory
succeedIO $ tmpDir </> "CPM" </> "bdiff"
--- This message is printed before CurryCheck is executed.
infoText :: String
......@@ -152,6 +156,7 @@ infoText = unlines
--- @param repo - the central package index
--- @param gc - the global package cache
--- @param info - the comparison info obtained from preparePackageDirs
--- @param groundequiv - test ground equivalence only?
--- @param useanalysis - use program analysis to filter non-term. operations?
--- @param mods - a list of modules to compare
diffBehavior :: Config
......@@ -159,16 +164,19 @@ diffBehavior :: Config
-> GC.GlobalCache
-> ComparisonInfo
-> Bool
-> Bool
-> Maybe [String]
-> IO (ErrorLogger ())
diffBehavior cfg repo gc info useanalysis cmods = getBaseTemp |>=
\baseTmp -> findFunctionsToCompare cfg repo gc (infSourceDirA info)
(infSourceDirB info) useanalysis cmods |>=
diffBehavior cfg repo gc info groundequiv useanalysis cmods =
getBaseTemp |>= \baseTmp ->
findFunctionsToCompare cfg repo gc (infSourceDirA info) (infSourceDirB info)
useanalysis cmods |>=
\(acyCache, loadpath, funcs, removed) ->
let
filteredFuncs = maybe funcs
(\mods -> filter ((`elem` mods) . fst . funcName . snd) funcs)
cmods
filteredFuncs =
maybe funcs
(\mods -> filter ((`elem` mods) . fst . funcName . snd) funcs)
cmods
filteredNames = map snd filteredFuncs
in log Debug ("Filtered operations to be checked: " ++
showFuncNames filteredNames) |>
......@@ -179,7 +187,8 @@ diffBehavior cfg repo gc info useanalysis cmods = getBaseTemp |>=
printRemoved removed
putStrLn $
"Comparing operations " ++ showFuncNames filteredNames ++ "\n"
genCurryCheckProgram cfg repo gc filteredFuncs info acyCache loadpath
genCurryCheckProgram cfg repo gc filteredFuncs info groundequiv
acyCache loadpath
|> callCurryCheck cfg info baseTmp
where
printRemoved removed =
......@@ -227,16 +236,17 @@ genCurryCheckProgram :: Config
-> Repository
-> GC.GlobalCache
-> [(Bool,CFuncDecl)]
-> ComparisonInfo
-> ComparisonInfo
-> Bool
-> ACYCache -> [String]
-> IO (ErrorLogger ())
genCurryCheckProgram cfg repo gc prodfuncs info acyCache loadpath =
genCurryCheckProgram cfg repo gc prodfuncs info groundequiv acyCache loadpath =
getBaseTemp |>= \baseTmp ->
let translatorGenerator = uncurry $ genTranslatorFunction cfg repo gc info in
foldEL translatorGenerator (acyCache, emptyTrans)
translateTypes |>= \(_, transMap) ->
let (limittypes,testFunctions) = unzip (map (genTestFunction info transMap)
prodfuncs)
let (limittypes,testFunctions) =
unzip (map (genTestFunction info groundequiv transMap) prodfuncs)
transFunctions = transFuncs transMap
limittconss = nub (concatMap tconsOfType (concat limittypes))
limittcmods = nub (map fst limittconss)
......@@ -247,7 +257,9 @@ genCurryCheckProgram cfg repo gc prodfuncs info acyCache loadpath =
limittcmods
let limitFunctions = concatMap (genLimitFunction typeinfos) limittdecls
prog = simpleCurryProg "Compare" imports []
(testFunctions ++ transFunctions ++ limitFunctions) []
(concat testFunctions ++ transFunctions ++
(if groundequiv then limitFunctions else []))
[]
let prodops = map snd (filter fst prodfuncs)
unless (null prodops) $ putStrLn $
"Productive operations (currently not fully supported for all types):\n" ++
......@@ -338,42 +350,69 @@ genLimitFunction typeinfos tdecl = case tdecl of
--- Generates a test function to compare two versions of the given function.
--- If the argument and result types must be transformed between types
--- of the two different version, also auxiliary operations are generated
--- for the equivalence test.
--- If the function is productive, we also return the result type of
--- the function in order to generate "limit" functions for this type.
genTestFunction :: ComparisonInfo -> TransMap -> (Bool, CFuncDecl)
-> ([CTypeExpr], CFuncDecl)
genTestFunction info tm (isprod,f) =
(if isprod then [newResultType] else [],
stCmtFunc ("Check equivalence of operation " ++ fmod ++ "." ++ fname ++
if isprod then " up to a depth limit" else "")
(modName, testName) (realArity f) Private newType
[if isprod
then let limitvar = (100,"limit") in
simpleRule (if isprod then CPVar limitvar : vars else vars)
(applyF ("Test.EasyCheck", "<~>")
[applyE (type2LimitFunc newResultType) [CVar limitvar, callA],
applyE (type2LimitFunc newResultType) [CVar limitvar, callB]])
else simpleRule vars (applyF ("Test.EasyCheck", "<~>") [callA, callB])])
genTestFunction :: ComparisonInfo -> Bool -> TransMap -> (Bool, CFuncDecl)
-> ([CTypeExpr], [CFuncDecl])
genTestFunction info groundequiv tm (isprod,f) =
(if isprod && groundequiv then [newResultTypeA] else [],
if groundequiv
then
[stCmtFunc ("Check ground equivalence of operation " ++ fmod ++ "." ++
fname ++ if isprod then " up to a depth limit" else "")
(modName, testName ++ "_GroundEquiv") (realArity f) Private newType
[if isprod
then let limitvar = (100,"limit") in
simpleRule (if isprod then CPVar limitvar : vars else vars)
(applyF (easyCheckMod "<~>")
[applyE (type2LimitFunc newResultTypeA)
[CVar limitvar, callA],
applyE (type2LimitFunc newResultTypeA)
[CVar limitvar, callB]])
else simpleRule vars (applyF (easyCheckMod "<~>") [callA, callB])]
]
else
[stFunc testName1 (realArity f) Private
(replaceResultType newType newResultTypeB)
[simpleRule vars callA]
,stFunc testName2 (realArity f) Private
(replaceResultType newType newResultTypeB)
[simpleRule vars callB]
,stCmtFunc ("Check equivalence of operation " ++ fmod ++ "." ++ fname)
(modName, testName ++ "_Equivalent") 0 Private
(baseType (easyCheckMod "Prop"))
[simpleRule [] (applyF (easyCheckMod "<=>")
[constF testName1, constF testName2])]]
)
where
(fmod,fname) = funcName f
modName = "Compare"
testName = "test_" ++
combineTuple (both (replace' '.' '_') $ (fmod, encodeCurryId fname)) "_"
testName1 = (modName, testName++"_1")
testName2 = (modName, testName++"_2")
vars = pVars (realArity f)
modA = (infPrefixA info) ++ "_" ++ fmod
modB = (infPrefixB info) ++ "_" ++ fmod
modA = infPrefixA info ++ "_" ++ fmod
modB = infPrefixB info ++ "_" ++ fmod
instantiatedFunc = instantiateBool $ typeOfQualType $ funcType f
newResultType = mapTypes info
newResultTypeA = mapTypes (infModMapA info)
(instantiateBool (resultType (typeOfQualType (funcType f))))
newType = let ftype = mapTypes info $ genTestFuncType f
newResultTypeB = mapTypes (infModMapB info)
(instantiateBool (resultType (typeOfQualType (funcType f))))
newType = let ftype = mapTypes (infModMapA info) $ genTestFuncType f
in if isprod then baseType ("Nat","Nat") ~> ftype
else ftype
returnTransform = case findTrans tm (resultType $ instantiatedFunc) of
Nothing -> id
Just tr -> \t -> applyF (modName, tr) [t]
-- Since we use the data types from the A version in type of the generated
-- test function, we transform the parameters in the call of the B version of
-- the tested function using the translator functions from the TransMap. As we
......@@ -392,7 +431,7 @@ genTestFunction info tm (isprod,f) =
(_, CPVar v) ->
maybe (CVar v)
(\_ -> case findTrans tm texp of
Just n -> applyF ("Compare", n) [CVar v]
Just n -> applyF (modName, n) [CVar v]
Nothing -> CVar v)
(tconsArgsOfType texp)
_ -> error "CPM.Diff.Behavior.transformedVar: This case should be impossible to reach"
......@@ -521,9 +560,14 @@ genTranslatorFunction :: Config
-> CTypeExpr
-> IO (ErrorLogger (ACYCache, TransMap))
genTranslatorFunction cfg repo gc info acy tm texp =
-- TODO: generate also translation functions for functional types.
-- This requires type translator in both directions but currently
-- we generate only one direction.
-- For instance, to translate a function A->B into A'->B':
-- (A->B)2(A'->B') f = \x -> B2B' (f (A'2A x))
let (mod, n) = maybe
(error $ "CPM.Diff.Behavior.genTranslatorFunction: " ++
"Cannot generate translator function for type:\n" ++
"cannot generate type translation function for type:\n" ++
pPrint (ppCTypeExpr defaultOptions texp))
fst
(tconsArgsOfType texp)
......@@ -673,15 +717,18 @@ instantiate tdecl texp = case texp of
maybeReplaceField (CField n'' v'' e) =
CField n'' v'' $ maybeReplaceVar varMap e
--- Recursively transforms all module names of all constructor references in the
--- type expression into the module names of version A.
mapTypes :: ComparisonInfo -> CTypeExpr -> CTypeExpr
mapTypes info (CFuncType a b) = CFuncType (mapTypes info a) (mapTypes info b)
mapTypes info (CTApply a b) = CTApply (mapTypes info a) (mapTypes info b)
mapTypes _ v@(CTVar _) = v
mapTypes info (CTCons (m, n)) = case lookup m (infModMapA info) of
Nothing -> CTCons (m, n)
Just m' -> CTCons (m', n)
--- Recursively transforms the module names of all type constructors in a
--- type expression into new module names according to a mapping of
--- module names.
mapTypes :: [(String,String)] -> CTypeExpr -> CTypeExpr
mapTypes mmap (CFuncType a b) = CFuncType (mapTypes mmap a) (mapTypes mmap b)
mapTypes mmap (CTApply a b) = CTApply (mapTypes mmap a) (mapTypes mmap b)
mapTypes _ v@(CTVar _) = v
mapTypes mmap (CTCons (m, n)) =
case lookup m mmap of
Nothing -> CTCons (m, n)
Just m' -> CTCons (m', n)
realArity :: CFuncDecl -> Int
realArity (CFunc _ _ _ t _) = arityOfType (typeOfQualType t)
......@@ -717,13 +764,18 @@ transCTCon2Limit (_,tcn) = ("Compare", "limit" ++ trans tcn)
| "(," `isPrefixOf` n = "Tuple" ++ show (length n - 1)
| otherwise = n
--- Qualify a name by `Test.EasyCheck` module:
easyCheckMod :: String -> QName
easyCheckMod n = ("Test.EasyCheck", n)
--- Generates a function type for the test function by replacing the result
--- type with `Test.EasyCheck.Prop`. Also instantiates polymorphic types to
--- Bool.
genTestFuncType :: CFuncDecl -> CTypeExpr
genTestFuncType f = replaceResultType t (baseType ("Test.EasyCheck", "Prop"))
genTestFuncType f = replaceResultType t (baseType (easyCheckMod "Prop"))
where t = instantiateBool $ typeOfQualType $ funcType f
--- Instantiates all type variables in a type expression to `Prelude.Bool`.
instantiateBool :: CTypeExpr -> CTypeExpr
instantiateBool (CTVar _) = boolType
instantiateBool (CTCons n) = CTCons n
......@@ -782,33 +834,36 @@ findFunctionsToCompare :: Config
-> Maybe [String]
-> IO (ErrorLogger (ACYCache, [String],
[(Bool,CFuncDecl)], [(CFuncDecl, FilterReason)]))
findFunctionsToCompare cfg repo gc dirA dirB useanalysis cmods =
findFunctionsToCompare cfg repo gc dirA dirB useanalysis onlymods =
loadPackageSpec dirA |>= \pkgA ->
loadPackageSpec dirB |>= \pkgB ->
resolveAndCopyDependencies cfg repo gc dirA |>= \depsA ->
succeedIO (maybe (intersect (exportedModules pkgA) (exportedModules pkgB))
id
cmods) |>= \mods ->
log Debug ("Comparing modules: "++ intercalate " " mods) |>
APIDiff.compareModulesInDirs cfg repo gc dirA dirB (Just mods) |>= \diffs ->
findAllFunctions dirA dirB pkgA depsA emptyACYCache mods |>=
\(acy, allFuncs) ->
log Debug ("All public functions: " ++ showFuncNames allFuncs) |>
let areDiffThenFilter = thenFilter allFuncs Diffing
areHighArityThenFilter = thenFilter allFuncs HighArity
areIOActionThenFilter = thenFilter allFuncs IOAction
areNoCompareThenFilter = thenFilter allFuncs NoCompare
areNonMatchingThenFilter = thenFilter allFuncs NonMatchingTypes
haveFuncArgThenFilter = thenFilter allFuncs FuncArg
in
(emptyFilter ((liftFilter $ filterDiffingFunctions diffs) acy allFuncs)
`areDiffThenFilter`
liftFilter filterHighArity `areHighArityThenFilter`
liftFilter filterIOAction `areIOActionThenFilter`
filterNoCompare dirA dirB depsA `areNoCompareThenFilter`
filterNonMatchingTypes dirA dirB depsA `areNonMatchingThenFilter`
filterFuncArg dirA dirB depsA `haveFuncArgThenFilter`
liftFilter id ) |>= terminationFilter pkgA dirA depsA useanalysis
succeedIO (let cmods = intersect (exportedModules pkgA) (exportedModules pkgB)
in maybe cmods (intersect cmods) onlymods) |>= \mods ->
if null mods
then log Info "No exported modules to compare" |>
succeedIO (emptyACYCache,[],[],[])
else
log Info ("Comparing modules: "++ intercalate " " mods) |>
APIDiff.compareModulesInDirs cfg repo gc dirA dirB (Just mods) |>= \diffs ->
findAllFunctions dirA dirB pkgA depsA emptyACYCache mods |>=
\(acy, allFuncs) ->
log Debug ("All public functions: " ++ showFuncNames allFuncs) |>
let areDiffThenFilter = thenFilter allFuncs Diffing
areHighArityThenFilter = thenFilter allFuncs HighArity
areIOActionThenFilter = thenFilter allFuncs IOAction
areNoCompareThenFilter = thenFilter allFuncs NoCompare
areNonMatchingThenFilter = thenFilter allFuncs NonMatchingTypes
haveFuncArgThenFilter = thenFilter allFuncs FuncArg
in
(emptyFilter ((liftFilter $ filterDiffingFunctions diffs) acy allFuncs)
`areDiffThenFilter`
liftFilter filterHighArity `areHighArityThenFilter`
liftFilter filterIOAction `areIOActionThenFilter`
filterNoCompare dirA dirB depsA `areNoCompareThenFilter`
filterNonMatchingTypes dirA dirB depsA `areNonMatchingThenFilter`
filterFuncArg dirA dirB depsA `haveFuncArgThenFilter`
liftFilter id ) |>= terminationFilter pkgA dirA depsA useanalysis
--- Filters out functions which are possibly non-terminating and
--- non-productive, and mark productive functions so that they are
......@@ -1208,11 +1263,11 @@ preparePackages :: Config
-> Version
-> IO (ErrorLogger ComparisonInfo)
preparePackages cfg repo gc nameA verA nameB verB =
GC.tryFindPackage gc nameA verA |>=
\pkgA -> findPackageDir cfg pkgA |>=
\dirA -> GC.tryFindPackage gc nameB verB |>=
\pkgB -> findPackageDir cfg pkgB |>=
\dirB -> preparePackageDirs cfg repo gc dirA dirB
GC.tryFindPackage gc nameA verA |>= \pkgA ->
findPackageDir cfg pkgA |>= \dirA ->
GC.tryFindPackage gc nameB verB |>= \pkgB ->
findPackageDir cfg pkgB |>= \dirB ->
preparePackageDirs cfg repo gc dirA dirB
--- Prepares two package, one from a directory and one from the global package
--- cache. Copies them to a temporary directory and builds renamed versions of
......@@ -1231,9 +1286,10 @@ preparePackageAndDir :: Config
-> String
-> Version
-> IO (ErrorLogger ComparisonInfo)
preparePackageAndDir cfg repo gc dirA nameB verB = GC.tryFindPackage gc nameB verB |>=
\pkgB -> findPackageDir cfg pkgB |>=
\dirB -> preparePackageDirs cfg repo gc dirA dirB
preparePackageAndDir cfg repo gc dirA nameB verB =
GC.tryFindPackage gc nameB verB |>= \pkgB ->
findPackageDir cfg pkgB |>= \dirB ->
preparePackageDirs cfg repo gc dirA dirB
--- Prepares two packages from two directories for comparison. Copies the
--- package files to a temporary directory and creates renamed version of the
......
......@@ -56,7 +56,7 @@ cpmBanner :: String
cpmBanner = unlines [bannerLine,bannerText,bannerLine]
where
bannerText =
"Curry Package Manager <curry-language.org/tools/cpm> (version of 19/06/2018)"
"Curry Package Manager <curry-language.org/tools/cpm> (version of 05/10/2018)"
bannerLine = take (length bannerText) (repeat '-')
main :: IO ()
......@@ -224,11 +224,13 @@ data TestOptions = TestOptions
{ testModules :: Maybe [String] }
data DiffOptions = DiffOptions
{ diffVersion :: Maybe Version
, diffModules :: Maybe [String]
, diffAPI :: Bool
, diffBehavior :: Bool
, diffUseAna :: Bool }
{ diffVersion :: Maybe Version -- version to be compared
, diffModules :: Maybe [String] -- modules to be compared
, diffAPI :: Bool -- check API equivalence
, diffBehavior :: Bool -- test behavior equivalence
, diffGroundEqu :: Bool -- test ground equivalence only
, diffUseAna :: Bool -- use termination analysis for safe tests
}
configOpts :: Options -> ConfigOptions
configOpts s = case optCommand s of
......@@ -319,7 +321,7 @@ testOpts s = case optCommand s of
diffOpts :: Options -> DiffOptions
diffOpts s = case optCommand s of
Diff opts -> opts
_ -> DiffOptions Nothing Nothing True True True
_ -> DiffOptions Nothing Nothing True True False True
readLogLevel :: String -> Either String LogLevel
readLogLevel s = case map toLower s of
......@@ -638,7 +640,12 @@ optionParser allargs = optParser
<> short "b"
<> help "Diff only the behavior")
<.> flag (\a -> Right $ a { optCommand = Diff (diffOpts a)
{ diffUseAna = False } })
{ diffGroundEqu = True } })
( long "ground"
<> short "g"
<> help "Check ground equivalence only when comparing behavior")
<.> flag (\a -> Right $ a { optCommand = Diff (diffOpts a)
{ diffUseAna = False } })
( long "unsafe"
<> short "u"
<> help
......@@ -1317,12 +1324,13 @@ diffCmd opts cfg =
showlocalv = showVersion localv
in
getRepoForPackageSpec cfg localSpec >>= \repo ->
readGlobalCache cfg repo |>= \gc ->
getDiffVersion repo localname |>= \diffv ->
if diffv == localv
then failIO $ "Cannot diff identical package versions " ++ showlocalv
else putStrLn ("Comparing local version " ++ showlocalv ++
" and repository version " ++ showVersion diffv ++ ":\n") >>
installIfNecessary repo localname diffv |> putStrLn "" >>
readGlobalCache cfg repo |>= \gc ->
diffAPIIfEnabled repo gc specDir localSpec diffv |>
diffBehaviorIfEnabled repo gc specDir localSpec diffv
where
......@@ -1334,7 +1342,12 @@ diffCmd opts cfg =
"' found in package repository."
Just p -> succeedIO (version p)
Just v -> succeedIO v
installIfNecessary repo pkgname ver =
case findVersion repo pkgname ver of
Nothing -> packageNotFoundFailure $ pkgname ++ "-" ++ showVersion ver
Just p -> acquireAndInstallPackageWithDependencies cfg repo p
diffAPIIfEnabled repo gc specDir localSpec diffversion =
if diffAPI opts
then (putStrLn "Running API diff...\n" >> succeedIO ()) |>
......@@ -1352,8 +1365,8 @@ diffCmd opts cfg =
then (putStrLn "Preparing behavior diff...\n" >> succeedIO ()) |>
BDiff.preparePackageAndDir cfg repo gc specDir (name localSpec)
diffversion |>=
\i -> BDiff.diffBehavior cfg repo gc i (diffUseAna opts)
(diffModules opts)
\i -> BDiff.diffBehavior cfg repo gc i (diffGroundEqu opts)
(diffUseAna opts) (diffModules opts)
else succeedIO ()
-- Implementation of the "curry" command.
......
......@@ -150,11 +150,12 @@ installFromZip cfg zip = do
--- Installs a package's missing dependencies.
installMissingDependencies :: Config -> GlobalCache -> [Package]
-> IO (ErrorLogger ())
installMissingDependencies cfg gc deps = if length missing > 0
then log Info logMsg |>
mapEL (acquireAndInstallPackage cfg) missing |>
succeedIO ()
else succeedIO ()
installMissingDependencies cfg gc deps =
if length missing > 0
then log Info logMsg |>
mapEL (acquireAndInstallPackage cfg) missing |>
succeedIO ()
else succeedIO ()
where
missing = filter (not . isPackageInstalled gc) deps