{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-binds #-} -- | -- Module : Network.Format.LLSD.Test -- Copyright : (c) Linden Lab 2009 -- License : MIT -- Maintainer : bos@lindenlab.com -- Stability : provisional -- Portability : portable module Network.Format.LLSD.Test ( runTests, runChecks ) where import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as C import qualified Data.ByteString.Lazy.UTF8 as U import Data.Char (ord) import Data.List (foldl') import qualified Data.Map as Map import Data.Maybe (fromJust) import Data.Time import qualified Data.UUID as UUID import Network.Format.LLSD import qualified Network.URI as URI import System.IO (stderr) import Test.HUnit import Test.QuickCheck {- unit tests to write path access updating SData extension llsd size get 34 l get "foo" l set 34 thing l set "foo" thing l getPath ("abc" ./ "def") l setPath ("abc" ./ "def") v l -- test paths with strings and with numbers test parsing of with, at, ./ and .= -} instance Arbitrary Char where arbitrary = choose ('\32', '\xcfff') -- FIXME: expand to all Unicode chars coarbitrary c = variant (ord c `rem` 4) -- boilerplate for using Char with Test.QuickCheck -- -- Identity Conversion Tests -- prop_toFromIdentity :: (Eq a, SData a) => a -> Bool prop_toFromIdentity a = fromLLSD (toLLSD a) == a prop_BoolToFromIdentity :: Bool -> Bool prop_BoolToFromIdentity = prop_toFromIdentity prop_IntToFromIdentity :: Int -> Bool prop_IntToFromIdentity = prop_toFromIdentity prop_DoubleToFromIdentity :: Double -> Bool prop_DoubleToFromIdentity = prop_toFromIdentity prop_StringToFromIdentity :: String -> Bool prop_StringToFromIdentity = prop_toFromIdentity nullUUID = fromJust $ UUID.fromString "00000000-0000-0000-0000-000000000000" someUUID = fromJust $ UUID.fromString "14409e2f-5588-4c12-b719-ff33f614e3b7" nullDate = UTCTime (fromGregorian 1970 01 01) (secondsToDiffTime 0) someDate = UTCTime (fromGregorian 2003 06 23) (secondsToDiffTime $ 4*3600) nullURI = URI.nullURI someURI = fromJust $ URI.parseURI "http://slurl.com/secondlife/Ambleside/57/104/26" nullBytes = L.empty someBytes = L.pack [222, 173, 190, 239] test_identity = "scalar type identities" ~: TestList [ prop_toFromIdentity True ~? "true identity", prop_toFromIdentity False ~? "false identity", prop_toFromIdentity(42::Int) ~? "42 identity", prop_toFromIdentity(0::Int) ~? "zero identity", prop_toFromIdentity(-12345::Int) ~? "neg identity", prop_toFromIdentity(2000000000::Int) ~? "big identity", prop_toFromIdentity(3.14159265359::Double) ~? "pi identity", prop_toFromIdentity(6.7e256::Double) ~? "big float identity", prop_toFromIdentity "now is the time" ~? "string identity", prop_toFromIdentity nullUUID ~? "null uuid identity", prop_toFromIdentity someUUID ~? "some uuid identity", prop_toFromIdentity nullDate ~? "null date identity", prop_toFromIdentity someDate ~? "some date identity", prop_toFromIdentity nullURI ~? "null URI identity", prop_toFromIdentity someURI ~? "some URI identity", prop_toFromIdentity nullBytes ~? "null byte array", prop_toFromIdentity someBytes ~? "some byte array" ] props_identity = [ label "prop_BoolToFromIdentity" prop_BoolToFromIdentity, label "prop_IntToFromIdentity" prop_IntToFromIdentity, label "prop_DoubleToFromIdentity" prop_DoubleToFromIdentity, label "prop_StringToFromIdentity" prop_StringToFromIdentity ] -- FIXME: test identity conversion of Maybe abs -- FIXME: test identity conversion of lists -- FIXME: test identity conversion of maps -- -- Conversion Tests -- test_conversion :: (SData a, Show a) => a -> Bool -> Int -> Double -> String -> Test test_conversion av eb ei ed es = show av ~: TestList $ map TestCase [ fromLLSD al @?= eb, fromLLSD al @?= ei, not (fromLLSD al < ed || fromLLSD al > ed) @? "double compare", -- written this way to handle NaNs correctly fromLLSD al @?= es ] where al = toLLSD av test_IntConversion :: Int -> Bool -> Int -> Double -> String -> Test test_IntConversion = test_conversion test_DoubleConversion :: Double -> Bool -> Int -> Double -> String -> Test test_DoubleConversion = test_conversion test_toFromString :: (SData a, Show a, Eq a) => a -> String -> Test test_toFromString av es = show av ~: TestList $ map TestCase [ fromLLSD (toLLSD av) @?= es, fromLLSD (toLLSD es) @?= av ] test_conversions = "conversions" ~: TestList [ test_conversion llsd False 0 0.0 "", test_conversion False False 0 0.0 "", test_conversion True True 1 1.0 "true", test_IntConversion 0 False 0 0.0 "0", test_IntConversion 1 True 1 1.0 "1", test_IntConversion (-33) True (-33) (-33.0) "-33", test_DoubleConversion 0.0 False 0 0.0 "0.0", -- differs from C, which gives just "0" for string conversion test_DoubleConversion 0.5 True 0 0.5 "0.5", test_DoubleConversion 0.9 True 1 0.9 "0.9", -- differs from C, which seems to use trunc for int conversion test_DoubleConversion (-3.9) True (-4) (-3.9) "-3.9", -- differs from C, which seems to use trunc for int conversion test_DoubleConversion (sqrt(-1)) False 0 (sqrt(-1)) "NaN", -- differs from C, which gives "nan" for string conversion test_conversion "" False 0 0.0 "", test_conversion "0" True 0 0.0 "0", test_conversion "10" True 10 10.0 "10", test_conversion "-2.345" True (-2) (-2.345) "-2.345", test_conversion "apple" True 0 0.0 "apple", test_conversion "33bob" True 0 0.0 "33bob", test_conversion " " True 0 0.0 " ", test_conversion "\n" True 0 0.0 "\n", test_toFromString nullUUID "00000000-0000-0000-0000-000000000000", test_toFromString someUUID "14409e2f-5588-4c12-b719-ff33f614e3b7", test_toFromString nullDate "1970-01-01T00:00:00Z", test_toFromString someDate "2003-06-23T04:00:00Z", test_toFromString nullURI "", test_toFromString someURI "http://slurl.com/secondlife/Ambleside/57/104/26" ] compile_fromLLSD :: LLSD -> Bool compile_fromLLSD v = b && (i /= 0) && (d /= 0.0) && (s /= "") where b :: Bool b = fromLLSD v i :: Int i = fromLLSD v d :: Double d = fromLLSD v s :: String s = fromLLSD v compile_toLLSD :: Bool -> Int -> Double -> String -> LLSD compile_toLLSD b i d s = toLLSD [vb, vi, vd, vs] where vb, vi, vd, vs :: LLSD vb = toLLSD b vi = toLLSD i vd = toLLSD d vs = toLLSD s prop_arrayHasIndex :: [Int] -> Bool prop_arrayHasIndex is = all sameAsElem $ range is where ls = foldl' (\l i -> l `with` i .= "bob") undef is sameAsElem i = (hasIndex i ls) == (elem i is) range [] = [-1..1] range is' = [minimum is' - 1 .. maximum is' + 1] prop_mapHasKey :: [String] -> Bool prop_mapHasKey ks = all sameAsElem $ range ks where ls = foldl' (\l k -> l `with` k .= "bob") undef ks sameAsElem k = (hasKey k ls) == (elem k ks) range [] = ["a", "z"] range ks' = ks ++ map (++"x") ks' ++ map ("x"++) ks' {- prop_mapHasMaps :: [String] -> Bool prop_mapHasMaps ks = all sameAsPrefix $ paths ks where ls = foldl' (\l k -> l `with` k .= "yo") undef ks sameAsPrefix p = (hasPath p ls) == (isPrefixOf p ks) -} props_has = [ label "prop_arrayHas" prop_arrayHasIndex, label "prop_mapHas" prop_mapHasKey ] -- -- XML Format Tests -- test_xmlFormat :: (SData a, Show a) => a -> String -> Test test_xmlFormat v xml = xml ~=? (U.toString . formatXML . toLLSD $ v) test_xmlFormats = "XML formats" ~: TestList [ test_xmlFormat undef "", test_xmlFormat True "true", test_xmlFormat False "false", test_xmlFormat (3463::Int) "3463", test_xmlFormat "" "", test_xmlFormat "foobar" "foobar", test_xmlFormat (1.0::Double) "1.0", test_xmlFormat nullUUID "00000000-0000-0000-0000-000000000000", test_xmlFormat someUUID "14409e2f-5588-4c12-b719-ff33f614e3b7", test_xmlFormat nullDate "1970-01-01T00:00:00Z", test_xmlFormat someDate "2003-06-23T04:00:00Z", test_xmlFormat nullURI "", test_xmlFormat someURI "http://slurl.com/secondlife/Ambleside/57/104/26", test_xmlFormat nullBytes "", test_xmlFormat someBytes "3q2+7w==", test_xmlFormat ([]::[Int]) "", test_xmlFormat [undef] "", test_xmlFormat [undef, toLLSD (1::Int)] "1", test_xmlFormat (Map.empty :: Map.Map String Int) "", test_xmlFormat (Map.fromAscList [("foo", "bar")]) "foobar", test_xmlFormat (Map.fromAscList [("foo", toLLSD "bar"), ("baz", undef)]) "foobarbaz" ] -- -- Binary Format Tests -- test_binaryFormat :: (SData a, Show a) => a -> String -> Test test_binaryFormat v binstr = binstr ~=? (C.unpack . formatBinary . toLLSD $ v) test_binaryFormats = "Binary formats" ~: TestList [ test_binaryFormat undef "!", test_binaryFormat True "1", test_binaryFormat False "0", test_binaryFormat (3463::Int) "i\x00\x00\x0d\x87", test_binaryFormat "" "s\x00\x00\x00\x00", test_binaryFormat "foobar" "s\x00\x00\x00\x06\&foobar", test_binaryFormat nullUUID "u\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", test_binaryFormat someUUID "u\x14\x40\x9e\x2f\x55\x88\x4c\x12\xb7\x19\xff\x33\xf6\x14\xe3\xb7", test_binaryFormat nullURI "l\x00\x00\x00\x00", test_binaryFormat someURI "l\x00\x00\x00\x2fhttp://slurl.com/secondlife/Ambleside/57/104/26", test_binaryFormat (1.0::Double) "r\x3f\xf0\x00\x00\x00\x00\x00\x00", test_binaryFormat (3.14159::Double) "r\x40\x09\x21\xF9\xF0\x1B\x86\x6E", test_binaryFormat nullDate "d\x00\x00\x00\x00\x00\x00\x00\x00", test_binaryFormat someDate "d\x41\xCF\x7B\x3D\xA0\x00\x00\x00", test_binaryFormat nullBytes "b\x00\x00\x00\x00", test_binaryFormat someBytes "b\x00\x00\x00\x04\222\173\190\239", test_binaryFormat ([]::[Int]) "[\0\0\0\0]", test_binaryFormat [undef] "[\0\0\0\1!]", test_binaryFormat [undef, toLLSD (1::Int)] "[\0\0\0\2!i\0\0\0\1]", test_binaryFormat (Map.empty :: Map.Map String Int) "{\0\0\0\0}", test_binaryFormat (Map.fromAscList [("foo", "bar")]) "{\0\0\0\1k\0\0\0\3foos\0\0\0\3bar}", test_binaryFormat (Map.fromAscList [("foo", toLLSD "bar"), ("baz", undef)]) "{\0\0\0\2k\0\0\0\3foos\0\0\0\3bark\0\0\0\3baz!}" ] -- -- Round Trip Tests -- prop_roundtrip :: (SData a, Eq a) => (LLSD -> Either String LLSD) -> a -> Bool prop_roundtrip rt v = case rt lv of (Left _) -> False (Right lw) -> v == fromLLSD lw where lv = toLLSD v -- FIXME: should be testing the structural equality of the LLSDs prop_mapRoundtrip :: (SData a, Eq a) => (LLSD -> Either String LLSD) -> [(String, a)] -> Bool prop_mapRoundtrip rt v = prop_roundtrip rt (Map.fromAscList v) test_roundtrip s rt = s ++ " Roundtrips" ~: TestList [ --prop_roundtrip rt undef ~? "undef", prop_roundtrip rt True ~? "true", prop_roundtrip rt False ~? "false", prop_roundtrip rt (1::Int) ~? "one", prop_roundtrip rt (0::Int) ~? "zero", prop_roundtrip rt (-1::Int) ~? "negative one", prop_roundtrip rt (1234.5::Double) ~? "float", prop_roundtrip rt (0.0::Double) ~? "float zero", prop_roundtrip rt (-1234.5::Double) ~? "negative float", prop_roundtrip rt "" ~? "empty string", prop_roundtrip rt "some string" ~? "some string", prop_roundtrip rt nullUUID ~? "null UUID", prop_roundtrip rt someUUID ~? "some UUID", prop_roundtrip rt nullDate ~? "null date", prop_roundtrip rt someDate ~? "some date", prop_roundtrip rt nullURI ~? "null URI", prop_roundtrip rt someURI ~? "some URI", prop_roundtrip rt nullBytes ~? "null byte array", prop_roundtrip rt someBytes ~? "some byte array" ] props_roundtrip s rt = [ label (s ++ "prop_BoolToFromIdentity") (prop_roundtrip rt :: Bool -> Bool), label (s ++ "prop_IntToFromIdentity") (prop_roundtrip rt :: Int -> Bool), label (s ++ "prop_DoubleToFromIdentity") (prop_roundtrip rt :: Double -> Bool), label (s ++ "prop_StringToFromIdentity") (prop_roundtrip rt :: String -> Bool), label (s ++ "prop_ArrayToFromIdentity") (prop_roundtrip rt :: [String] -> Bool), label (s ++ "prop_MapToFromIdentity") (prop_mapRoundtrip rt :: [(String, Int)] -> Bool) ] test_xmlRoundtrip = test_roundtrip "XML" (parseXML . toByteString . formatXML) props_xmlRoundtrip = props_roundtrip "XML" (parseXML . toByteString . formatXML) test_binaryRoundtrip = test_roundtrip "Binary" (parseBinary . toByteString . formatBinary) props_binaryRoundtrip = props_roundtrip "Binary" (parseBinary . toByteString . formatBinary) toByteString :: L.ByteString -> B.ByteString toByteString = B.concat . L.toChunks addExample :: LLSD -> LLSD addExample origLLSD = origLLSD `with` "p1" ./ "name" .= "Bob" `with` "p1" ./ "age" .= (45::Int) `with` "p2" ./ "name" .= "Amy" `with` "p2" ./ "age" .= (36::Int) fetchAge :: String -> LLSD -> Int fetchAge ident d = d `at` ident ./ "age" fetchName :: String -> LLSD -> String fetchName ident d = d `at` ident ./ "name" setSize :: String -> String -> LLSD -> LLSD setSize ident s d = d `with` ident ./ "size" .= s data Address = Address String String String Int deriving (Eq, Show) instance SData Address where toLLSD (Address street city state zipcode) = llsd `with` "street" .= street `with` "city" .= city `with` "state" .= state `with` "zip" .= zipcode fromLLSD v = Address (v `at` "street") (v `at` "city") (v `at` "state") (v `at` "zip") setAddress :: String -> Address -> LLSD -> LLSD setAddress ident add d = d `with` ident ./ "address" .= add data Part = Part { name:: String, weight:: Double, location:: (Int, Int) } instance SData Part where toLLSD p = llsd `with` "name" .= name p `with` "weight" .= weight p `with` "location" .= [fst $ location p, snd $ location p] fromLLSD v = Part { name = v `at` "name", weight = v `at` "weight", location = (v `at` "location" ./ (0::Int), v `at` "location" ./ (1::Int)) } {- oneAndTwo :: LLSD -> (Int, Int) oneAndTwo v = (v `at` "foo" ./ 0, v `at` "foo" ./ 1) -} runTests = runTestText (putTextToHandle stderr False) (TestList [ test_identity, test_conversions, test_xmlFormats, test_xmlRoundtrip, test_binaryFormats, test_binaryRoundtrip ]) runChecks = mapM_ quickCheck $ concat [ props_identity, props_has, props_xmlRoundtrip, props_binaryRoundtrip ]