[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:48:37 UTC 2010
The following commit has been merged in the master branch:
commit d1f1bf373d793d651a9fc36e6363b2e669c8ef99
Author: John Goerzen <jgoerzen at complete.org>
Date: Tue Nov 30 22:37:24 2004 +0100
Checkpointing work on tests
Keywords:
(jgoerzen at complete.org--projects/missingh--head--0.5--patch-121)
diff --git a/ChangeLog b/ChangeLog
index 91405c0..b50090f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,23 @@
# arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.5
#
+2004-11-30 15:37:24 GMT John Goerzen <jgoerzen at complete.org> patch-121
+
+ Summary:
+ Checkpointing work on tests
+ Revision:
+ missingh--head--0.5--patch-121
+
+
+ new files:
+ testsrc/Eithertest.hs
+
+ modified files:
+ ChangeLog libsrc/MissingH/ConfigParser/Parser.hs
+ libsrc/MissingH/Either.hs testsrc/ConfigParser/Maintest.hs
+ testsrc/ConfigParser/Parsertest.hs testsrc/Tests.hs
+
+
2004-11-30 15:08:41 GMT John Goerzen <jgoerzen at complete.org> patch-120
Summary:
diff --git a/libsrc/MissingH/ConfigParser/Parser.hs b/libsrc/MissingH/ConfigParser/Parser.hs
index 3760654..63396d3 100644
--- a/libsrc/MissingH/ConfigParser/Parser.hs
+++ b/libsrc/MissingH/ConfigParser/Parser.hs
@@ -70,7 +70,7 @@ parse_handle h =
-- Private funcs
----------------------------------------------------------------------
detokenize fp l =
- let conv msg (Left err) = throwError $ (ParseError (msg ++ (show err)), msg)
+ let conv msg (Left err) = throwError $ (ParseError (show err), msg)
conv msg (Right val) = return val
in do r <- conv "lexer" l
conv "parser" $ runParser main () fp r
diff --git a/libsrc/MissingH/Either.hs b/libsrc/MissingH/Either.hs
index b25b608..ba37f04 100644
--- a/libsrc/MissingH/Either.hs
+++ b/libsrc/MissingH/Either.hs
@@ -32,7 +32,8 @@ Copyright (c) 2004 John Goerzen, jgoerzen\@complete.org
-}
module MissingH.Either
(
- maybeToEither
+ maybeToEither,
+ forceEither
) where
import Control.Monad.Error
@@ -52,3 +53,9 @@ maybeToEither :: MonadError e m =>
-> m a
maybeToEither errorval Nothing = throwError errorval
maybeToEither _ (Just normalval) = return normalval
+
+{- | Pulls a "Right" value out of an Either value. If the Either value is
+Left, raises an exception with "error". -}
+forceEither :: Show e => Either e a -> a
+forceEither (Left x) = error (show x)
+forceEither (Right x) = x
diff --git a/testsrc/ConfigParser/Maintest.hs b/testsrc/ConfigParser/Maintest.hs
index 632ddda..b59dded 100644
--- a/testsrc/ConfigParser/Maintest.hs
+++ b/testsrc/ConfigParser/Maintest.hs
@@ -19,52 +19,54 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
module ConfigParser.Maintest(tests) where
import HUnit
import MissingH.ConfigParser
+import MissingH.Either
import Testutil
import Control.Exception
-p inp = readstring empty inp
-f msg inp exp conv = TestLabel msg $ TestCase $ assertEqual "" exp (conv (p inp))
+p inp = forceEither $ readstring empty inp
+f msg inp exp conv = TestLabel msg $ TestCase $ assertEqual "" (Right exp) (conv (p inp))
f2 msg exp res = TestLabel msg $ TestCase $ assertEqual "" exp res
+f3 msg inp exp conv = TestLabel msg $ TestCase $ assertEqual "" exp (conv (p inp))
test_basic =
[
- f "empty doc, no sections" "" [] sections,
- f "one empty line" "\n" [] sections,
- f "comment line only" "#foo bar" [] sections,
- f "comment line with \\n" "#foo bar\n" [] sections,
- f "one empty sect" "[emptysect]" ["emptysect"] sections,
- f "one empty sect w comment" "#foo bar\n[emptysect]\n" ["emptysect"]
- sections,
- f "assure comments not processed"
- "# [nonexistant]\n[emptysect]\n" ["emptysect"] sections,
- f "1 empty s w/comments"
- "#fo\n[Cemptysect]\n#asdf boo\n \n # fnonexistantg"
- ["Cemptysect"] sections,
- f "1 empty s, comments, EOL"
- "[emptysect]\n# [nonexistant]\n" ["emptysect"] sections,
+ f3 "empty doc, no sections" "" [] sections,
+ f3 "one empty line" "\n" [] sections,
+ f3 "comment line only" "#foo bar" [] sections,
+ f3 "comment line with \\n" "#foo bar\n" [] sections,
+ f3 "one empty sect" "[emptysect]" ["emptysect"] sections,
+ f3 "one empty sect w comment" "#foo bar\n[emptysect]\n" ["emptysect"]
+ sections,
+ f3 "assure comments not processed"
+ "# [nonexistant]\n[emptysect]\n" ["emptysect"] sections,
+ f3 "1 empty s w/comments"
+ "#fo\n[Cemptysect]\n#asdf boo\n \n # fnonexistantg"
+ ["Cemptysect"] sections,
+ f3 "1 empty s, comments, EOL"
+ "[emptysect]\n# [nonexistant]\n" ["emptysect"] sections,
TestLabel "1 sec w/option" $ TestCase $
do let cp = p "[sect1]\nfoo: bar\n"
["sect1"] @=? sections cp
- "bar" @=? get cp "sect1" "foo"
+ (Right "bar") @=? get cp "sect1" "foo"
, f "comments in option text"
"[s1]\no1: v1#v2\n"
"v1#v2" (\cp -> get cp "s1" "o1")
, TestLabel "mult options" $ TestCase $
do let cp = p "\n#foo\n[sect1]\n\n#iiii \no1: v1\no2: v2\no3: v3"
- ["o1", "o2", "o3"] @=? options cp "sect1"
+ Right ["o1", "o2", "o3"] @=? options cp "sect1"
["sect1"] @=? sections cp
- "v2" @=? get cp "sect1" "o2"
+ Right "v2" @=? get cp "sect1" "o2"
, TestLabel "sectionless option" $ TestCase $
do let cp = p "v1: o1\n[sect1]\nv2: o2"
- "o1" @=? get cp "sect1" "v1"
- "o2" @=? get cp "sect1" "v2"
- "o1" @=? get cp "DEFAULT" "v1"
+ Right "o1" @=? get cp "sect1" "v1"
+ Right "o2" @=? get cp "sect1" "v2"
+ Right "o1" @=? get cp "DEFAULT" "v1"
]
test_defaults =
let cp = p "def: ault\n[sect1]\nfoo: bar\nbaz: quuz\nint: 2\nfloat: 3\nbool: yes" in
[
- f2 "default item" "ault" (get cp "sect1" "def")
+ f2 "default item" (Right "ault") (get cp "sect1" "def")
]
diff --git a/testsrc/ConfigParser/Parsertest.hs b/testsrc/ConfigParser/Parsertest.hs
index 37ffc1c..beaaec3 100644
--- a/testsrc/ConfigParser/Parsertest.hs
+++ b/testsrc/ConfigParser/Parsertest.hs
@@ -19,11 +19,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
module ConfigParser.Parsertest(tests) where
import HUnit
import MissingH.ConfigParser.Parser
+import MissingH.ConfigParser.Types
import Testutil
import Control.Exception
test_basic =
- let f msg inp exp = TestLabel msg $ TestCase $ assertEqual "" exp (parse_string inp) in
+ let f msg inp exp = TestLabel msg $ TestCase $ assertEqual "" (Right exp) (parse_string inp) in
[
f "empty string" "" []
@@ -56,16 +57,26 @@ test_basic =
]
test_asserts =
- do
+ let f msg inp exp = TestLabel msg $ TestCase $ exp @=? parse_string inp in
+ [
+ f "e test1" "#foo\nthis is bad data"
+ (Left (ParseError "\"(string)\" (line 1, column 5):\nunexpected \"\\n\"\nexpecting Option separator", "Lexer"))
+ ,f "e test2" "[sect1]\n#iiiiii \n extensionline\n#foo"
+ (Left (ParseError "\"(string)\" (line 2, column 9):\nunexpected \"\\n\"\nexpecting Option separator", "Lexer"))
+ ]
+
+{-
+
assertRaises "e test1" (ErrorCall "Lexer: \"(string)\" (line 1, column 5):\nunexpected \"\\n\"\nexpecting Option separator")
([] @=? parse_string "#foo\nthis is bad data")
assertRaises "e test2" (ErrorCall "Lexer: \"(string)\" (line 2, column 9):\nunexpected \"\\n\"\nexpecting Option separator")
([] @=? parse_string "[sect1]\n#iiiiii \n extensionline\n#foo")
+-}
test_extensionlines =
- let f inp exp = exp @=? parse_string inp in
+ let f inp exp = (Right exp) @=? parse_string inp in
do
f "[sect1]\nfoo: bar\nbaz: l1\n l2\n l3\n# c\nquux: asdf"
[("sect1", [("foo", "bar"),
@@ -73,6 +84,6 @@ test_extensionlines =
("quux", "asdf")])]
tests = TestList [TestLabel "test_basic" (TestList test_basic),
- TestLabel "test_asserts" (TestCase test_asserts),
+ TestLabel "test_asserts" (TestList test_asserts),
TestLabel "test_extensionlines" (TestCase test_extensionlines)
]
\ No newline at end of file
diff --git a/testsrc/Eithertest.hs b/testsrc/Eithertest.hs
new file mode 100644
index 0000000..c1c8793
--- /dev/null
+++ b/testsrc/Eithertest.hs
@@ -0,0 +1,48 @@
+{- arch-tag: MissingH.Either tests
+Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program 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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+module Eithertest(tests) where
+import HUnit
+import MissingH.Either
+import Testutil
+import Control.Exception
+
+test_maybeToEither =
+ let f msg inp exp = TestLabel msg $ TestCase $ assertEqual "" exp inp in
+ [
+ f "Nothing" (maybeToEither "error" (Nothing::Maybe String))
+ (Left "error"),
+ f "Nothing diff types" (maybeToEither "error" (Nothing::Maybe Int))
+ (Left "error"),
+ f "Just" (maybeToEither "error" (Just "good")) (Right "good"),
+ f "Diff types" (maybeToEither "error" (Just (5::Int)))
+ (Right (5::Int))
+ ]
+
+test_forceEither =
+ let f msg inp exp = TestLabel msg $ TestCase $ assertEqual "" exp inp in
+ [
+ f "Right" (forceEither ((Right "foo")::Either Int String)) "foo",
+ TestLabel "Left" $ TestCase $ assertRaises "" (ErrorCall "\"wrong\"")
+ ("" @=? forceEither (Left "wrong"))
+ ]
+
+tests = TestList [TestLabel "test_maybeToEither" (TestList test_maybeToEither),
+ TestLabel "test_forceEither" (TestList test_forceEither)
+ ]
+
diff --git a/testsrc/Tests.hs b/testsrc/Tests.hs
index c856e11..22bbd91 100644
--- a/testsrc/Tests.hs
+++ b/testsrc/Tests.hs
@@ -27,6 +27,7 @@ import qualified IOtest
import qualified Bitstest
import qualified Printftest
import qualified Network.FTP.Parsertest
+import qualified Eithertest
import qualified ConfigParser.Parsertest
import qualified ConfigParser.Maintest
@@ -41,6 +42,7 @@ tests = TestList [TestLabel "test1" test1,
TestLabel "Bitstest" Bitstest.tests,
TestLabel "Network.FTP.Parser" Network.FTP.Parsertest.tests,
TestLabel "Printftest" Printftest.tests,
+ TestLabel "Eithertest" Eithertest.tests,
TestLabel "ConfigParser.RunParser" ConfigParser.Parsertest.tests,
TestLabel "ConfigParser.Main" ConfigParser.Maintest.tests]
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list