-------------------------------------------------------------------------------- -- $Id: TestXml.hs,v 1.1 2004/03/10 16:05:14 graham Exp $ -- -- Copyright (c) 2004, G. KLYNE. All rights reserved. -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : TestXml -- Copyright : (c) 2004, Graham Klyne -- License : LGPL V2 -- -- Maintainer : Graham Klyne -- Stability : provisional -- Portability : H98 -- -- This module contains test cases for XML parsing and XML handling libraries. -- -- The test cases make reference to externally stored test data files. -- -- The module is designed to be retargetable to alternative XML libraries -- with reasonable effort: the main body of test cases is isolated from the -- details of the XML library used. -- -------------------------------------------------------------------------------- module Main where import Text.XML.HaXml.Parse ( xmlParseDiag ) import Text.XML.HaXml.Pretty ( document ) import HUnit ( Test(TestCase,TestList,TestLabel) , Assertable(..) , Assertion , assertBool, assertEqual, assertString, assertFailure , runTestTT, runTestText, putTextToHandle ) import IO ( Handle, IOMode(WriteMode) , openFile, hClose, hPutStr, hPutStrLn ) import List ( (\\) ) ------------------------------------------------------------ -- XML handling interfaces ------------------------------------------------------------ -- -- Subsequent tests are based on these interfaces. -- Re-implement these interfaces to use the XML package -- under test. -- doXmlParseOK :: String -> String -> Bool doXmlParseOK filepath filedata = either (const False) (const True) (xmlParseDiag filepath filedata) doXmlParseFormat :: String -> String -> String doXmlParseFormat filepath filedata = either ("Error: "++) (show . document) (xmlParseDiag filepath filedata) ------------------------------------------------------------ -- Test case helpers ------------------------------------------------------------ testEq :: (Eq a, Show a) => String -> a -> a -> Test testEq lab a1 a2 = TestCase ( assertEqual ("testEq:"++lab) a1 a2 ) ------------------------------------------------------------ -- XML test case functions ------------------------------------------------------------ testXmlParseOK :: String -> Bool -> String -> Test testXmlParseOK lab ok filepath = TestCase $ do { -- putStrLn ("\nTest "++lab) ; s <- catch (readFile filepath) (error ("Failed reading file "++filepath)) ; assertEqual lab ok (doXmlParseOK filepath s) } makeTestXmlParseOK :: String -> Bool -> String -> [String] -> Test makeTestXmlParseOK lab ok fileroot suffixes = TestList [ testXmlParseOK (lab++s) ok (fileroot++s++".xml") | s <- suffixes ] testXmlFormat :: String -> String -> String -> Test testXmlFormat lab filepathI filepathF = TestCase $ do { si <- readFile filepathI -- ; writeFile (filepathF++".tmp") (doXmlParseFormat filepathI si) ; sf <- readFile filepathF ; assertEqual lab sf (doXmlParseFormat filepathI si) } ------------------------------------------------------------ -- Basic XML parsing tests ------------------------------------------------------------ testXmlParse01 = testXmlParseOK "TestXmlParse01" True "xmlData01I.xml" testXmlParse02 = testXmlParseOK "TestXmlParse02" True "xmlData02I.xml" testXmlParse03 = testXmlParseOK "TestXmlParse03" False "xmlData03I.xml" testXmlParse04 = testXmlParseOK "TestXmlParse04" False "xmlData04I.xml" testXmlParse05 = testXmlParseOK "TestXmlParse05" True "KAoSOntologiesI.owl" testXmlFormat01 = testXmlFormat "TestXmlFormat01" "xmlData01I.xml" "xmlData01F.xml" testXmlFormat02 = testXmlFormat "TestXmlFormat02" "xmlData02I.xml" "xmlData02F.xml" testXmlFormat03 = testXmlFormat "TestXmlFormat03" "xmlData03I.xml" "xmlData03F.xml" testXmlFormat04 = testXmlFormat "TestXmlFormat04" "xmlData03I.xml" "xmlData04F.xml" testXmlFormat05 = testXmlFormat "TestXmlFormat05" "KAoSOntologiesI.owl" "KAoSOntologiesF.owl" testXmlParseSuite = TestList [ testXmlParse01 , testXmlParse02 , testXmlParse03 , testXmlParse04 , testXmlParse05 , testXmlFormat01 , testXmlFormat02 , testXmlFormat03 , testXmlFormat04 , testXmlFormat05 ] -- The following tests are designed to work with files from the -- W3C XML test suite, which can be obtained from: -- http://www.w3.org/XML/Test/ -- Retrieve the test suite archive and unpack the directory strunbture -- into a directory from which the test program is run (I use the source -- code directory: the archive has all its content in subdirectories). -- -- The tests are generated by from the 3-digit number that is used to form -- the test suite filename in each case, with tests known not to work being -- removed from the list. I expect these omissions to be removed as the -- parser is refined. -- -- Note: at this time, the "Valid" XML test suite is used only for testing -- well-formedness chacks by the parser. Additional tests may perform validity -- checking. -- -- Also, note that some external entity reference tests assume that the -- current directory is that containing the referencing document. jamesClarkValidSASuite = makeTestXmlParseOK "JamesClarkValidSA" True "xmlconf/xmltest/valid/sa/" ( map (showNDigits 3) [1..119] \\ ["012","013","049","050","051","063","097"] ) jamesClarkNotWfSASuite = makeTestXmlParseOK "jamesClarkNotWfSA" False "xmlconf/xmltest/not-wf/sa/" ( map (showNDigits 3) [1..186] \\ ["006","008","009" ,"014" ,"020","021","022","023","024","025","026","029" ,"030","031","032","033","034","038" ,"061","062","064","065","066","067","068","069" ,"070","071","072","073","074","075","076","077","078","079" ,"080","081","082","083","084","085","086","087" ,"090","092","093","094","095","096","097","098","099" ,"100","101","102","103" ,"113","114","115","116","117","118","119" ,"120","128" ,"133","134","137" ,"140","141","142","143","144","145","146","147","148","149" ,"150","151","152","153","154","155","156","157","159" ,"160","161","162","164","165","166","167","168","169" ,"170","171","172","173","174","175","177" ,"180","181","182","185","186" ] ) showNDigits :: Int -> Int -> String showNDigits places val = pad places (show val) where pad places str = replicate (places-length str) '0' ++ str ------------------------------------------------------------ -- All tests ------------------------------------------------------------ allTests = TestList [ testXmlParseSuite , jamesClarkValidSASuite , jamesClarkNotWfSASuite ] main = runTestTT allTests runTestFile t = do h <- openFile "a.tmp" WriteMode runTestText (putTextToHandle h False) t hClose h tf = runTestFile tt = runTestTT -------------------------------------------------------------------------------- -- -- Copyright (c) 2004, G. KLYNE. All rights reserved. -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 of the License, or (at your option) any later version. -- -- This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details. -- -- You should have received a copy of the GNU Lesser General Public -- License along with this library; if not, write to: -- The Free Software Foundation, Inc., -- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- or view the web page at: -- http://www.gnu.org/copyleft/lesser.html -- -------------------------------------------------------------------------------- -- $Source: /file/cvsdev/HaskellUtils/TestXml.hs,v $ -- $Author: graham $ -- $Revision: 1.1 $ -- $Log: TestXml.hs,v $