[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit 999978108387e13949480ae511519a58af8b7429
Author: John Goerzen <jgoerzen at complete.org>
Date:   Fri Nov 19 02:37:22 2004 +0100

    Basic parser is working
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.5--patch-81)

diff --git a/ChangeLog b/ChangeLog
index dfeedfc..fd677e9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,19 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.5
 #
 
+2004-11-18 19:37:22 GMT	John Goerzen <jgoerzen at complete.org>	patch-81
+
+    Summary:
+      Basic parser is working
+    Revision:
+      missingh--head--0.5--patch-81
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/ConfigParser/Lexer.hs
+     testsrc/ConfigParser/Parsertest.hs testsrc/Testutil.hs
+
+
 2004-11-18 19:13:50 GMT	John Goerzen <jgoerzen at complete.org>	patch-80
 
     Summary:
diff --git a/libsrc/MissingH/ConfigParser/Lexer.hs b/libsrc/MissingH/ConfigParser/Lexer.hs
index 05d00ef..7096d03 100644
--- a/libsrc/MissingH/ConfigParser/Lexer.hs
+++ b/libsrc/MissingH/ConfigParser/Lexer.hs
@@ -88,9 +88,9 @@ loken =
     <|> try (do {empty_line; loken})
     
     -- Real stuff
-    <|> do {sname <- sectheader; next <- loken; return $ NEWSECTION sname : next}
-    <|> do {pair <- optionpair; next <- loken; return $ NEWOPTION pair : next}
-    <|> do {extension <- extension_line; next <- loken; return $ EXTENSIONLINE extension : next}
+    <|> (do {sname <- sectheader; next <- loken; return $ NEWSECTION sname : next})
+    <|> try (do {pair <- optionpair; next <- loken; return $ NEWOPTION pair : next})
+    <|> (do {extension <- extension_line; next <- loken; return $ EXTENSIONLINE extension : next})
     <|> do {eof; return [EOFTOK]}
     <?> "Invalid syntax in configuration file"
         
diff --git a/testsrc/ConfigParser/Parsertest.hs b/testsrc/ConfigParser/Parsertest.hs
index 2f9f999..5de1690 100644
--- a/testsrc/ConfigParser/Parsertest.hs
+++ b/testsrc/ConfigParser/Parsertest.hs
@@ -23,31 +23,41 @@ import Testutil
 import Control.Exception
 
 test_basic =
-    let f inp exp = exp @=? parse_string inp in
+    let f msg inp exp = assertEqual msg exp (parse_string inp) in
         do
-        f "" []
-        f "\n" []
-        f "#foo bar" []
-        f "#foo bar\n" []
-        f "[emptysect]" [("emptysect", [])]
-        f "#foo bar\n[emptysect]\n" [("emptysect", [])]
-        f "# [nonexistant]\n[emptysect]\n" [("emptysect", [])]
-        f "#fo\n[Cemptysect]\n#asdf boo\n  \n  # fnonexistantg"
+        f "empty string" "" []
+        f "one empty line" "\n" []
+        f "one comment line" "#foo bar" []
+        f "one comment line with eol" "#foo bar\n" []
+        f "one empty section" "[emptysect]" [("emptysect", [])]
+        f "comment and empty sect" "#foo bar\n[emptysect]\n" [("emptysect", [])]
+        f "comments2" "# [nonexistant]\n[emptysect]\n" [("emptysect", [])]
+        f "comments3" "#fo\n[Cemptysect]\n#asdf boo\n  \n  # fnonexistantg"
           [("Cemptysect", [])]
