Permalink
Browse files

generics tests + make tests be wrt local sources

  • Loading branch information...
1 parent fca62dd commit b3c0d8407c97d6c26159fc87021b95625d243dab Sigbjorn Finne committed Jan 12, 2009
Showing with 87 additions and 2 deletions.
  1. +81 −0 tests/GenericTest.hs
  2. +6 −2 tests/Makefile
View
@@ -0,0 +1,81 @@
+{-# LANGUAGE DeriveDataTypeable, ExtendedDefaultRules, EmptyDataDecls #-}
+module Main where
+import Text.JSON.Generic
+import Data.Word
+import Data.Int
+
+data Foo = Foo { a :: Int, b :: Bool, c :: Baz } | None
+ deriving (Typeable, Data, Show, Eq)
+
+data Baz = Baz Int
+ deriving (Typeable, Data, Show, Eq)
+
+data Bar = Int :+: Int | Zero
+ deriving (Typeable, Data, Show, Eq)
+
+newtype New a = New a
+ deriving (Typeable, Data, Show, Eq)
+
+newtype Apples = Apples { noApples :: Int }
+ deriving (Typeable, Data, Show, Eq)
+
+data Record = Record { x :: Int, y :: Double, z :: Float, s :: String, t :: (Bool, Int) }
+ deriving (Typeable, Data, Show, Eq)
+
+rec = Record { x = 1, y = 2, z = 3.5, s = "hello", t = (True, 0) }
+
+data Tree a = Leaf | Node (Tree a) a (Tree a)
+ deriving (Typeable, Data, Show, Eq)
+
+atree = build 4
+ where build 0 = Leaf
+ build 1 = Node Leaf 100 Leaf
+ build n = Node (build (n-1)) n (build (n-2))
+
+data Color = Red | Green | Blue
+ deriving (Typeable, Data, Show, Eq, Enum)
+
+from (Ok x) = x
+from (Error s) = error s
+
+viaJSON :: (Data a) => a -> a
+viaJSON = from . fromJSON . toJSON
+
+testJSON :: (Data a, Eq a) => a -> Bool
+testJSON x = --x == viaJSON x
+ x == decodeJSON (encodeJSON x)
+
+tests = and [
+ testJSON (1::Integer),
+ testJSON (42::Int),
+ testJSON (100::Word8),
+ testJSON (-1000::Int64),
+ testJSON (4.2::Double),
+ testJSON (4.1::Float),
+ testJSON True,
+ testJSON 'q',
+ testJSON "Hello, World\n",
+ testJSON (Nothing :: Maybe Int),
+ testJSON (Just "aa"),
+ testJSON [],
+ testJSON [1,2,3,4],
+ testJSON (Left 1 :: Either Int Bool),
+ testJSON (Right True :: Either Int Bool),
+ testJSON (1,True),
+ testJSON (1,2,True,'a',"apa",(4.5,99)),
+ testJSON $ Baz 11,
+ testJSON $ Foo 1 True (Baz 42),
+ testJSON None,
+ testJSON $ 2 :+: 3,
+ testJSON Zero,
+ testJSON $ New (2 :+: 3),
+ testJSON rec,
+ testJSON [LT,EQ,GT],
+ testJSON atree,
+ testJSON (),
+ testJSON $ Apples 42,
+ testJSON [Red .. Blue]
+ ]
+
+main :: IO ()
+main = if tests then return () else error "Generic test failed"
View
@@ -4,9 +4,13 @@ $(ODIR):
mkdir $(ODIR)
all: $(ODIR)
- ghc -cpp -O QC.hs --make -o QC -no-recomp -odir=$(ODIR) -hidir=$(ODIR)
+ ghc -cpp -O QC.hs --make -o QC -no-recomp -i.. -odir=$(ODIR) -hidir=$(ODIR)
time ./QC
- runhaskell HUnit.hs
+ runhaskell -i.. HUnit.hs
+
+generic: $(ODIR)
+ ghc -i.. --make -fforce-recomp -odir=$(ODIR) -hidir=$(ODIR) GenericTest.hs -o GenericTest
+ ./GenericTest
clean:
$(RM) -r $(ODIR)

0 comments on commit b3c0d84

Please sign in to comment.