X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FInjuries.hs;h=2ea82c7ffe624b949d2697ced07d0f3d4e3f4edd;hb=a1edb885c755aac52e805255382dda50f6664b60;hp=53e24196c238c9c3ac2b8668287647fbe4e7b0ff;hpb=79cba02a6f520256991b345e9dffdaedf68ddde0;p=dead%2Fhtsn-import.git 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