diff --git a/cbits/hslibxml-shim.c b/cbits/hslibxml-shim.c --- a/cbits/hslibxml-shim.c +++ b/cbits/hslibxml-shim.c @@ -1,8 +1,9 @@ #define _GNU_SOURCE #include "hslibxml-shim.h" -#include #include +#include +#include /* for hslibxml_parse_complete */ #include diff --git a/libxml-sax.cabal b/libxml-sax.cabal --- a/libxml-sax.cabal +++ b/libxml-sax.cabal @@ -1,15 +1,15 @@ name: libxml-sax -version: 0.7.5 +version: 0.7.6 license: MIT license-file: license.txt author: John Millikin maintainer: jmillikin@gmail.com build-type: Simple -cabal-version: >= 1.6 +cabal-version: >= 1.10 category: Foreign, Text, XML, Parsing stability: experimental -homepage: https://john-millikin.com/software/haskell-libxml/ -bug-reports: mailto:jmillikin@gmail.com +homepage: https://git.singpolyma.net/haskell-libxml-sax +bug-reports: mailto:dev@singpolyma.net synopsis: Bindings for the libXML2 SAX interface description: @@ -20,14 +20,10 @@ source-repository head type: git - location: https://john-millikin.com/code/haskell-libxml-sax/ - -source-repository this - type: git - location: https://john-millikin.com/code/haskell-libxml-sax/ - tag: haskell-libxml-sax_0.7.5 + location: https://git.singpolyma.net/haskell-libxml-sax library + default-language: Haskell2010 hs-source-dirs: lib ghc-options: -Wall -O2 cc-options: -Wall @@ -45,3 +41,18 @@ extra-libraries: xml2 pkgconfig-depends: libxml-2.0 + +test-suite test + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: tests/Tests.hs + + build-depends: + base > 4.1 && < 5.0 + , bytestring + , containers + , libxml-sax + , text + , transformers + , xml-types + , chell >= 0.5 && < 0.6 diff --git a/tests/Tests.hs b/tests/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Tests.hs @@ -0,0 +1,289 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +-- Copyright (C) 2011 John Millikin +-- +-- See license.txt for details +module Main (tests, main) where + +import Control.Monad (forM_) +import Control.Monad.IO.Class (liftIO) + +import qualified Data.ByteString.Char8 as B8 +import Data.IORef (newIORef, readIORef, writeIORef, modifyIORef) +import qualified Data.Text as T + +import Test.Chell + +import qualified Text.XML.LibXML.SAX as SAX +import qualified Data.XML.Types as X + +tests :: Suite +tests = suite "libxml-sax" [ + test_Instruction, + test_Comment, + test_InternalSubset, + test_InternalSubsetEmpty, + test_ExternalSubset, + test_Element, + test_Content, + test_ContentNoReference, + test_PlainCDATA, + test_PassthroughCDATA, + test_AttributeContent, + test_AttributeContentNoReference, + test_AttributeOrder, + test_AttributeContentAmpersand + ] + +main :: IO () +main = defaultMain [tests] + +test_Instruction :: Test +test_Instruction = test_Chunks "instruction" + (\p add -> do + let set cb st = SAX.setCallback p cb st + set SAX.parsedInstruction (\pi_ -> add (X.EventInstruction pi_)) + ) + [ ("", + [ X.EventInstruction (X.Instruction "something" "foo bar") + ]) + , ("", []) + ] + +test_Comment :: Test +test_Comment = test_Chunks "comment" + (\p add -> do + let set cb st = SAX.setCallback p cb st + set SAX.parsedComment (\txt -> add (X.EventComment txt)) + ) + [ ("", + [ X.EventComment " something foo bar " + ]) + , ("", []) + ] + +test_InternalSubsetEmpty :: Test +test_InternalSubsetEmpty = test_Chunks "internal subset (empty)" + (\p add -> do + let set cb st = SAX.setCallback p cb st + set SAX.parsedComment (\txt -> add (X.EventComment txt)) + set SAX.parsedInternalSubset (\name id_ -> add (X.EventBeginDoctype name id_)) + ) + [ ("", + [ X.EventBeginDoctype "SOME_DOCTYPE" (Just (X.PublicID "foo" "bar")) + ]) + , ("", []) + ] + +test_InternalSubset :: Test +test_InternalSubset = test_Chunks "internal subset" + (\p add -> do + let set cb st = SAX.setCallback p cb st + set SAX.parsedComment (\txt -> add (X.EventComment txt)) + set SAX.parsedInternalSubset (\name id_ -> add (X.EventBeginDoctype name id_)) + ) + [ ("", + [ X.EventBeginDoctype "SOME_DOCTYPE" (Just (X.PublicID "foo" "bar")) + ]) + , ("]", []) + , (">", []) + , ("", []) + ] + +test_ExternalSubset :: Test +test_ExternalSubset = test_Chunks "external subset" + (\p add -> do + let set cb st = SAX.setCallback p cb st + set SAX.parsedComment (\txt -> add (X.EventComment txt)) + set SAX.parsedExternalSubset (\name id_ -> add (X.EventBeginDoctype name id_)) + ) + [ ("", + [ + ]) + , ("]", []) + , (">", + [ X.EventBeginDoctype "SOME_DOCTYPE" (Just (X.PublicID "foo" "bar")) + ]) + , ("", []) + ] + +test_Element :: Test +test_Element = test_Chunks "element begin/end" + (\p add -> do + let set cb st = SAX.setCallback p cb st + set SAX.parsedBeginElement (\n as -> add (X.EventBeginElement n as)) + set SAX.parsedEndElement (\n -> add (X.EventEndElement n)) + ) + [ ("", + [ X.EventBeginElement "doc" [] + ]) + , ("", + [ X.EventEndElement "doc" + ]) + ] + +test_Content :: Test +test_Content = test_Chunks "content" + (\p add -> do + let set cb st = SAX.setCallback p cb st + set SAX.parsedBeginElement (\n as -> add (X.EventBeginElement n as)) + set SAX.parsedEndElement (\n -> add (X.EventEndElement n)) + set SAX.parsedCharacters (\txt -> add (X.EventContent (X.ContentText txt))) + set SAX.parsedReference (\name -> add (X.EventContent (X.ContentEntity name))) + ) + [ ("]>", + [ + ]) + , ("", + [ X.EventBeginElement "doc" [] + ]) + , (" text &ref; <", + [ X.EventContent (X.ContentText " text ") + , X.EventContent (X.ContentEntity "ref") + , X.EventContent (X.ContentText " ") + ]) + , ("/doc>", + [ X.EventEndElement "doc" + ]) + ] + +test_ContentNoReference :: Test +test_ContentNoReference = test_Chunks "content (no reference CB)" + (\p add -> do + let set cb st = SAX.setCallback p cb st + set SAX.parsedCharacters (\txt -> add (X.EventContent (X.ContentText txt))) + ) + [ ("]>", + [ + ]) + , ("", []) + , (" text &ref; <", + [ X.EventContent (X.ContentText " text ") + , X.EventContent (X.ContentText "some reference") + , X.EventContent (X.ContentText " ") + ]) + , ("/doc>", + [ + ]) + ] + +test_PlainCDATA :: Test +test_PlainCDATA = test_Chunks "cdata (plain)" + (\p add -> do + let set cb st = SAX.setCallback p cb st + set SAX.parsedCharacters (\txt -> add (X.EventContent (X.ContentText txt))) + ) + [ ("", []) + , ("]]>", + [ X.EventContent (X.ContentText "") + ]) + , ("", []) + ] + +test_PassthroughCDATA :: Test +test_PassthroughCDATA = test_Chunks "cdata (passthrough)" + (\p add -> do + let set cb st = SAX.setCallback p cb st + set SAX.parsedCharacters (\txt -> add (X.EventContent (X.ContentText txt))) + set SAX.parsedCDATA (\txt -> add (X.EventCDATA txt)) + ) + [ ("", []) + , ("]]>", + [ X.EventCDATA "" + ]) + , ("", []) + ] + +test_AttributeContent :: Test +test_AttributeContent = test_Chunks "attribute content" + (\p add -> do + let set cb st = SAX.setCallback p cb st + set SAX.parsedBeginElement (\n as -> add (X.EventBeginElement n as)) + set SAX.parsedEndElement (\n -> add (X.EventEndElement n)) + set SAX.parsedReference (\name -> add (X.EventContent (X.ContentEntity name))) + ) + [ ("]>", + [ + ]) + , ("", + [ X.EventBeginElement "doc" [("a", [ X.ContentText "text ", X.ContentText "&", X.ContentText " " + , X.ContentEntity "ref", X.ContentText " text"])] + , X.EventEndElement "doc" + ]) + ] + +test_AttributeContentNoReference :: Test +test_AttributeContentNoReference = test_Chunks "attribute content (no reference CB)" + (\p add -> do + let set cb st = SAX.setCallback p cb st + set SAX.parsedBeginElement (\n as -> add (X.EventBeginElement n as)) + set SAX.parsedEndElement (\n -> add (X.EventEndElement n)) + ) + [ ("]>", + [ + ]) + , ("", + [ X.EventBeginElement "doc" [("a", [X.ContentText "text some reference text"])] + , X.EventEndElement "doc" + ]) + ] + +test_AttributeContentAmpersand :: Test +test_AttributeContentAmpersand = test_Chunks "attribute content (with ampersand)" + (\p add -> do + let set cb st = SAX.setCallback p cb st + set SAX.parsedBeginElement (\n as -> add (X.EventBeginElement n as)) + set SAX.parsedEndElement (\n -> add (X.EventEndElement n)) + ) + [ ("", + [ X.EventBeginElement "doc" [("a", [X.ContentText "&foo"])] + , X.EventEndElement "doc" + ]) + ] + +test_AttributeOrder :: Test +test_AttributeOrder = test_Chunks "attribute order" + (\p add -> do + let set cb st = SAX.setCallback p cb st + set SAX.parsedBeginElement (\n as -> add (X.EventBeginElement n as)) + set SAX.parsedEndElement (\n -> add (X.EventEndElement n)) + set SAX.parsedCharacters (\txt -> add (X.EventContent (X.ContentText txt))) + set SAX.parsedReference (\name -> add (X.EventContent (X.ContentEntity name))) + set SAX.parsedCDATA (\txt -> add (X.EventCDATA txt)) + ) + [ ("", + [ X.EventBeginElement "doc" [("z", [X.ContentText "1"]), ("a", [X.ContentText "2"]), ("b", [X.ContentText "3"])] + , X.EventEndElement "doc" + ]) + ] + +test_Chunks :: String -> (SAX.Parser IO -> (X.Event -> IO Bool) -> IO ()) -> [(String, [X.Event])] -> Test +test_Chunks name setup chunks = assertions name $ do + ref <- liftIO (newIORef []) + p <- liftIO (SAX.newParserIO Nothing) + + liftIO (SAX.setCallback p SAX.reportError (error . T.unpack)) + + let add ev = modifyIORef ref (ev:) >> return True + liftIO (setup p add) + + forM_ chunks $ \(chunk, expected) -> do + liftIO (SAX.parseBytes p (B8.pack chunk)) + result <- liftIO (fmap reverse (readIORef ref)) + liftIO (writeIORef ref []) + $assert (equal expected result) + + liftIO (SAX.parseComplete p) + result <- liftIO (fmap reverse (readIORef ref)) + $assert (equal [] result)