Commit 5a5d0e87 authored by Michael Hanus 's avatar Michael Hanus
Browse files

Tools updated

parent 8cc6655e
......@@ -99,7 +99,7 @@ import CPM.Repository (Repository)
-- its dependencies:
--
-- ```
-- test_sayHello :: SayHello.MyType -> Test.EasyCheck.Prop
-- test_sayHello :: SayHello.MyType -> Test.Prop.Prop
-- test_sayHello x0 = V_1_0_0_SayHello.sayHello x0 <~> V_1_1_0_SayHello.sayHello x0
-- ```
--
......@@ -289,7 +289,7 @@ genCurryCheckProgram cfg repo gc prodfuncs info groundequiv acyCache loadpath =
mods = map (fst . funcName . snd) prodfuncs
modsA = map (\mod -> (infPrefixA info) ++ "_" ++ mod) mods
modsB = map (\mod -> (infPrefixB info) ++ "_" ++ mod) mods
imports = modsA ++ modsB ++ ["Test.EasyCheck"]
imports = modsA ++ modsB ++ ["Test.Prop"]
--- Generates functions to limit the result depth of values of
--- the given data type.
......@@ -764,12 +764,12 @@ transCTCon2Limit (_,tcn) = ("Compare", "limit" ++ trans tcn)
| "(," `isPrefixOf` n = "Tuple" ++ show (length n - 1)
| otherwise = n
--- Qualify a name by `Test.EasyCheck` module:
--- Qualify a name by `Test.Prop` module:
easyCheckMod :: String -> QName
easyCheckMod n = ("Test.EasyCheck", n)
easyCheckMod n = ("Test.Prop", n)
--- Generates a function type for the test function by replacing the result
--- type with `Test.EasyCheck.Prop`. Also instantiates polymorphic types to
--- type with `Test.Prop.Prop`. Also instantiates polymorphic types to
--- Bool.
genTestFuncType :: CFuncDecl -> CTypeExpr
genTestFuncType f = replaceResultType t (baseType (easyCheckMod "Prop"))
......
......@@ -20,7 +20,7 @@ module CPM.LookupSet
) where
import List (sortBy, delete, deleteBy)
import Test.EasyCheck
import Test.Prop
import Data.Table.RBTree as Table ( TableRBT, empty, lookup, toList,update )
......@@ -113,13 +113,13 @@ findAllVersions (LookupSet ls o) p pre = localSorted' ++ nonLocalSorted
isLocal (FromRepository, _) = False
ps = map snd
test_findAllVersions_localBeforeNonLocal :: Test.EasyCheck.Prop
test_findAllVersions_localBeforeNonLocal :: Prop
test_findAllVersions_localBeforeNonLocal = findAllVersions ls "A" False -=- [aLocal, aNonLocal]
where aLocal = cPackage "A" (1, 0, 0, Nothing) []
aNonLocal = cPackage "A" (1, 1, 0, Nothing) []
ls = addPackage (addPackage emptySet aLocal FromLocalCache) aNonLocal FromRepository
test_findAllVersions_nonLocalIfIgnored :: Test.EasyCheck.Prop
test_findAllVersions_nonLocalIfIgnored :: Prop
test_findAllVersions_nonLocalIfIgnored = findAllVersions ls "A" False -=- [aNonLocal]
where aLocal = cPackage "A" (1, 0, 0, Nothing) []
aNonLocal = cPackage "A" (1, 1, 0, Nothing) []
......
......@@ -49,16 +49,16 @@ import JSON.Parser
import JSON.Pretty ( ppJSON )
import List ( intercalate, intersperse, isInfixOf, splitOn )
import Read ( readInt )
import SetFunctions
import Test.EasyCheck
import Test.Prop
import DetParse
import CPM.ErrorLogger
import CPM.FileUtil (ifFileExists)
--- A Version. Tuple components are major, minor, patch, prerelease, e.g.
--- 3.1.1-rc5
--- Data type representin a version number.
--- It is a tuple where the components are major, minor, patch, prerelease,
--- e.g., 3.1.1-rc5
type Version = (Int, Int, Int, Maybe String)
--- The initial version of a new package.
......@@ -382,19 +382,19 @@ isNumeric = all isDigit
ltShortlex :: String -> String -> Bool
ltShortlex a b = (length a == length b && a < b) || length a < length b
test_shorterPrereleaseIsSmaller :: Test.EasyCheck.Prop
test_shorterPrereleaseIsSmaller :: Prop
test_shorterPrereleaseIsSmaller =
always $ (0, 0, 0, Just "rc") `vlt` (0, 0, 0, Just "beta")
test_numericIsSmallerLeft :: Test.EasyCheck.Prop
test_numericIsSmallerLeft :: Prop
test_numericIsSmallerLeft =
always $ (0, 0, 0, Just "1234") `vlt` (0, 0, 0, Just "rc")
test_numericIsSmallerRight :: Test.EasyCheck.Prop
test_numericIsSmallerRight :: Prop
test_numericIsSmallerRight =
always $ not $ (0, 0, 0, Just "rc") `vlt` (0, 0, 0, Just "1234")
test_numbersAreComparedNumerically :: Test.EasyCheck.Prop
test_numbersAreComparedNumerically :: Prop
test_numbersAreComparedNumerically =
always $ (0, 0, 0, Just "0003") `vlt` (0, 0, 0, Just "123")
......@@ -657,20 +657,20 @@ optionalString k kv f = case lookup k kv of
Just JNull -> Left $ "Expected a string, got 'null'" ++ forKey
where forKey = " for key '" ++ k ++ "'"
test_specFromJObject_mandatoryFields :: Test.EasyCheck.Prop
test_specFromJObject_mandatoryFields :: Prop
test_specFromJObject_mandatoryFields =
is (packageSpecFromJObject obj)
(\x -> isLeft x && isInfixOf "name" ((head . lefts) [x]))
where obj = [("hello", JString "world")]
test_specFromJObject_invalidVersion :: Test.EasyCheck.Prop
test_specFromJObject_invalidVersion :: Prop
test_specFromJObject_invalidVersion =
is (packageSpecFromJObject obj)
(\x -> isLeft x && isInfixOf "version" ((head . lefts) [x]))
where obj = [ ("name", JString "mypackage"), ("author", JString "test")
, ("synopsis", JString "great!"), ("version", JString "1.2.b")]
test_specFromJObject_minimalSpec :: Test.EasyCheck.Prop
test_specFromJObject_minimalSpec :: Prop
test_specFromJObject_minimalSpec =
is (packageSpecFromJObject obj) (\x -> isRight x && test x)
where obj = [ ("name", JString "mypackage"), ("author", JString "me")
......@@ -842,13 +842,13 @@ docuSpecFromJObject kv =
readVersionConstraints :: String -> Maybe [[VersionConstraint]]
readVersionConstraints s = parse pVersionConstraints (dropWhile isSpace s)
test_readVersionConstraints_single :: Test.EasyCheck.Prop
test_readVersionConstraints_single :: Prop
test_readVersionConstraints_single = readVersionConstraints "=1.2.3" -=- Just [[VExact (1, 2, 3, Nothing)]]
test_readVersionConstraints_multi :: Test.EasyCheck.Prop
test_readVersionConstraints_multi :: Prop
test_readVersionConstraints_multi = readVersionConstraints "> 1.0.0, < 2.3.0" -=- Just [[VGt (1, 0, 0, Nothing), VLt (2, 3, 0, Nothing)]]
test_readVersionConstraints_disjunction :: Test.EasyCheck.Prop
test_readVersionConstraints_disjunction :: Prop
test_readVersionConstraints_disjunction = readVersionConstraints ">= 4.0.0 || < 3.0.0, > 2.0.0" -=- Just [[VGte (4, 0, 0, Nothing)], [VLt (3, 0, 0, Nothing), VGt (2, 0, 0, Nothing)]]
pVersionConstraints :: Parser [[VersionConstraint]]
......@@ -861,31 +861,31 @@ pConjunction = (:) <$> pVersionConstraint <*> (pWhitespace *> char ',' *> pWhite
readVersionConstraint :: String -> Maybe VersionConstraint
readVersionConstraint s = parse pVersionConstraint s
test_readVersionConstraint_exact :: Test.EasyCheck.Prop
test_readVersionConstraint_exact :: Prop
test_readVersionConstraint_exact = readVersionConstraint "=1.2.3" -=- (Just $ VExact (1, 2, 3, Nothing))
test_readVersionConstraint_without :: Test.EasyCheck.Prop
test_readVersionConstraint_without :: Prop
test_readVersionConstraint_without = readVersionConstraint "1.2.3" -=- (Just $ VExact (1, 2, 3, Nothing))
test_readVersionConstraint_invalidVersion :: Test.EasyCheck.Prop
test_readVersionConstraint_invalidVersion :: Prop
test_readVersionConstraint_invalidVersion = readVersionConstraint "=4.a.3" -=- Nothing
test_readVersionConstraint_invalidConstraint :: Test.EasyCheck.Prop
test_readVersionConstraint_invalidConstraint :: Prop
test_readVersionConstraint_invalidConstraint = readVersionConstraint "x1.2.3" -=- Nothing
test_readVersionConstraint_greaterThan :: Test.EasyCheck.Prop
test_readVersionConstraint_greaterThan :: Prop
test_readVersionConstraint_greaterThan = readVersionConstraint "> 1.2.3" -=- (Just $ VGt (1, 2, 3, Nothing))
test_readVersionConstraint_greaterThanEqual :: Test.EasyCheck.Prop
test_readVersionConstraint_greaterThanEqual :: Prop
test_readVersionConstraint_greaterThanEqual = readVersionConstraint ">= 1.2.3" -=- (Just $ VGte (1, 2, 3, Nothing))
test_readVersionConstraint_lessThan :: Test.EasyCheck.Prop
test_readVersionConstraint_lessThan :: Prop
test_readVersionConstraint_lessThan = readVersionConstraint "<1.2.3" -=- (Just $ VLt (1, 2, 3, Nothing))
test_readVersionConstraint_lessThanEqual :: Test.EasyCheck.Prop
test_readVersionConstraint_lessThanEqual :: Prop
test_readVersionConstraint_lessThanEqual = readVersionConstraint "<= 1.2.3" -=- (Just $ VLte (1, 2, 3, Nothing))
test_readVersionConstraint_compatible :: Test.EasyCheck.Prop
test_readVersionConstraint_compatible :: Prop
test_readVersionConstraint_compatible = readVersionConstraint "~>1.2.3" -=- (Just $ VCompatible (1, 2, 3, Nothing))
pVersionConstraint :: Parser VersionConstraint
......
......@@ -21,8 +21,8 @@ import Either
import List
import Sort
import Maybe
import Test.Prop
import Text.Pretty
import Test.EasyCheck
import CPM.Config ( Config, defaultConfig, compilerVersion
, compilerBaseVersion )
......@@ -473,21 +473,21 @@ transitiveDependencies' seen ls pkg = foldl (\s d -> if d `elem` s then s else (
transitiveDependencies :: LookupSet -> Package -> [String]
transitiveDependencies = transitiveDependencies' []
test_transitiveDependencies_simpleCase :: Test.EasyCheck.Prop
test_transitiveDependencies_simpleCase :: Prop
test_transitiveDependencies_simpleCase = transitiveDependencies db pkg -=- ["B", "C"]
where pkg = cPackage "A" (0, 0, 1, Nothing) [cDep "B" ">= 1.0.0", cDep "C" "= 1.2.0"]
b = cPackage "B" (1, 0, 9, Nothing) []
c = cPackage "C" (1, 2, 0, Nothing) []
db = cDB [b, c]
test_transitiveDependencies_loop :: Test.EasyCheck.Prop
test_transitiveDependencies_loop :: Prop
test_transitiveDependencies_loop = transitiveDependencies db pkg -=- ["B", "C"]
where pkg = cPackage "A" (0, 0, 1, Nothing) [cDep "B" ">= 1.0.0", cDep "C" "= 1.2.0"]
b = cPackage "B" (1, 0, 0, Nothing) [cDep "C" "= 1.2.0"]
c = cPackage "C" (1, 2, 0, Nothing) [cDep "B" ">= 1.0.0"]
db = cDB [b, c]
test_transitiveDependencies_multipleVersions :: Test.EasyCheck.Prop
test_transitiveDependencies_multipleVersions :: Prop
test_transitiveDependencies_multipleVersions = transitiveDependencies db pkg -=- ["B", "D", "C"]
where pkg = cPackage "A" (0, 0, 1, Nothing) [cDep "B" ">= 1.0.0"]
b100 = cPackage "B" (1, 0, 0, Nothing) [cDep "C" "= 1.0.0"]
......@@ -525,57 +525,57 @@ isDisjunctionCompatible ver cs = any id (map (all id) rs)
preReleaseCompatible ver v
nextMinor (maj, min, _, _) = (maj, min + 1, 0, Nothing)
test_onlyConjunctionCompatible :: Test.EasyCheck.Prop
test_onlyConjunctionCompatible :: Prop
test_onlyConjunctionCompatible = isDisjunctionCompatible ver dis -=- True
where dis = cDisj "= 1.0.0"
ver = (1, 0, 0, Nothing)
test_allConjunctionsCompatible :: Test.EasyCheck.Prop
test_allConjunctionsCompatible :: Prop
test_allConjunctionsCompatible = isDisjunctionCompatible ver dis -=- True
where dis = cDisj ">= 1.0.0 || = 1.2.0"
ver = (1, 2, 0, Nothing)
test_oneConjunctionCompatible :: Test.EasyCheck.Prop
test_oneConjunctionCompatible :: Prop
test_oneConjunctionCompatible = isDisjunctionCompatible ver dis -=- True
where ver = (1, 0, 0, Nothing)
dis = cDisj "> 2.0.0 || = 1.0.0"
test_conjunctionWithMultipleParts :: Test.EasyCheck.Prop
test_conjunctionWithMultipleParts :: Prop
test_conjunctionWithMultipleParts = isDisjunctionCompatible ver dis -=- True
where ver = (1, 0, 0, Nothing)
dis = cDisj ">= 1.0.0, < 2.0.0"
test_reportsSimpleFailure :: Test.EasyCheck.Prop
test_reportsSimpleFailure :: Prop
test_reportsSimpleFailure = isDisjunctionCompatible ver dis -=- False
where ver = (1, 0, 0, Nothing)
dis = cDisj "> 1.0.0"
test_reportsAllConjunctionsAsFailure :: Test.EasyCheck.Prop
test_reportsAllConjunctionsAsFailure :: Prop
test_reportsAllConjunctionsAsFailure = isDisjunctionCompatible ver dis -=- False
where ver = (1, 0, 0, Nothing)
dis = cDisj "< 1.0.0 || > 1.0.0"
test_reportsRelevantPartOfConjunction :: Test.EasyCheck.Prop
test_reportsRelevantPartOfConjunction :: Prop
test_reportsRelevantPartOfConjunction = isDisjunctionCompatible ver dis -=- False
where ver = (1, 0, 0, Nothing)
dis = cDisj "< 1.0.0, > 0.5.0"
test_semverCompatible :: Test.EasyCheck.Prop
test_semverCompatible :: Prop
test_semverCompatible = isDisjunctionCompatible ver dis -=- True
where ver = (0, 5, 9, Nothing)
dis = cDisj "~> 0.5.0"
test_semverIncompatible :: Test.EasyCheck.Prop
test_semverIncompatible :: Prop
test_semverIncompatible = isDisjunctionCompatible ver dis -=- False
where ver = (0, 7, 1, Nothing)
dis = cDisj "~> 0.6.0"
test_semverMinimum :: Test.EasyCheck.Prop
test_semverMinimum :: Prop
test_semverMinimum = isDisjunctionCompatible ver dis -=- False
where ver = (0, 7, 0, Nothing)
dis = cDisj "~> 0.7.2"
test_resolvesSimpleDependency :: Test.EasyCheck.Prop
test_resolvesSimpleDependency :: Prop
test_resolvesSimpleDependency =
maybeResolvedPackages (resolve defaultConfig pkg db) -=- Just [json100, pkg]
where pkg = cPackage "sample" (0, 0, 1, Nothing) [cDep "json" "=1.0.0"]
......@@ -583,20 +583,20 @@ test_resolvesSimpleDependency =
json101 = cPackage "json" (1, 0, 1, Nothing) []
db = cDB [json100, json101]
test_reportsUnknownPackage :: Test.EasyCheck.Prop
test_reportsUnknownPackage :: Prop
test_reportsUnknownPackage = showResult result -=- "There seems to be no version of package json that can satisfy the constraint json = 1.0.0"
where result = resolve defaultConfig pkg db
pkg = cPackage "sample" (0, 0, 1, Nothing) [cDep "json" "= 1.0.0"]
db = cDB [pkg]
test_reportsMissingPackageVersion :: Test.EasyCheck.Prop
test_reportsMissingPackageVersion :: Prop
test_reportsMissingPackageVersion = showResult result -=- "There seems to be no version of package json that can satisfy the constraint json = 1.2.0"
where result = resolve defaultConfig pkg db
pkg = cPackage "sample" (0, 0, 1, Nothing) [cDep "json" "=1.2.0"]
json = cPackage "json" (1, 0, 0, Nothing) []
db = cDB [json]
test_reportsSecondaryConflict :: Test.EasyCheck.Prop
test_reportsSecondaryConflict :: Prop
test_reportsSecondaryConflict = showResult result -=- expectedMessage
where result = resolve defaultConfig pkg db
pkg = cPackage "sample" (0, 0, 1, Nothing) [cDep "json" "= 1.0.0", cDep "b" ">= 0.0.1"]
......@@ -611,7 +611,7 @@ test_reportsSecondaryConflict = showResult result -=- expectedMessage
++ " |- b (b >= 0.0.1)\n"
++ " |- json (json ~> 1.0.4)"
test_reportsSecondaryConflictInsteadOfPrimary :: Test.EasyCheck.Prop
test_reportsSecondaryConflictInsteadOfPrimary :: Prop
test_reportsSecondaryConflictInsteadOfPrimary = showResult result -=- expectedMessage
where result = resolve defaultConfig pkg db
pkg = cPackage "sample" (0, 0, 1, Nothing) [cDep "json" "= 1.0.0", cDep "b" ">= 0.0.5"]
......@@ -629,7 +629,7 @@ test_reportsSecondaryConflictInsteadOfPrimary = showResult result -=- expectedMe
++ " |- b (b >= 0.0.5)\n"
++ " |- json (json ~> 1.0.4)"
test_detectsSecondaryOnFirstActivation :: Test.EasyCheck.Prop
test_detectsSecondaryOnFirstActivation :: Prop
test_detectsSecondaryOnFirstActivation = showResult result -=- expectedMessage
where result = resolve defaultConfig pkg db
pkg = cPackage "sample" (0, 0, 1, Nothing) [cDep "a" "= 0.0.1", cDep "b" "> 0.0.1"]
......@@ -644,7 +644,7 @@ test_detectsSecondaryOnFirstActivation = showResult result -=- expectedMessage
++ "sample\n"
++ " |- b (b > 0.0.1)"
test_makesDecisionBetweenAlternatives :: Test.EasyCheck.Prop
test_makesDecisionBetweenAlternatives :: Prop
test_makesDecisionBetweenAlternatives =
maybeResolvedPackages (resolve defaultConfig pkg db) -=- Just [json150, pkg]
where pkg = cPackage "sample" (0, 0, 1, Nothing) [cDep "json" "> 1.0.0, < 2.0.0 || >= 4.0.0"]
......@@ -652,7 +652,7 @@ test_makesDecisionBetweenAlternatives =
json320 = cPackage "json" (3, 2, 0, Nothing) []
db = cDB [json150, json320]
test_alwaysChoosesNewestAlternative :: Test.EasyCheck.Prop
test_alwaysChoosesNewestAlternative :: Prop
test_alwaysChoosesNewestAlternative =
maybeResolvedPackages (resolve defaultConfig pkg db) -=- Just [json420, pkg]
where pkg = cPackage "sample" (0, 0, 1, Nothing) [cDep "json" "> 1.0.0, < 2.0.0 || >= 4.0.0"]
......@@ -660,7 +660,7 @@ test_alwaysChoosesNewestAlternative =
json420 = cPackage "json" (4, 2, 0, Nothing) []
db = cDB [json150, json420]
test_doesNotChoosePrereleaseByDefault :: Test.EasyCheck.Prop
test_doesNotChoosePrereleaseByDefault :: Prop
test_doesNotChoosePrereleaseByDefault =
maybeResolvedPackages (resolve defaultConfig pkg db) -=- Just [b109, pkg]
where pkg = cPackage "A" (0, 0, 1, Nothing) [cDep "B" ">= 1.0.0"]
......@@ -668,7 +668,7 @@ test_doesNotChoosePrereleaseByDefault =
b110b1 = cPackage "B" (1, 1, 0, Just "b1") []
db = cDB [b109, b110b1]
test_upgradesPackageToPrereleaseWhenNeccesary :: Test.EasyCheck.Prop
test_upgradesPackageToPrereleaseWhenNeccesary :: Prop
test_upgradesPackageToPrereleaseWhenNeccesary =
maybeResolvedPackages (resolve defaultConfig pkg db) -=- Just [b110b1, c, pkg]
where pkg = cPackage "A" (0, 0, 1, Nothing) [cDep "C" "= 1.2.0"]
......@@ -677,7 +677,7 @@ test_upgradesPackageToPrereleaseWhenNeccesary =
c = cPackage "C" (1, 2, 0, Nothing) [cDep "B" ">= 1.1.0-b1"]
db = cDB [b109, b110b1, c]
test_prefersLocalPackageCacheEvenIfOlder :: Test.EasyCheck.Prop
test_prefersLocalPackageCacheEvenIfOlder :: Prop
test_prefersLocalPackageCacheEvenIfOlder =
maybeResolvedPackages (resolve defaultConfig pkg db) -=- Just [b101, pkg]
where pkg = cPackage "A" (0, 0, 1, Nothing) [cDep "B" ">= 1.0.0"]
......@@ -685,7 +685,7 @@ test_prefersLocalPackageCacheEvenIfOlder =
b105 = cPackage "B" (1, 0, 5, Nothing) []
db = addPackage (addPackage emptySet b101 FromLocalCache) b105 FromRepository
test_reportsCompilerIncompatibility :: Test.EasyCheck.Prop
test_reportsCompilerIncompatibility :: Prop
test_reportsCompilerIncompatibility = showResult result -=- "The package json-1.0.0, dependency constraint json = 1.0.0, is not compatible to the current compiler. It was activated because:\nsample\n |- json (json = 1.0.0)"
where result = resolve defaultConfig pkg db
pkg = cPackage "sample" (0, 0, 1, Nothing) [cDep "json" "= 1.0.0"]
......
......@@ -12,7 +12,7 @@ import AbstractCurry.Files
import AbstractCurry.Pretty
import AbstractCurry.Types
import Directory
import Test.EasyCheck
import Test.Prop
--- Test for equality of an AbstractCurry program with the same program
--- after pretty printing and reading this AbstractCurry program:
......
......@@ -3,8 +3,6 @@
-- Runt test with:
-- > cass NonDetDeps NonDetTest.curry
import SetFunctions
last xs | _ ++ [x] == xs = x where x free
lastfp (_ ++ [x]) = x
......@@ -26,7 +24,3 @@ g x = f x
-- non-determinism depends on `f`.
-- However, the analysis NonDetAllDeps reports also the dependency
-- on the non-deterministic operations coin, last,...
main0 = set0 lastCoin
main1 = set1 last [1,2,3]
main2 = set1 last [1,2,coin]
......@@ -8,7 +8,7 @@
import FlatCurry.Types
import FlatCurry.Files
import FlatCurry.Goodies
import Test.EasyCheck
import Test.Prop
testIdentityTransformation = identity `returns` True
......
......@@ -7,14 +7,13 @@
import FlatCurry.Types
import FlatCurry.Files
import FlatCurry.XML
import SearchTree(someValue)
import XML
import Test.Prop
-- Shows a program in XML format:
showxml mod = do
prog <- readFlatCurry mod
putStrLn (someValue (showXmlDoc (flatCurry2Xml prog)))
putStrLn $ showXmlDoc (flatCurry2Xml prog)
-- Store a program in XML format:
store mod = do
......@@ -27,7 +26,7 @@ testEqualFcy prog = prog == xml2FlatCurry (flatCurry2Xml prog)
readAndTestEqualFcy mod = do
prog <- readFlatCurry mod
return (someValue (testEqualFcy prog))
return $ testEqualFcy prog
testXML_test_for_rev = (readAndTestEqualFcy "rev") `returns` True
......@@ -6,6 +6,7 @@
"synopsis": "A JSON library for Curry",
"category": [ "Data", "Web" ],
"dependencies": {
"base" : ">= 1.0.0, < 2.0.0",
"det-parse": "= 0.0.1",
"wl-pprint": ">= 0.0.1"
},
......
......@@ -4,7 +4,7 @@ import JSON.Data
import Char
import Float
import DetParse
import Test.EasyCheck
import Test.Prop
--- Parses a JSON string into a JValue. Returns Nothing if the string could not
--- be parsed.
......@@ -31,19 +31,19 @@ pObject' = (:) <$> (pWhitespace *> pKeyValuePair) <*> (pWhitespace *> char ',' *
pKeyValuePair :: Parser (String, JValue)
pKeyValuePair = (,) <$> pString <*> (pWhitespace *> char ':' *> pWhitespace *> pJValue)
test_pObject_empty :: Test.EasyCheck.Prop
test_pObject_empty :: Prop
test_pObject_empty = parse pObject "{}" -=- Just (JObject [])
test_pObject_onlyStringKeys :: Test.EasyCheck.Prop
test_pObject_onlyStringKeys :: Prop
test_pObject_onlyStringKeys = parse pObject "{1: 2}" -=- Nothing
test_pObject_simple :: Test.EasyCheck.Prop
test_pObject_simple :: Prop
test_pObject_simple = parse pObject "{\"test\": 1, \"test2\": false}" -=- Just (JObject [("test", JNumber 1.0), ("test2", JFalse)])
test_pObject_whitespace :: Test.EasyCheck.Prop
test_pObject_whitespace :: Prop
test_pObject_whitespace = parse pObject "{\n \"test\": 1,\n \"test2\": false\n}" -=- Just (JObject [("test", JNumber 1.0), ("test2", JFalse)])
test_pObject_nested :: Test.EasyCheck.Prop
test_pObject_nested :: Prop
test_pObject_nested = parse pObject "{\"test\": {\"hello\": \"world\"}}" -=- Just (JObject [("test", JObject [("hello", JString "world")])])
pArray :: Parser JValue
......@@ -53,16 +53,16 @@ pArray = JArray <$> (char '[' *> pWhitespace *> pArray' <* pWhitespace <* char
pArray' :: Parser [JValue]
pArray' = (:) <$> (pWhitespace *> pJValue) <*> ((pWhitespace *> char ',' *> pArray') <|> yield [])
test_pArray_empty :: Test.EasyCheck.Prop
test_pArray_empty :: Prop
test_pArray_empty = parse pArray "[]" -=- Just (JArray [])
test_pArray_single :: Test.EasyCheck.Prop
test_pArray_single :: Prop
test_pArray_single = parse pArray "[1]" -=- Just (JArray [JNumber 1.0])
test_pArray_multi :: Test.EasyCheck.Prop
test_pArray_multi :: Prop
test_pArray_multi = parse pArray "[true, false, null]" -=- Just (JArray [JTrue, JFalse, JNull])
test_pArray_nested :: Test.EasyCheck.Prop
test_pArray_nested :: Prop
test_pArray_nested = parse pArray "[true, [false], [[null]]]" -=- Just (JArray [JTrue, JArray [JFalse], JArray [JArray [JNull]]])
pWhitespace :: Parser ()
......@@ -110,52 +110,52 @@ pTwoByteHex = hexToInt <$> ((:) <$> pHexDigit <*> ((:) <$> pHexDigit <*> ((:) <$
hexToInt :: String -> Int
hexToInt s = foldl1 ((+).(16*)) (map digitToInt s)
test_pCharSequence_simple :: Test.EasyCheck.Prop
test_pCharSequence_simple :: Prop
test_pCharSequence_simple = parse pCharSequence "test" -=- Just "test"
test_pCharSequence_noDoubleQuote :: Test.EasyCheck.Prop
test_pCharSequence_noDoubleQuote :: Prop
test_pCharSequence_noDoubleQuote = parse pCharSequence "te\"st" -=- Nothing
test_pCharSequence_noStandaloneBackslash :: Test.EasyCheck.Prop
test_pCharSequence_noStandaloneBackslash :: Prop
test_pCharSequence_noStandaloneBackslash = parse pCharSequence "He\\world" -=- Nothing
test_pCharSequence_escapedDoubleQuote :: Test.EasyCheck.Prop
test_pCharSequence_escapedDoubleQuote :: Prop
test_pCharSequence_escapedDoubleQuote = parse pCharSequence "Hello \\\"World\\\"" -=- Just "Hello \"World\""
test_pCharSequence_escapedBackslash :: Test.EasyCheck.Prop
test_pCharSequence_escapedBackslash :: Prop
test_pCharSequence_escapedBackslash = parse pCharSequence "He\\\\world" -=- Just "He\\world"
test_pCharSequence_escapedSlash :: Test.EasyCheck.Prop
test_pCharSequence_escapedSlash :: Prop
test_pCharSequence_escapedSlash = parse pCharSequence "He\\/world" -=- Just "He/world"
test_pCharSequence_escapedBackspace :: Test.EasyCheck.Prop
test_pCharSequence_escapedBackspace :: Prop
test_pCharSequence_escapedBackspace = parse pCharSequence "He\\bworld" -=- Just "He\bworld"
test_pCharSequence_escapedFormFeed :: Test.EasyCheck.Prop
test_pCharSequence_escapedFormFeed :: Prop
test_pCharSequence_escapedFormFeed = parse pCharSequence "He\\fworld" -=- Just "He\fworld"
test_pCharSequence_escapedNewline :: Test.EasyCheck.Prop
test_pCharSequence_escapedNewline :: Prop
test_pCharSequence_escapedNewline = parse pCharSequence "He\\nworld" -=- Just "He\nworld"
test_pCharSequence_escapedCarriageReturn :: Test.EasyCheck.Prop
test_pCharSequence_escapedCarriageReturn :: Prop
test_pCharSequence_escapedCarriageReturn = parse pCharSequence "He\\rworld" -=- Just "He\rworld"
test_pCharSequence_escapedTab :: Test.EasyCheck.Prop
test_pCharSequence_escapedTab :: Prop
test_pCharSequence_escapedTab = parse pCharSequence "He\\tworld" -=- Just "He\tworld"
test_pCharSequence_twoEscapes :: Test.EasyCheck.Prop
test_pCharSequence_twoEscapes :: Prop
test_pCharSequence_twoEscapes = parse pCharSequence "He\\r\\nWorld" -=- Just "He\r\nWorld"
test_pCharSequence_escapedUnicodeChar :: Test.EasyCheck.Prop
test_pCharSequence_escapedUnicodeChar :: Prop
test_pCharSequence_escapedUnicodeChar = parse pCharSequence "Hello \\u2603 World" -=- Just "Hello ☃ World"
test_pCharSequence_escapedUnicodeRequiresFourDigits :: Test.EasyCheck.Prop
test_pCharSequence_escapedUnicodeRequiresFourDigits :: Prop
test_pCharSequence_escapedUnicodeRequiresFourDigits = parse pCharSequence "Hello \\u26 World" -=- Nothing
test_pString_simple :: Test.EasyCheck.Prop
test_pString_simple :: Prop
test_pString_simple = parse pString "\"Hello, World\"" -=- Just "Hello, World"
test_pString_complex :: Test.EasyCheck.Prop
test_pString_complex :: Prop
test_pString_complex = parse pString "\"Hello \\r\\n \\u2603 World\"" -=- Just "Hello \r\n ☃ World"
pJNumber :: Parser JValue
......
-- A few auxiliary functions to formulate tests with random numbers.
module RandomTest ( test, eq ) where
import List ( nub )
import Test.EasyCheck
import System.Random
--- Tests a given predicate on a list of distinct random numbers.
--- In case of a failure, the list of random numbers is returned
--- in order to see the test cases in the CurryTest tool.
test :: ([Int] -> Bool) -> PropIO
test f = (rndList lenRnds >>= \xs -> return (if f xs then Nothing else Just xs))
`returns` Nothing
--- Tests whether two operations return equal results
--- on a list of distinct random numbers.
--- In case of a failure, the list of random numbers is returned
--- in order to see the test cases in the CurryTest tool.
eq :: Eq a => ([Int] -> a) -> ([Int] -> a) -> PropIO
eq f g = test (\x -> (f x)==(g x))
--- generate a list of at most n random numbers (without duplicated elements)
rndList :: Int -> IO [Int]
rndList n = getRandomSeed >>= return . nub . take n . (flip nextIntRange 100000)
--- maximal length of test lists
lenRnds :: Int
lenRnds = 1000
import List
import Test.Prop
import System.Random
import Data.Queue
import RandomTest
deq f = f . listToDeq
......@@ -29,3 +31,30 @@ testLength = eq (deq deqLength) length
testRotate = eq (deqs rotate) (\ (x:xs) -> xs ++ [x])
------------------------------------------------------------------------------
-- Random test:
--- Tests a given predicate on a list of distinct random numbers.
--- In case of a failure, the list of random numbers is returned
--- in order to see the test cases in the CurryTest tool.
test :: ([Int] -> Bool) -> PropIO
test f =
(rndList lenRnds >>= \xs -> return (if f xs then Nothing else Just xs))
`returns` Nothing
--- Tests whether two operations return equal results
--- on a list of distinct random numbers.
--- In case of a failure, the list of random numbers is returned
--- in order to see the test cases in the CurryTest tool.
eq :: Eq a => ([Int] -> a) -> ([Int] -> a) -> PropIO
eq f g = test (\x -> (f x)==(g x))
--- generate a list of at most n random numbers (without duplicated elements)
rndList :: Int -> IO [Int]
rndList n = getRandomSeed >>= return . nub . take n . (flip nextIntRange 100000)
--- maximal length of test lists
lenRnds :: Int
lenRnds = 1000
------------------------------------------------------------------------------