-        f "[emptysect]\n# [nonexistant]\n" [("emptysect", [])]
-        f "[sect1]\nfoo: bar\n" [("sect1", [("foo", "bar")])]
-        f "\n#foo\n[sect1]\n\n#iiii \no1: v1\no2:  v2\n o3: v3"
+        f "comments4" "[emptysect]\n# [nonexistant]\n" [("emptysect", [])]
+        f "simple section" "[sect1]\nfoo: bar\n" [("sect1", [("foo", "bar")])]
+        f "comments5" "\n#foo\n[sect1]\n\n#iiii \no1: v1\no2:  v2\n o3: v3"
           [("sect1", [("o1", "v1"), ("o2", "v2"), ("o3", "v3")])]
 
-        assertRaises (ErrorCall "Lexer: \"(string)\" (line 1, column 5):\nunexpected \"\\n\"\nexpecting Option separator")
-                      (f "#foo\nthis is bad data" [])
+        f "default1" "v1: o1\n[sect1]\nv2: o2" [("DEFAULT", [("v1", "o1")]),
+                                     ("sect1", [("v2", "o2")])]
+        f "simple default" "foo: bar" [("DEFAULT", [("foo", "bar")])]
+{-
+        assertRaises "e test1" (ErrorCall "Lexer: \"(string)\" (line 1, column 5):\nunexpected \"\\n\"\nexpecting Option separator")
+                      (f "" "#foo\nthis is bad data" [])
 
-        assertRaises (ErrorCall "Lexer: \"(string)\" (line 2, column 9):\nunexpected \"\\n\"\nexpecting Option separator")
-                     (f "[sect1]\n#iiiiii \n  extensionline\n#foo" [])
+        assertRaises "e test2" (ErrorCall "Lexer: \"(string)\" (line 2, column 9):\nunexpected \"\\n\"\nexpecting Option separator")
+                     (f "" "[sect1]\n#iiiiii \n  extensionline\n#foo" [])
+-}
 
-        f "v1: o1\n[sect1]\nv2: o2" [("DEFAULT", [("v1", "o1")]),
-                                     ("sect1", [("v2", "o2")])]
-        f "foo: bar" [("DEFAULT", [("foo", "bar")])]
+test_extensionlines =
+    let f inp exp = exp @=? parse_string inp in
+        do
+        f "[sect1]\nfoo: bar\nbaz: l1\n l2\n   l3\n# c\nquux: asdf"
+          [("sect1", [("foo", "bar"),
+                      ("baz", "l1\nl2\nl3"),
+                      ("quux", "asdf")])]
 
-tests = TestList [TestLabel "test_basic" (TestCase test_basic)
+tests = TestList [TestLabel "test_basic" (TestCase test_basic),
+                  TestLabel "test_extensionlines" (TestCase test_extensionlines)
                  ]
\ No newline at end of file
diff --git a/testsrc/Testutil.hs b/testsrc/Testutil.hs
index 136643d..5683c24 100644
--- a/testsrc/Testutil.hs
+++ b/testsrc/Testutil.hs
@@ -20,16 +20,16 @@ module Testutil(assertRaises, mapassertEqual) where
 import HUnit
 import qualified Control.Exception
 
-assertRaises :: Show a => Control.Exception.Exception -> IO a -> IO ()
-assertRaises selector action =
+assertRaises :: Show a => String -> Control.Exception.Exception -> IO a -> IO ()
+assertRaises msg selector action =
     let thetest e = if e == selector then return ()
-                    else assertFailure $ "Received unexpected exception: "
+                    else assertFailure $ msg ++ "\nReceived unexpected exception: "
                              ++ (show e) ++ "\ninstead of exception: " ++ (show selector)
         in do
            r <- Control.Exception.try action
            case r of
                   Left e -> thetest e
-                  Right x -> assertFailure $ "Received no exception, but was expecting exception: " ++ (show selector)
+                  Right x -> assertFailure $ msg ++ "\nReceived no exception, but was expecting exception: " ++ (show selector)
 
 mapassertEqual :: (Show b, Eq b) => String -> (a -> b) -> [(a, b)] -> Assertion
 mapassertEqual descrip func [] = return ()

-- 
haskell-testpack