From: Ulya Trofimovich <skvadrik@gmail.com>
Date: Thu, 3 Aug 2017 11:14:19 +0000 (+0100)
Subject: Fuzzers: a bunch of small tweaks.
X-Git-Tag: 1.0~15
X-Git-Url: https://granicus.if.org/sourcecode?a=commitdiff_plain;h=f20d1a052087eed929431908e3dee119e65c6e94;p=re2c

Fuzzers: a bunch of small tweaks.
---

diff --git a/re2c/fuzz/regex_tdfa/check.hs b/re2c/fuzz/regex_tdfa/check.hs
index 97480c9b..cde049e6 100644
--- a/re2c/fuzz/regex_tdfa/check.hs
+++ b/re2c/fuzz/regex_tdfa/check.hs
@@ -6,6 +6,7 @@ import qualified System.Exit as SE
 import qualified Data.ByteString.Char8 as BS
 import           Data.Char (ord)
 import qualified Text.Regex.TDFA as X
+import qualified Data.Array as A
 import           Control.Monad (when)
 
 
@@ -102,27 +103,36 @@ arbitrary_d d = do
         where d' = pred d
 
 
-parse_input :: Int -> IO [(BS.ByteString, [Int], [BS.ByteString])]
+parse_input :: Int -> IO [(BS.ByteString, [Int], [BS.ByteString], X.MatchArray)]
 parse_input ncaps = do
-    let step :: BS.ByteString -> BS.ByteString -> (BS.ByteString, [Int], [BS.ByteString], BS.ByteString)
+    let step :: BS.ByteString -> BS.ByteString -> (BS.ByteString, [Int], [BS.ByteString], X.MatchArray, BS.ByteString)
         step input key =
             let ns'@(n1:n2:_:ns) = reverse $ BS.foldl' (\xs c -> ord c : xs) [] key
                 s = BS.take n2 input
                 ss = split ns s
+                ar = A.listArray (0, ncaps) (split2 ns s)
                 rest = BS.drop n1 input
-            in (s, ns', ss, rest)
+            in (s, ns', ss, ar, rest)
 
-        go :: [BS.ByteString] -> BS.ByteString -> [(BS.ByteString, [Int], [BS.ByteString])]
+        go :: [BS.ByteString] -> BS.ByteString -> [(BS.ByteString, [Int], [BS.ByteString], X.MatchArray)]
         go [] _ = []
         go (key:keys) input =
-            let (s, ns, ss, rest) = step input key
-            in (s, ns, ss) : go keys rest
+            let (s, ns, ss, ar, rest) = step input key
+            in (s, ns, ss, ar) : go keys rest
 
         split :: [Int] -> BS.ByteString -> [BS.ByteString]
         split [] _ = []
         split (n1:n2:ns) s = (BS.drop n1 . BS.take n2) s : split ns s
         split _ _ = error "uneven number of keys"
 
+        split2 :: [Int] -> BS.ByteString -> [(Int, Int)]
+        split2 [] _ = []
+        split2 (n1:n2:ns) s = case (n1, n2) of
+            (255, 255)                 -> (-1, 0) : split2 ns s
+            _ | n1 /= 255 && n2 /= 255 -> (n1, n2 - n1) : split2 ns s
+            _                          -> error $ "bad re2c result: " ++ show (n1, n2)
+        split2 _ _ = error "uneven number of keys"
+
         split_at :: Int -> BS.ByteString -> [BS.ByteString]
         split_at _ s | s == BS.empty = []
         split_at n s | BS.length s < n = error "bad tail"
@@ -152,10 +162,11 @@ prop_test_re2c r1 = QM.monadicIO $ do
     QM.assert $ ok0 `elem` [SE.ExitSuccess, SE.ExitFailure 42]
     when (ok0 == SE.ExitSuccess) $ do
         ss <- QM.run $ parse_input ncaps
-        mapM_ (\(s, ns, xs) -> do
+        mapM_ (\(s, ns, xs, ar) -> do
                 let s1 = map BS.unpack xs
                     s2 = ((\x -> if x == [] then [] else head x) . X.match rr . BS.unpack) s
-                    ok = s1 == s2 || (BS.filter (== '\n') s) /= BS.empty
+                    ar' = (X.match rr . BS.unpack) s :: X.MatchArray
+                    ok = (ar == ar' && s1 == s2) || (BS.filter (== '\n') s) /= BS.empty
                 QM.run $ when (not ok) $ do
                     print re_posix
                     print ncaps
@@ -163,6 +174,8 @@ prop_test_re2c r1 = QM.monadicIO $ do
                     print ns
                     print s1
                     print s2
+                    print ar
+                    print ar'
                 QM.assert ok
             ) ss
 
diff --git a/re2c/fuzz/tdfa0_tdfa1/check.hs b/re2c/fuzz/tdfa0_tdfa1/check.hs
index 778dc055..a03cae4c 100644
--- a/re2c/fuzz/tdfa0_tdfa1/check.hs
+++ b/re2c/fuzz/tdfa0_tdfa1/check.hs
@@ -48,9 +48,7 @@ instance Q.Arbitrary E where
 
 arbitrary_d :: (Enum a, Eq a, Num a) => a -> Q.Gen E
 arbitrary_d 0 = do
-    t1 <- Q.choose (97, 122) :: Q.Gen Int
-    t2 <- Q.choose (97, 122) :: Q.Gen Int
-    t3 <- Q.choose (97, 122) :: Q.Gen Int
+    tag <- take 5 <$> Q.infiniteListOf (Q.choose (97, 122) :: Q.Gen Int)
     Q.frequency
         [ (1, pure Empty)
         , (1, pure A)
@@ -59,8 +57,8 @@ arbitrary_d 0 = do
         , (1, pure NA)
         , (1, pure NB)
         , (1, pure NC)
-        , (3, pure $ Tag $ map chr [t1, t2, t3])
-        , (3, pure $ HTag $ map chr [t1, t2, t3])
+        , (3, pure $ Tag $ map chr tag)
+        , (3, pure $ HTag $ map chr tag)
         ]
 arbitrary_d d = do
     n <- Q.choose (0, 1) :: Q.Gen Int
diff --git a/re2c/fuzz/tdfa0_tdfa1_posix/check.hs b/re2c/fuzz/tdfa0_tdfa1_posix/check.hs
index 56bcd3f9..77212bab 100644
--- a/re2c/fuzz/tdfa0_tdfa1_posix/check.hs
+++ b/re2c/fuzz/tdfa0_tdfa1_posix/check.hs
@@ -85,7 +85,7 @@ prop_test_re2c r1 r2 = QM.monadicIO $ do
         re2c = "../re2c"
 
     s0 <- QM.run $ do BS.writeFile "a.re" $ BS.pack re_file
-                      SP.system $ "ulimit -t 10 && " ++ re2c ++ " --no-lookahead --posix-captures -Werror-undefined-control-flow -ST a.re -o a.c 2>>re2c_last_warning || exit 42 && cp a.c b.c"
+                      SP.system $ "ulimit -t 20 && " ++ re2c ++ " --no-lookahead --posix-captures -Werror-undefined-control-flow -ST a.re -o a.c 2>>re2c_last_warning || exit 42 && cp a.c b.c"
 
     s1 <- QM.run $ do BS.writeFile "a.re" $ BS.pack re_file
                       SP.system $ "ulimit -t 10 && " ++ re2c ++ "                --posix-captures -Werror-undefined-control-flow -ST a.re -o a.c 2>>re2c_last_warning || exit 42 && gcc a.c -o a && ./a && gcc b.c -o b && ./b"