[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36
John Goerzen
jgoerzen at complete.org
Fri Apr 23 14:45:17 UTC 2010
The following commit has been merged in the master branch:
commit 68e4ebf9c7f204eec7d8b1ab81241bd5346164fc
Author: John Goerzen <jgoerzen at complete.org>
Date: Fri Oct 22 21:44:41 2004 +0100
Added initial tests for FTP parser
Keywords:
(jgoerzen at complete.org--projects/missingh--head--1.0--patch-97)
diff --git a/ChangeLog b/ChangeLog
index a57253e..ff75fdc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,30 @@
# arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--1.0
#
+2004-10-22 15:44:41 GMT John Goerzen <jgoerzen at complete.org> patch-97
+
+ Summary:
+ Added initial tests for FTP parser
+ Revision:
+ missingh--head--1.0--patch-97
+
+
+ new files:
+ testsrc/Network/.arch-ids/=id
+ testsrc/Network/FTP/.arch-ids/=id
+ testsrc/Network/FTP/Parsertest.hs
+
+ modified files:
+ ChangeLog libsrc/MissingH/MIMETypes.hs
+ libsrc/MissingH/Network/FTP/Parser.hs
+ libsrc/MissingH/Parsec.hs libsrc/MissingH/Path.hs
+ testsrc/MIMETypestest.hs testsrc/Pathtest.hs testsrc/Tests.hs
+
+ new directories:
+ testsrc/Network testsrc/Network/.arch-ids testsrc/Network/FTP
+ testsrc/Network/FTP/.arch-ids
+
+
2004-10-22 15:23:19 GMT John Goerzen <jgoerzen at complete.org> patch-96
Summary:
diff --git a/libsrc/MissingH/MIMETypes.hs b/libsrc/MissingH/MIMETypes.hs
index 4f57fe0..e38f4e6 100644
--- a/libsrc/MissingH/MIMETypes.hs
+++ b/libsrc/MissingH/MIMETypes.hs
@@ -136,14 +136,14 @@ guessType mtd strict fn =
let mapext (base, ext) =
case lookupFM (suffixMap mtd) ext of
Nothing -> (base, ext)
- Just x -> mapext (splitext (base ++ x))
+ Just x -> mapext (splitExt (base ++ x))
checkencodings (base, ext) =
case lookupFM (encodingsMap mtd) ext of
Nothing -> (base, ext, Nothing)
- Just x -> (fst (splitext base),
- snd (splitext base),
+ Just x -> (fst (splitExt base),
+ snd (splitExt base),
Just x)
- (base, ext, enc) = checkencodings . mapext $ splitext fn
+ (base, ext, enc) = checkencodings . mapext $ splitExt fn
typemap = getStrict mtd strict
in
case lookupFM typemap ext of
diff --git a/libsrc/MissingH/Network/FTP/Parser.hs b/libsrc/MissingH/Network/FTP/Parser.hs
index e1b2d5f..ed9dae2 100644
--- a/libsrc/MissingH/Network/FTP/Parser.hs
+++ b/libsrc/MissingH/Network/FTP/Parser.hs
@@ -34,12 +34,13 @@ Written by John Goerzen, jgoerzen\@complete.org
-}
-module MissingH.Network.FTP.Parser(
- )
+module MissingH.Network.FTP.Parser(parseReply, parseGoodReply)
where
import Text.ParserCombinators.Parsec
import MissingH.Parsec
+import MissingH.List
+-- import Control.Exception(Exception(PatternMatchFail), throw)
----------------------------------------------------------------------
-- Utilities
@@ -118,3 +119,22 @@ multiReply = try (do
end <- expectedReplyLine (fst start)
return (fst start, snd start : (component ++ [snd end]))
)
+-- | Parse a FTP reply. Returns a (result code, text) pair.
+
+parseReply :: String -> (Int, [String])
+parseReply input =
+ case parse multiReply "(unknown)" input of
+ Left err -> error (show err)
+ Right reply -> reply
+
+-- | Parse a FTP reply. Returns a (result code, text) pair.
+-- If the result code indicates an error, raise an exception instead
+-- of just passing it back.
+
+parseGoodReply :: String -> (Int, [String])
+parseGoodReply input =
+ let reply = parseReply input
+ in
+ if (fst reply) >= 400
+ then error ((show (fst reply)) ++ ": " ++ (join "\n" (snd reply)))
+ else reply
diff --git a/libsrc/MissingH/Parsec.hs b/libsrc/MissingH/Parsec.hs
index 0dac04b..8d64b55 100644
--- a/libsrc/MissingH/Parsec.hs
+++ b/libsrc/MissingH/Parsec.hs
@@ -30,8 +30,7 @@ Written by John Goerzen, jgoerzen\@complete.org
-}
-module MissingH.Parsec(-- * Utilities
- notMatching)
+module MissingH.Parsec(notMatching)
where
import Text.ParserCombinators.Parsec
diff --git a/libsrc/MissingH/Path.hs b/libsrc/MissingH/Path.hs
index 83e1c07..7e7e0aa 100644
--- a/libsrc/MissingH/Path.hs
+++ b/libsrc/MissingH/Path.hs
@@ -32,7 +32,7 @@ names.
Written by John Goerzen, jgoerzen\@complete.org
-}
-module MissingH.Path(splitext
+module MissingH.Path(splitExt
)
where
import Data.List
@@ -41,11 +41,11 @@ import MissingH.List
{- | Splits a pathname into a tuple representing the root of the name and
the extension. The extension is considered to be all characters from the last
dot after the last slash to the end. Either returned string may be empty. -}
-splitext :: String -> (String, String)
-splitext path =
+splitExt :: String -> (String, String)
+splitExt path =
let dotindex = alwaysElemRIndex '.' path
slashindex = alwaysElemRIndex '/' path
in
if dotindex <= slashindex
then (path, "")
- else ((take dotindex path), (drop dotindex path))
\ No newline at end of file
+ else ((take dotindex path), (drop dotindex path))
diff --git a/testsrc/MIMETypestest.hs b/testsrc/MIMETypestest.hs
index 5a91752..65d65ee 100644
--- a/testsrc/MIMETypestest.hs
+++ b/testsrc/MIMETypestest.hs
@@ -24,7 +24,6 @@ import MissingH.MIMETypes
test_readMIMETypes =
do
mtd <- readMIMETypes defaultmtd True "testsrc/mime.types.test"
- putStrLn "\nread\n"
let f = \strict inp exp -> exp @=? guessType mtd strict inp
let fe = \strict inp exp -> (sort exp) @=? sort (guessAllExtensions mtd strict inp)
f True "foo.bar.baz" (Nothing, Nothing)
@@ -67,4 +66,4 @@ test_guessType =
tests = TestList [TestLabel "guessType" (TestCase test_guessType),
TestLabel "guessAllExtensions" (TestCase test_guessAllExtensions),
TestLabel "readMIMETypes" (TestCase test_readMIMETypes)
- ]
\ No newline at end of file
+ ]
diff --git a/testsrc/IOtest.hs b/testsrc/Network/FTP/Parsertest.hs
similarity index 66%
copy from testsrc/IOtest.hs
copy to testsrc/Network/FTP/Parsertest.hs
index ef23d84..8b0fecd 100644
--- a/testsrc/IOtest.hs
+++ b/testsrc/Network/FTP/Parsertest.hs
@@ -1,4 +1,4 @@
-{- arch-tag: IO tests main file
+{- arch-tag: MissingH.Network.FTP.Parser tests main file
Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
This program is free software; you can redistribute it and/or modify
@@ -16,13 +16,15 @@ along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
-module IOtest(foo) where
+module Network.FTP.Parsertest(tests) where
import HUnit
-import MissingH.IO
-import Testutil
-
-foo = hInteract
-
+import MissingH.Network.FTP.Parser
+test_parseReply =
+ let f inp exp = exp @=? parseReply inp in
+ do
+ f "200 Welcome to this server.\r\n" (200, ["Welcome to this server."])
+tests = TestList [TestLabel "parseReply" (TestCase test_parseReply)
+ ]
\ No newline at end of file
diff --git a/testsrc/Pathtest.hs b/testsrc/Pathtest.hs
index 882b3b7..8c2c4a2 100644
--- a/testsrc/Pathtest.hs
+++ b/testsrc/Pathtest.hs
@@ -20,8 +20,8 @@ module Pathtest(tests) where
import HUnit
import MissingH.Path
-test_splitext =
- let f inp exp = exp @=? splitext inp in
+test_splitExt =
+ let f inp exp = exp @=? splitExt inp in
do
f "" ("", "")
f "/usr/local" ("/usr/local", "")
@@ -30,5 +30,5 @@ test_splitext =
f "foo.txt/bar" ("foo.txt/bar", "")
f "foo.txt/bar.bz" ("foo.txt/bar", ".bz")
-tests = TestList [TestLabel "splitext" (TestCase test_splitext)
+tests = TestList [TestLabel "splitExt" (TestCase test_splitExt)
]
\ No newline at end of file
diff --git a/testsrc/Tests.hs b/testsrc/Tests.hs
index 106b60f..4b281cc 100644
--- a/testsrc/Tests.hs
+++ b/testsrc/Tests.hs
@@ -24,6 +24,7 @@ import qualified FiniteMaptest
import qualified Pathtest
import qualified Strtest
import qualified IOtest
+import qualified Network.FTP.Parsertest
test1 = TestCase ("x" @=? "x")
@@ -32,6 +33,7 @@ tests = TestList [TestLabel "test1" test1,
TestLabel "Str" Strtest.tests,
TestLabel "FiniteMap" FiniteMaptest.tests,
TestLabel "Path" Pathtest.tests,
- TestLabel "MIMETypes" MIMETypestest.tests]
+ TestLabel "MIMETypes" MIMETypestest.tests,
+ TestLabel "Network.FTP.Parser" Network.FTP.Parsertest.tests]
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list