From 39b407a6d147bd2f4d0bf494316129bae209dc93 Mon Sep 17 00:00:00 2001 From: EMQ-YangM Date: Thu, 6 Aug 2020 14:42:17 +0800 Subject: [PATCH] feat(QuickCheck): add 'instance Arbitrary (a, b)' --- lib/Data/Eq.hm | 4 ++++ lib/Data/Map.hm | 7 ++----- lib/System/IO/Printf.hm | 10 +++++++--- lib/Test/QuickCheck.hm | 10 +++++----- src/Language/Hamler/CodeGen.hs | 8 ++++++++ stack.yaml | 2 +- tests/Test/Data/Map.hm | 6 +++++- 7 files changed, 32 insertions(+), 15 deletions(-) diff --git a/lib/Data/Eq.hm b/lib/Data/Eq.hm index d91b53f6..24692443 100644 --- a/lib/Data/Eq.hm +++ b/lib/Data/Eq.hm @@ -19,6 +19,7 @@ module Data.Eq ) where import Data.Unit (Unit) +import Data.Bool ((&&)) class Eq a where eq :: a -> a -> Boolean @@ -51,6 +52,9 @@ instance Eq Float where instance Eq a => Eq (List a) where eq = eqListImpl +instance (Eq a, Eq b) => Eq (a, b) where + eq (a, b) (c, d) = a == c && b == d + instance Eq Unit where eq _ _ = true diff --git a/lib/Data/Map.hm b/lib/Data/Map.hm index a45b3ebf..d5acb2c3 100644 --- a/lib/Data/Map.hm +++ b/lib/Data/Map.hm @@ -15,7 +15,7 @@ module Data.Map where import Data.Maybe (Maybe) -import Control.Monad(bind, return) +import Control.Monad((<$>)) import Foreign (ffi0, ffi1, ffi2, ffi3, ffi4) import Test.QuickCheck (arbitrary, class Arbitrary) import Data.Eq @@ -132,10 +132,7 @@ tzip [] y = [] tzip [x|xs] [y|ys] = [ (x,y) | tzip xs ys ] instance (Arbitrary k, Arbitrary v) => Arbitrary (Map k v) where - arbitrary = do - xs1 <- arbitrary - xs2 <- arbitrary - return (fromList (tzip xs1 xs2)) + arbitrary = fromList <$> arbitrary instance Eq (Map a b) where eq = eqMapImpl diff --git a/lib/System/IO/Printf.hm b/lib/System/IO/Printf.hm index 01eb52af..a558a02d 100644 --- a/lib/System/IO/Printf.hm +++ b/lib/System/IO/Printf.hm @@ -86,10 +86,14 @@ instance (PrintArg a, Printf t) => Printf (a -> t) where class PrintArg a where render :: Control -> a -> String +partcal' :: Integer -> Integer -> String +partcal' _ 0 = "" +partcal' k x = let (a,b) = (x/k,x%k) + in partcal' k a <> rhex b + partcal :: Integer -> Integer -> String -partcal _ 0 = "" -partcal k x = let (a,b) = (x/k,x%k) - in partcal k a <> rhex b +partcal _ 0 = "0" +partcal k x = partcal' k x rstr :: Integer -> String rstr 2 = "0B" diff --git a/lib/Test/QuickCheck.hm b/lib/Test/QuickCheck.hm index b17d2fab..04f75216 100644 --- a/lib/Test/QuickCheck.hm +++ b/lib/Test/QuickCheck.hm @@ -32,7 +32,7 @@ import Data.Tuple (fst) import Data.Foldable (foldl) import Data.Traversable (sequence) import Data.Unit (Unit) -import Control.Monad (class Applicative, pure, class Monad, return, bind, IO, discard, seqio, (>>=)) +import Control.Monad (liftM2, class Applicative, pure, class Monad, return, bind, IO, discard, seqio, (>>=)) import System.IO (printf, println) import System.Random(randomRIO) import Data.Binary (listToBin) @@ -158,8 +158,8 @@ instance Arbitrary Binary where tabs x | x >= 0 = x | otherwise = (-x) --- instance (Arbitrary a, Arbitrary b) => Arbitrary (a, b) where --- arbitrary = liftM2 (\x y -> (x,y)) arbitrary arbitrary +instance (Arbitrary a, Arbitrary b) => Arbitrary (a, b) where + arbitrary = liftM2 (\x y -> (x,y)) arbitrary arbitrary instance Arbitrary a => Arbitrary [a] where arbitrary = sized (\n -> choose (0,n) >>= vector) @@ -224,7 +224,7 @@ check s 0 m n = (printf "%s----- %s " (replicate n ' ') s :: IO ()) >>= \_ check s v m n = do i <- randomRIO 1332292274972041455 7304856964418773083 let Gen fun = evaluate m - Result r = fun 10 (mkRand i) + Result r = fun 15 (mkRand i) case r.ok of Just true -> check s (v-1) m n Just false -> (printf "%sxxxxx %s -----> %s" @@ -259,7 +259,7 @@ runTest g = do res <- runTestGroup 0 g let res1 = tgToList res (succ, fail, total) = tcount (0,0,0) res1 - printf "total test functions %d, successed %d, failed %d" total succ fail + printf "total test functions %d, successed %d, failed %d." total succ fail tcount :: (Integer, Integer, Integer) -> [TestResult] -> (Integer, Integer, Integer) tcount (a,b,c) [] = (a,b,c) diff --git a/src/Language/Hamler/CodeGen.hs b/src/Language/Hamler/CodeGen.hs index e69ac7bf..acc6ca79 100644 --- a/src/Language/Hamler/CodeGen.hs +++ b/src/Language/Hamler/CodeGen.hs @@ -410,6 +410,10 @@ literalToErl (ListLiteral xs) = do literalToErl (TupleLiteral xs) = do xs' <- mapM exprToErl xs return . ann . ETuple $ fmap (ann . Expr) xs' +literalToErl (Tuple2Literal a b) = do + a' <- exprToErl a + b' <- exprToErl b + return . ann . ETuple $ fmap (ann . Expr) [a', b'] literalToErl (ObjectLiteral xs) = do xs' <- forM xs $ \(pps, e) -> do e' <- exprToErl e @@ -568,6 +572,10 @@ literalBinderToPat (ListLiteral xs) = do literalBinderToPat (TupleLiteral xs) = do xs' <- mapM binderToPat xs return . ann $ E.PTuple xs' +literalBinderToPat (Tuple2Literal a b) = do + a' <- binderToPat a + b' <- binderToPat b + return . ann $ E.PTuple [a', b'] literalBinderToPat (ObjectLiteral xs) = do xs' <- forM xs $ \(pps, e) -> do e' <- binderToPat e diff --git a/stack.yaml b/stack.yaml index 436854c8..6cb3344e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -13,7 +13,7 @@ extra-deps: - github: hamler-lang/CoreErlang commit: 2bacba611fed9eb773939964aa70e3ad49b8c816 - github: hamler-lang/purescript - commit: e03f1b9516cd439c3b384e658c2201f2a48e1ac3 + commit: 5c41feb6c3f0605238364020dafd1387f1b7eee0 - megaparsec-8.0.0@sha256:362f85e243ecbcb550e1de6e5c74ba5a50c09edaa1208c99bc5b9fd242227fc6,3808 flags: these: diff --git a/tests/Test/Data/Map.hm b/tests/Test/Data/Map.hm index ac0a5be4..3bdcd268 100644 --- a/tests/Test/Data/Map.hm +++ b/tests/Test/Data/Map.hm @@ -32,6 +32,9 @@ propMapMap m1 f = let l1 = M.toList m1 lf1 = \(k,v) -> f v in M.fromList (map lf l1) == M.map lf1 m1 +propInsert :: M.Map Integer Integer -> Integer -> Integer -> Boolean +propInsert m k v = M.insert k v m == M.insert k v (M.insert k v m) + baseMap :: M.Map Integer Integer baseMap = M.fromList [(1,2),(2,3),(3,4)] @@ -43,6 +46,7 @@ test = Exe [ quickCheck "put_get " propMapPutGet , quickCheck "singleton" (M.singleton 1 2 == M.fromList [(1,2)]) , quickCheck "isKey" (M.isKey 1 baseMap) , quickCheck "insert" (M.insert 1 3 baseMap == M.fromList [(1,3),(2,3),(3,4)]) + , quickCheck "prop_insert" propInsert , quickCheck "get" (M.get 1 baseMap == 2) , quickCheck "lookup_Just" (M.lookup 1 baseMap == Just 2) , quickCheck "lookup_Nothing" (M.lookup 10 baseMap == Nothing) @@ -52,7 +56,7 @@ test = Exe [ quickCheck "put_get " propMapPutGet , quickCheck "not_member" (M.notMember 10 baseMap == true) , quickCheck "update" (M.update 1 10 baseMap == M.fromList [(1,10),(2,3),(3,4)]) , quickCheck "updateWith" (M.updateWith 1 (\x -> x+1) baseMap == M.fromList [(1,3),(2,3),(3,4)]) - , quickCheck "updateWithInit" (M.updateWithInit 10 (\x -> x+1) 10 baseMap == M.fromList [(1,3),(2,3),(3,4),(10,10)]) + , quickCheck "updateWithInit" (M.updateWithInit 10 (\x -> x+1) 10 baseMap == M.fromList [(1,2),(2,3),(3,4),(10,10)]) , quickCheck "take" (case M.take 1 baseMap of Just (2, v) -> v == M.fromList [(2,3),(3,4)] _ -> error "error happened"