From: Michael Orlitzky Date: Thu, 2 Jan 2014 05:12:06 +0000 (-0500) Subject: Add separate 'unpickleable' tests to the existing XML modules. X-Git-Tag: 0.0.1~123 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=a163a47ab0aed0072f7868d4b2b28aa4c326e5e1;p=dead%2Fhtsn-import.git Add separate 'unpickleable' tests to the existing XML modules. --- diff --git a/src/TSN/XML/Heartbeat.hs b/src/TSN/XML/Heartbeat.hs index 6cc4931..bcf9069 100644 --- a/src/TSN/XML/Heartbeat.hs +++ b/src/TSN/XML/Heartbeat.hs @@ -20,7 +20,7 @@ import Text.XML.HXT.Core ( xpWrap ) import TSN.DbImport ( ImportResult(..) ) -import Xml ( pickle_unpickle ) +import Xml ( pickle_unpickle, unpickleable ) data Message = Message { @@ -61,12 +61,24 @@ heartbeat_tests :: TestTree heartbeat_tests = testGroup "Heartbeat tests" - [ test_pickle_of_unpickle_is_identity ] + [ test_pickle_of_unpickle_is_identity, + test_unpickle_succeeds ] +-- | Warning, succeess of this test does not mean that unpickling +-- succeeded. test_pickle_of_unpickle_is_identity :: TestTree test_pickle_of_unpickle_is_identity = testCase "pickle composed with unpickle is the identity" $ do let path = "test/xml/Heartbeat.xml" (expected :: [Message], actual) <- pickle_unpickle "message" path actual @?= expected + + +test_unpickle_succeeds :: TestTree +test_unpickle_succeeds = + testCase "unpickling succeeds" $ do + let path = "test/xml/Heartbeat.xml" + actual <- unpickleable path pickle_message + let expected = True + actual @?= expected diff --git a/src/TSN/XML/Injuries.hs b/src/TSN/XML/Injuries.hs index 53e2419..2ea82c7 100644 --- a/src/TSN/XML/Injuries.hs +++ b/src/TSN/XML/Injuries.hs @@ -41,7 +41,7 @@ import Text.XML.HXT.Core ( import TSN.DbImport ( DbImport(..), import_generic ) -import Xml ( pickle_unpickle ) +import Xml ( pickle_unpickle, unpickleable ) data Listing = @@ -117,12 +117,24 @@ injuries_tests :: TestTree injuries_tests = testGroup "Injuries tests" - [ test_pickle_of_unpickle_is_identity ] + [ test_pickle_of_unpickle_is_identity, + test_unpickle_succeeds ] +-- | Warning, succeess of this test does not mean that unpickling +-- succeeded. test_pickle_of_unpickle_is_identity :: TestTree test_pickle_of_unpickle_is_identity = testCase "pickle composed with unpickle is the identity" $ do let path = "test/xml/injuriesxml.xml" (expected :: [Message], actual) <- pickle_unpickle "message" path actual @?= expected + + +test_unpickle_succeeds :: TestTree +test_unpickle_succeeds = + testCase "unpickling succeeds" $ do + let path = "test/xml/injuriesxml.xml" + actual <- unpickleable path pickle_message + let expected = True + actual @?= expected diff --git a/src/TSN/XML/InjuriesDetail.hs b/src/TSN/XML/InjuriesDetail.hs index 81b915d..bb529d0 100644 --- a/src/TSN/XML/InjuriesDetail.hs +++ b/src/TSN/XML/InjuriesDetail.hs @@ -49,7 +49,7 @@ import Text.XML.HXT.Core ( import TSN.DbImport ( DbImport(..), import_generic ) import TSN.Picklers( xp_date, xp_team_id ) -import Xml ( pickle_unpickle ) +import Xml ( pickle_unpickle, unpickleable ) data PlayerListing = @@ -167,12 +167,24 @@ injuries_detail_tests :: TestTree injuries_detail_tests = testGroup "InjuriesDetail tests" - [ test_pickle_of_unpickle_is_identity ] + [ test_pickle_of_unpickle_is_identity, + test_unpickle_succeeds ] +-- | Warning, succeess of this test does not mean that unpickling +-- succeeded. test_pickle_of_unpickle_is_identity :: TestTree test_pickle_of_unpickle_is_identity = testCase "pickle composed with unpickle is the identity" $ do let path = "test/xml/Injuries_Detail_XML.xml" (expected :: [Message], actual) <- pickle_unpickle "message" path actual @?= expected + + +test_unpickle_succeeds :: TestTree +test_unpickle_succeeds = + testCase "unpickling succeeds" $ do + let path = "test/xml/Injuries_Detail_XML.xml" + actual <- unpickleable path pickle_message + let expected = True + actual @?= expected diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs index 31587a3..ad106d3 100644 --- a/src/TSN/XML/News.hs +++ b/src/TSN/XML/News.hs @@ -51,7 +51,7 @@ import TSN.Codegen ( tsn_codegen_config, tsn_db_field_namer ) -- Used in a test import TSN.DbImport ( DbImport(..), ImportResult(..) ) -import Xml ( ToFromXml(..), pickle_unpickle ) +import Xml ( ToFromXml(..), pickle_unpickle, unpickleable ) @@ -333,15 +333,8 @@ news_tests = testGroup "News tests" [ test_news_fields_have_correct_names, - test_pickle_of_unpickle_is_identity ] - - -test_pickle_of_unpickle_is_identity :: TestTree -test_pickle_of_unpickle_is_identity = - testCase "pickle composed with unpickle is the identity" $ do - let path = "test/xml/newsxml.xml" - (expected :: [MessageXml], actual) <- pickle_unpickle "message" path - actual @?= expected + test_pickle_of_unpickle_is_identity, + test_unpickle_succeeds ] test_news_fields_have_correct_names :: TestTree @@ -363,3 +356,22 @@ test_news_fields_have_correct_names = actual = ["mid", "sport", "url", "sms", "text", "continue"] check (x,y) = (x @?= y) + + +-- | Warning, succeess of this test does not mean that unpickling +-- succeeded. +test_pickle_of_unpickle_is_identity :: TestTree +test_pickle_of_unpickle_is_identity = + testCase "pickle composed with unpickle is the identity" $ do + let path = "test/xml/newsxml.xml" + (expected :: [MessageXml], actual) <- pickle_unpickle "message" path + actual @?= expected + + +test_unpickle_succeeds :: TestTree +test_unpickle_succeeds = + testCase "unpickling succeeds" $ do + let path = "test/xml/newsxml.xml" + actual <- unpickleable path pickle_message + let expected = True + actual @?= expected