[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 37a1d479545e8a4feae6b3b0cd8fe4e72ee3a721
Author: John Goerzen <jgoerzen at complete.org>
Date:   Sat Oct 23 00:10:09 2004 +0100

    More FTP parser tests
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--1.0--patch-98)

diff --git a/ChangeLog b/ChangeLog
index ff75fdc..9adf26b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,19 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--1.0
 #
 
+2004-10-22 18:10:09 GMT	John Goerzen <jgoerzen at complete.org>	patch-98
+
+    Summary:
+      More FTP parser tests
+    Revision:
+      missingh--head--1.0--patch-98
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/Network/FTP/Parser.hs
+     testsrc/Network/FTP/Parsertest.hs testsrc/Testutil.hs
+
+
 2004-10-22 15:44:41 GMT	John Goerzen <jgoerzen at complete.org>	patch-97
 
     Summary:
diff --git a/libsrc/MissingH/Network/FTP/Parser.hs b/libsrc/MissingH/Network/FTP/Parser.hs
index ed9dae2..2bf9f93 100644
--- a/libsrc/MissingH/Network/FTP/Parser.hs
+++ b/libsrc/MissingH/Network/FTP/Parser.hs
@@ -69,7 +69,11 @@ specificCode exp = do
                    return (read s)
 
 line :: Parser String
-line = many (noneOf "\r\n")
+line = do
+       x <- many (noneOf "\r\n")
+       crlf
+       -- return $ unsafePerformIO $ putStrLn ("line: " ++ x)
+       return x
 
 ----------------------------------------------------------------------
 -- The parsers
@@ -80,7 +84,6 @@ singleReplyLine = do
                   x <- code
                   sp
                   text <- line
-                  crlf
                   return (x, text)
 
 expectedReplyLine :: Int -> Parser (Int, String)
@@ -88,7 +91,6 @@ expectedReplyLine expectedcode = do
                                  x <- specificCode expectedcode
                                  sp
                                  text <- line
-                                 crlf
                                  return (x, text)
 
 startOfMultiReply :: Parser (Int, String)
@@ -96,17 +98,20 @@ startOfMultiReply = do
                     x <- code
                     char '-'
                     text <- line
-                    crlf
                     return (x, text)
 
 multiReplyComponent :: Parser [String]
-multiReplyComponent = try (do
-                           notMatching codeString "found unexpected code"
-                           thisLine <- line
-                           remainder <- multiReplyComponent
-                           return (thisLine : remainder)
-                          )
-                      <|> return []
+multiReplyComponent = (try (do
+                            notMatching (do 
+                                         codeString
+                                         sp
+                                        ) "found unexpected code"
+                            thisLine <- line
+                            -- return $ unsafePerformIO (putStrLn ("MRC: got " ++ thisLine))
+                            remainder <- multiReplyComponent
+                            return (thisLine : remainder)
+                           )
+                      ) <|> return []
 
 multiReply :: Parser (Int, [String])
 multiReply = try (do
diff --git a/testsrc/Network/FTP/Parsertest.hs b/testsrc/Network/FTP/Parsertest.hs
index 8b0fecd..f485ec8 100644
--- a/testsrc/Network/FTP/Parsertest.hs
+++ b/testsrc/Network/FTP/Parsertest.hs
@@ -19,11 +19,16 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 module Network.FTP.Parsertest(tests) where
 import HUnit
 import MissingH.Network.FTP.Parser
+import Testutil
 
 test_parseReply =
     let f inp exp = exp @=? parseReply inp in
         do
         f "200 Welcome to this server.\r\n" (200, ["Welcome to this server."])
+        f "230-Foo\r\n230 Foo2\r\n" (230, ["Foo", "Foo2"])
+        f "240-Foo\r\n240-Foo2\r\n240 Foo3\r\n" (240, ["Foo", "240-Foo2", "Foo3"])
+        f "230-Test\r\nLine2\r\n 230 Line3\r\n230 Done\r\n"
+          (230, ["Test", "Line2", " 230 Line3", "Done"])
 
 tests = TestList [TestLabel "parseReply" (TestCase test_parseReply)
 
diff --git a/testsrc/Testutil.hs b/testsrc/Testutil.hs
index 5eceef9..bea55fb 100644
--- a/testsrc/Testutil.hs
+++ b/testsrc/Testutil.hs
@@ -16,13 +16,19 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 -}
 
-module Testutil(mapassertEqual) where
+module Testutil(assertRaises) where
 import HUnit
+import qualified Control.Exception
 
-mapassertEqual :: (Show b, Eq b) => String -> (a -> b) -> [(a, b)] -> Assertion
-mapassertEqual descrip func [] = return ()
-mapassertEqual descrip func ((inp,result):xs) = 
-    do
-    assertEqual descrip result (func inp)
-    mapassertEqual descrip func xs
-
+assertRaises :: Show a => Exception -> IO a -> IO ()
+assertRaises selector action =
+    let test e =  if e == selector
+                  then Just e
+                  else Nothing
+        in
+        result <- tryJust test action
+        case result of
+             Left e -> return ()
+             Right x -> assertFailure ("Received " ++ (show x) ++
+                                       " instead of expected exception "
+                                       ++ (show selector))

-- 
haskell-testpack