From: John Goerzen Date: Tue, 12 Aug 2008 05:36:00 +0000 (-0500) Subject: Added quoted test X-Git-Url: https://code.delx.au/offlineimap/commitdiff_plain/9ccd884d0ee9699ac76f8f6b671c675ec83be207 Added quoted test --- diff --git a/testsrc/TestParserPrim.hs b/testsrc/TestParserPrim.hs index 1bda21f..86046b4 100644 --- a/testsrc/TestParserPrim.hs +++ b/testsrc/TestParserPrim.hs @@ -15,8 +15,7 @@ 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 TestParser where -import qualified Data.Map as Map +module TestParserPrim where import Data.List import qualified Test.HUnit as HU import Test.HUnit.Utils @@ -24,50 +23,24 @@ import Data.Word import Test.QuickCheck import TestInfrastructure -import Network.IMAP.Parser -import Network.IMAP.Connection +import Network.IMAP.Parser.Prim import Network.IMAP.Types import TestInfrastructure -import TestConnection(expectedString, noCR) - -prop_getFullLine_basic :: [String] -> Property -prop_getFullLine_basic s = - (null s || not ("}" `isSuffixOf` (head s))) && noCR s ==> - runLinesConnection s (getFullLine []) @?= - if null s - then Left "EOF in input in readLine" - else Right (head s, (expectedString (tail s), [])) - -prop_getFullLine_count :: [String] -> Property -prop_getFullLine_count s = - length s >= 2 && noCR s && (length s < 3 || not ("}" `isSuffixOf` (s !! 2))) - ==> - runLinesConnection lenS (getFullLine []) @?= - Right (expectedResult, (expectedRemain, [])) - where lenS = [braceString] ++ [(head . tail $ s)] ++ drop 2 s - braceString = head s ++ "{" ++ show (length (s !! 1)) ++ "}" - expectedResult = braceString ++ "\r\n" ++ (s !! 1) - expectedRemain = expectedString (drop 2 s) - -prop_rfr_basic :: [String] -> Property -prop_rfr_basic s = - let testlist = - case length s of - 0 -> [] - 1 -> ["TAG " ++ head s] - _ -> map ("* " ++) (init s) ++ - ["TAG " ++ last s] - resultstr = expectedString testlist - in noCR s && noBrace s ==> - runLinesConnection testlist readFullResponse @?= - if null s - then Left "EOF in input in readLine" - else Right (resultstr, ([], [])) - -noBrace s = and (map (not . isSuffixOf "}") s) - -allt = [q "getFullLine_basic" prop_getFullLine_basic, - q "getFullLine_count" prop_getFullLine_count, - q "readFullResponse_basic" prop_rfr_basic +import Text.ParserCombinators.Parsec + +p parser input = + case parse parser "(none)" input of + Left e -> Left (show e) + Right y -> Right y + +prop_quoted :: String -> Result +prop_quoted s = + p quoted quotedString @?= Right s + where quotedString = '"' : concatMap quoteChar s ++ "\"" + quoteChar '\\' = "\\\\" + quoteChar '"' = "\\\"" + quoteChar x = [x] + +allt = [q "quoted" prop_quoted ] diff --git a/testsrc/runtests.hs b/testsrc/runtests.hs index 41726ee..c0f27bb 100644 --- a/testsrc/runtests.hs +++ b/testsrc/runtests.hs @@ -30,6 +30,7 @@ import TestInfrastructure import qualified TestSyncable import qualified TestConnection import qualified TestParser +import qualified TestParserPrim q :: Testable a => String -> a -> HU.Test q = qccheck (defaultConfig {configMaxTest = 250}) @@ -38,7 +39,9 @@ tl msg t = HU.TestLabel msg $ HU.TestList t allt = [tl "TestSyncable" TestSyncable.allt, tl "TestConnection" TestConnection.allt, - tl "TestParser" TestParser.allt] + tl "TestParserPrim" TestParserPrim.allt, + tl "TestParser" TestParser.allt + ] testh = HU.runTestTT $ HU.TestList allt testv = runVerbTestText (HU.putTextToHandle stderr True) $ HU.TestList allt