[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 16c96adb7d39e5cb3ee5cbecd7ee450364cc277a
Author: John Goerzen <jgoerzen at complete.org>
Date:   Thu Dec 2 00:04:04 2004 +0100

    Basic interpolation working
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.5--patch-138)

diff --git a/ChangeLog b/ChangeLog
index 666ee99..de62a03 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 17:04:04 GMT	John Goerzen <jgoerzen at complete.org>	patch-138
+
+    Summary:
+      Basic interpolation working
+    Revision:
+      missingh--head--0.5--patch-138
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/ConfigParser.hs
+     libsrc/MissingH/ConfigParser/Parser.hs
+     testsrc/ConfigParser/Maintest.hs
+
+
 2004-12-01 16:43:10 GMT	John Goerzen <jgoerzen at complete.org>	patch-137
 
     Summary:
diff --git a/libsrc/MissingH/ConfigParser.hs b/libsrc/MissingH/ConfigParser.hs
index 7594b62..93798e4 100644
--- a/libsrc/MissingH/ConfigParser.hs
+++ b/libsrc/MissingH/ConfigParser.hs
@@ -167,7 +167,7 @@ interpolatingAccess maxdepth cp s o =
                      "interpolatingAccess")
            else do
                 x <- simpleAccess cp s o
-                case parse (interpmain lookupfunc) "(string)" s of
+                case parse (interpmain lookupfunc) "(string)" x of
                      Left x -> throwError $ 
                                (InterpolationError ("Unresolvable interpolation reference to \"" ++ error2str x ++ "\""),
                                 "interpolatingAccess")
diff --git a/libsrc/MissingH/ConfigParser/Parser.hs b/libsrc/MissingH/ConfigParser/Parser.hs
index 92cb752..dd2c1ff 100644
--- a/libsrc/MissingH/ConfigParser/Parser.hs
+++ b/libsrc/MissingH/ConfigParser/Parser.hs
@@ -131,14 +131,12 @@ valmerge vallist =
 -- Interpolation
 ----------------------------------------------------------------------
 
-interpval :: (String -> CPResult String) -> Parser String
-interpval lookupfunc = do
+interpval :: Parser String
+interpval  = do
             string "%("
             s <- (many1 $ noneOf ")") <?> "interpolation name"
             string ")s"               <?> "end of interpolation name"
-            return $ case lookupfunc s of
-                       Left x -> fail s
-                       Right x -> x
+            return s
 
 percentval :: Parser String
 percentval = do
@@ -147,16 +145,19 @@ percentval = do
 
 interpother :: Parser String
 interpother = do
-              c <- anyChar
+              c <- noneOf "%"
               return [c]
 
 interptok :: (String -> CPResult String) -> Parser String
-interptok lookupfunc = (try percentval) <|>
-                       (try (interpval lookupfunc))
+interptok lookupfunc = (try percentval)
                        <|> interpother
+                       <|> do s <- interpval
+                              case lookupfunc s of
+                                              Left _ -> fail s
+                                              Right x -> return x
+
 
 interpmain :: (String -> CPResult String) -> Parser String
 interpmain lookupfunc =
-    do r <- many $ interptok lookupfunc
-       eof
+    do r <- manyTill (interptok lookupfunc) eof
        return $ concat r
diff --git a/testsrc/ConfigParser/Maintest.hs b/testsrc/ConfigParser/Maintest.hs
index 655da4a..91bfc55 100644
--- a/testsrc/ConfigParser/Maintest.hs
+++ b/testsrc/ConfigParser/Maintest.hs
@@ -134,10 +134,27 @@ test_ex_errormonad =
                         options cp "sect1"
        )
     ]
-     
+
+test_interp = 
+    let interpdoc = "[DEFAULT]\narch = i386\n\n[builder]\n" ++
+                    "filename = test_%(arch)s.c\n" ++
+                    "dir = /usr/src/%(filename)s\n" ++
+                    "percent = 5%%\n" ++
+                    "bad = /usr/src/%(nonexistent)s"
+        cp = (forceEither $ (readstring emptyCP interpdoc)){ accessfunc = interpolatingAccess 5}
+        in
+        [
+         f2 "basic" (Right "i386") (get cp "DEFAULT" "arch")
+        ,f2 "filename" (Right "test_i386.c") (get cp "builder" "filename")
+        ,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")
+        ]
+
 
 tests = TestList [TestLabel "test_basic" (TestList test_basic),
                  TestLabel "test_defaults" (TestList test_defaults),
                  TestLabel "test_nodefault" (TestList test_nodefault),
                  TestLabel "test_ex_nomonad" (TestCase test_ex_nomonad),
-                 TestLabel "test_ex_errormonad" (TestList test_ex_errormonad)]
+                 TestLabel "test_ex_errormonad" (TestList test_ex_errormonad),
+                 TestLabel "test_interp" (TestList test_interp)]

-- 
haskell-testpack