[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 8c81a3128124e4abf37d0ab1b1c2cfc474dc34d1
Author: John Goerzen <jgoerzen at complete.org>
Date:   Thu Dec 2 02:20:35 2004 +0100

    Checkpointing
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.5--patch-140)

diff --git a/ChangeLog b/ChangeLog
index 35cef87..d902bb0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,20 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.5
 #
 
+2004-12-01 19:20:35 GMT	John Goerzen <jgoerzen at complete.org>	patch-140
+
+    Summary:
+      Checkpointing
+    Revision:
+      missingh--head--0.5--patch-140
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/ConfigParser.hs
+     libsrc/MissingH/ConfigParser/Parser.hs
+     testsrc/ConfigParser/Maintest.hs
+
+
 2004-12-01 17:07:22 GMT	John Goerzen <jgoerzen at complete.org>	patch-139
 
     Summary:
diff --git a/libsrc/MissingH/ConfigParser.hs b/libsrc/MissingH/ConfigParser.hs
index 5571d62..0e100a5 100644
--- a/libsrc/MissingH/ConfigParser.hs
+++ b/libsrc/MissingH/ConfigParser.hs
@@ -113,7 +113,7 @@ import Control.Monad.Error
 
 -- For interpolatingAccess
 import Text.ParserCombinators.Parsec.Error(ParseError, messageString,
-    errorMessages)
+    errorMessages, Message(..))
 import Text.ParserCombinators.Parsec(parse)
 
 ----------------------------------------------------------------------
@@ -167,11 +167,14 @@ interpolatingAccess maxdepth cp s o =
                      "interpolatingAccess")
            else do
                 x <- simpleAccess cp s o
-                case parse (interpmain lookupfunc) "(string)" x of
-                     Left x -> throwError $ 
-                               (InterpolationError ("unresolvable interpolation reference to \"" ++ error2str x ++ "\""),
-                                "interpolatingAccess")
-                     Right x -> return x
+                case parse (interpmain lookupfunc) (s ++ "/" ++ o) x of
+                     Left y -> case (head (errorMessages y)) of
+                                   Message z -> throwError $ 
+                                         (InterpolationError z,
+                                          "interpolatingAccess")
+                                   _ -> throwError $ (InterpolationError (show y),
+                                             "interpolatingAccess")
+                     Right y -> return y
 
 -- internal function: default handler
 defdefaulthandler :: ConfigParser -> SectionSpec -> OptionSpec -> CPResult String
diff --git a/libsrc/MissingH/ConfigParser/Parser.hs b/libsrc/MissingH/ConfigParser/Parser.hs
index dd2c1ff..ba9b88d 100644
--- a/libsrc/MissingH/ConfigParser/Parser.hs
+++ b/libsrc/MissingH/ConfigParser/Parser.hs
@@ -153,8 +153,9 @@ interptok lookupfunc = (try percentval)
                        <|> interpother
                        <|> do s <- interpval
                               case lookupfunc s of
-                                              Left _ -> fail s
-                                              Right x -> return x
+                                 Left (InterpolationError x, _) -> fail x
+                                 Left _ -> fail $ "unresolvable interpolation reference to \"" ++ s ++ "\""
+                                 Right x -> return x
 
 
 interpmain :: (String -> CPResult String) -> Parser String
diff --git a/testsrc/ConfigParser/Maintest.hs b/testsrc/ConfigParser/Maintest.hs
index 8ff7e38..21b64f9 100644
--- a/testsrc/ConfigParser/Maintest.hs
+++ b/testsrc/ConfigParser/Maintest.hs
@@ -141,7 +141,11 @@ test_interp =
                     "dir = /usr/src/%(filename)s\n" ++
                     "percent = 5%%\n" ++
                     "bad = /usr/src/%(nonexistent)s\n" ++
-                    "recursive = foo%(recursive)s\n"
+                    "recursive = foo%(recursive)s\n" ++
+                    "syn1 = foo%()s\n" ++
+                    "syn2 = foo%(asdf)\n" ++
+                    "syn3 = foo%s\n" ++
+                    "syn4 = %\n"
         cp = (forceEither $ (readstring emptyCP interpdoc)){ accessfunc = interpolatingAccess 5}
         in
         [
@@ -150,8 +154,16 @@ test_interp =
         ,f2 "dir" (Right "/usr/src/test_i386.c") (get cp "builder" "dir")
         ,f2 "percents" (Right "5%") (get cp "builder" "percent")
         ,f2 "error" (Left (InterpolationError "unresolvable interpolation reference to \"nonexistent\"", "interpolatingAccess")) (get cp "builder" "bad")
-        ,f2 "recursive" (Left (InterpolationError "unresolvable interpolation reference to \"recursive\"", "interpolatingAccess"))
+        ,f2 "recursive" (Left (InterpolationError "maximum interpolation depth exceeded", "interpolatingAccess"))
                         (get cp "builder" "recursive")
+        ,f2 "syn1" (Left (InterpolationError "\"builder/syn1\" (line 1, column 6):\nunexpected \")\"\nexpecting interpolation name","interpolatingAccess"))
+                   (get cp "builder" "syn1")
+        ,f2 "syn2" (Left (InterpolationError "\"builder/syn2\" (line 1, column 10):\nunexpected end of input\nexpecting \")s\"","interpolatingAccess"))
+                   (get cp "builder" "syn2")
+        ,f2 "syn3" (Left (InterpolationError "\"builder/syn3\" (line 1, column 4):\nunexpected \"s\"\nexpecting \"%(\"","interpolatingAccess"))
+                   (get cp "builder" "syn3")
+        ,f2 "syn4" (Left (InterpolationError "\"builder/syn4\" (line 1, column 1):\nunexpected end of input\nexpecting \"%(\"","interpolatingAccess"))
+                   (get cp "builder" "syn4")
         ]
 
 

-- 
haskell-testpack