All of the regex exampes are self-testing and together make up the regex test suite run during development and over each release of the test suite. But here we have the unit an small-check tests used to systematically probe the library for weak points and guard against regressions.
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main (main) where
import Control.Exception
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.ByteString.Lazy.UTF8 as LBS
import qualified Data.ByteString.UTF8 as B
import Data.Char
import qualified Data.Foldable as F
import qualified Data.HashMap.Strict as HM
import Data.Maybe
import qualified Data.Monoid as M
import qualified Data.Sequence as S
import Data.String
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Typeable
import Language.Haskell.TH.Quote
import Prelude.Compat
import System.Directory
import System.FilePath
import qualified System.Info as SI
import Test.SmallCheck.Series
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.SmallCheck as SC
import TestKit
import Text.Heredoc
import qualified Text.RE.PCRE as PCRE
import qualified Text.RE.PCRE.ByteString as P_BS
import qualified Text.RE.PCRE.ByteString.Lazy as PLBS
import qualified Text.RE.PCRE.Sequence as P_SQ
import qualified Text.RE.PCRE.String as P_ST
import qualified Text.RE.PCRE.Text as P_TX
import qualified Text.RE.PCRE.Text.Lazy as PLTX
import Text.RE.REOptions
import Text.RE.Replace
import Text.RE.TDFA as TDFA
import qualified Text.RE.TDFA.ByteString as T_BS
import qualified Text.RE.TDFA.ByteString.Lazy as TLBS
import qualified Text.RE.TDFA.Sequence as T_SQ
import qualified Text.RE.TDFA.String as T_ST
import qualified Text.RE.TDFA.Text as T_TX
import qualified Text.RE.TDFA.Text.Lazy as TLTX
import Text.RE.TestBench
import Text.RE.Tools.Find
import Text.RE.Tools.Sed
import Text.RE.ZeInternals
import qualified Text.Regex.PCRE as PCRE_
import qualified Text.Regex.TDFA as TDFA_
main :: IO ()
= do
main print SI.os
$
defaultMain "Tests"
testGroup
[ prelude_tests
, compiling_tests
, core_tests
, replace_methods_tests
, search_replace_tests
, options_tests
, named_capture_tests
, many_tests
, escape_tests
, add_capture_names_tests
, find_tests
, backslash_tests
, misc_tests ]
-- | check that our self-testing macro environments are good
prelude_tests :: TestTree
= testGroup "Prelude"
prelude_tests
[ tc TDFA.regexType TDFA.preludeEnv
, tc PCRE.regexType PCRE.preludeEnv
]where
=
tc rty m_env show rty) $ do
testCase (<- doesDirectoryExist "docs"
is_docs $
when is_docs "docs" ".txt") (fp "docs" "-src.txt") rty m_env
dumpMacroTable (fp "data" ".txt") (fp "data" "-src.txt") rty m_env
dumpMacroTable (fp "testMacroEnv" =<< testMacroEnv "prelude" rty m_env
assertBool where
= dir </> (rty_s ++ "-macros" ++ sfx)
fp dir sfx
= map toLower $ presentRegexType rty rty_s
The core tests rely on these simple test vectors.
-- | our standard test strings
str' :: String
str_,= "a bbbb aa b"
str_ = "foo"
str'
-- | standard test REs
regex_alt :: RE
regex_,= [re|(a+) (b+)|]
regex_ = [re|(a+)|(b+)|]
regex_alt
-- | golden matches result 1
regex_str_matches :: Matches String
=
regex_str_matches Matches
= str_
{ matchesSource =
, allMatches
[ regex_str_match
, regex_str_match_2
]
}
-- | golden match result 1
regex_str_match :: Match String
=
regex_str_match Match
= str_
{ matchSource = noCaptureNames
, captureNames = array (0,2)
, matchArray 0,Capture {captureSource = str_, capturedText = "a bbbb", captureOffset = 0, captureLength = 6})
[ (1,Capture {captureSource = str_, capturedText = "a" , captureOffset = 0, captureLength = 1})
, (2,Capture {captureSource = str_, capturedText = "bbbb" , captureOffset = 2, captureLength = 4})
, (
]
}
-- | golden match result 2
regex_str_match_2 :: Match String
=
regex_str_match_2 Match
= str_
{ matchSource = noCaptureNames
, captureNames = array (0,2)
, matchArray 0,Capture {captureSource = str_, capturedText = "aa b", captureOffset = 7 , captureLength = 4})
[ (1,Capture {captureSource = str_, capturedText = "aa" , captureOffset = 7 , captureLength = 2})
, (2,Capture {captureSource = str_, capturedText = "b" , captureOffset = 10, captureLength = 1})
, (
]
}
-- | golden match result 2
regex_alt_str_matches :: Matches String
=
regex_alt_str_matches Matches
= str_
{ matchesSource =
, allMatches Match
[ = str_
{ matchSource = noCaptureNames
, captureNames = array (0,2)
, matchArray 0,Capture {captureSource = str_, capturedText = "a", captureOffset = 0, captureLength = 1})
[ (1,Capture {captureSource = str_, capturedText = "a", captureOffset = 0, captureLength = 1})
, (2,Capture {captureSource = str_, capturedText = "", captureOffset = -1, captureLength = 0})
, (
]
}Match
, = str_
{ matchSource = noCaptureNames
, captureNames = array (0,2)
, matchArray 0,Capture {captureSource = str_, capturedText = "bbbb", captureOffset = 2 , captureLength = 4})
[ (1,Capture {captureSource = str_, capturedText = "" , captureOffset = -1, captureLength = 0})
, (2,Capture {captureSource = str_, capturedText = "bbbb", captureOffset = 2 , captureLength = 4})
, (
]
}Match
, = str_
{ matchSource = noCaptureNames
, captureNames = array (0,2)
, matchArray 0,Capture {captureSource = str_, capturedText = "aa", captureOffset = 7 , captureLength = 2})
[ (1,Capture {captureSource = str_, capturedText = "aa", captureOffset = 7 , captureLength = 2})
, (2,Capture {captureSource = str_, capturedText = "" , captureOffset = -1, captureLength = 0})
, (
]
}Match
, = str_
{ matchSource = noCaptureNames
, captureNames = array (0,2)
, matchArray 0,Capture {captureSource = str_, capturedText = "b", captureOffset = 10, captureLength = 1})
[ (1,Capture {captureSource = str_, capturedText = "" , captureOffset = -1, captureLength = 0})
, (2,Capture {captureSource = str_, capturedText = "b", captureOffset = 10, captureLength = 1})
, (
]
}
] }
compiling_tests :: TestTree
= testGroup "Compiling"
compiling_tests "complete check (matchM/ByteString)" $ do
[ testCase <- TDFA.compileRegex $ reSource regex_
r "Match" (B.pack <$> regex_str_match) $ B.pack str_ ?=~ r
assertEqual "matched (matchM/Text)" $ do
, testCase <- TDFA.compileRegex $ reSource regex_
r "matched" $ matched $ T.pack str_ ?=~ r
assertBool "TDFA.String" TDFA.compileRegex
, tc "TDFA.B" $ TDFA.compileRegex . B.unpack
, tc "TDFA.LBS" $ TDFA.compileRegex . LBS.unpack
, tc "TDFA.T" $ TDFA.compileRegex . T.unpack
, tc "TDFA.LT" $ TDFA.compileRegex . LT.unpack
, tc "TDFA.S" $ TDFA.compileRegex . s_toList
, tc "PCRE.String" PCRE.compileRegex
, tc "PCRE.B" $ PCRE.compileRegex . B.unpack
, tc "PCRE.LBS" $ PCRE.compileRegex . LBS.unpack
, tc "PCRE.S" $ PCRE.compileRegex . s_toList
, tc
]where
tc :: IsRegex re s => String -> (s->IO re) -> TestTree
= testGroup lab
tc lab mk0 "loop" $ do
[ testCase <- mk re_s
r "RE" re_s $ regexSource r
assertEqual "Match" $ do
, testCase <- mk' re_s
r "Match" (pk <$> regex_str_match) $ matchOnce r $ pk str_
assertEqual "Escape" $ do
, testCase <- esc $ pk "foobar"
r "String" (pk "bar") $ matchSource $ matchOnce r $ pk "bar"
assertEqual
]where
= makeRegex `asTypeOf` mk0
mk
= makeRegexWith minBound `asTypeOf` mk0
mk'
= makeEscaped id `asTypeOf` mk0
esc
= pk $ reSource regex_
re_s
= mk_pk mk0
pk
mk_pk :: Replace s' => (s'->IO re') -> String -> s'
= packR mk_pk _
core_tests :: TestTree
= testGroup "Match"
core_tests "text (=~~Text.Lazy)" $ do
[ testCase <- LT.pack str_ =~~ [re|(a+) (b+)|] :: IO (LT.Text)
txt "text" txt "a bbbb"
assertEqual "multi (=~~/String)" $ do
, testCase let sm = str_ =~ regex_ :: Match String
= capture [cp|0|] sm
m "captureSource" "a bbbb aa b" $ captureSource m
assertEqual "capturedText" "a bbbb" $ capturedText m
assertEqual "capturePrefix" "" $ capturePrefix m
assertEqual "captureSuffix" " aa b" $ captureSuffix m
assertEqual "complete (=~~/ByteString)" $ do
, testCase <- B.pack str_ =~~ regex_ :: IO (Match B.ByteString)
mtch "Match" mtch $ B.pack <$> regex_str_match
assertEqual "complete (all,String)" $ do
, testCase let mtchs = str_ =~ regex_ :: Matches String
"Matches" mtchs regex_str_matches
assertEqual "complete (all,reg_alt)" $ do
, testCase let mtchs = str_ =~ regex_alt :: Matches String
"Matches" mtchs regex_alt_str_matches
assertEqual "complete (=~~,all)" $ do
, testCase <- str_ =~~ regex_ :: IO (Matches String)
mtchs "Matches" mtchs regex_str_matches
assertEqual "fail (all)" $ do
, testCase let mtchs = str' =~ regex_ :: Matches String
"not.anyMatches" False $ anyMatches mtchs
assertEqual ]
replace_methods_tests :: TestTree
= testGroup "Replace"
replace_methods_tests "String/single" $ do
[ testCase let m = str_ =~ regex_ :: Match String
= replaceCaptures ALL fmt m
r "replaceCaptures" r "(0:0:(0:1:a) (0:2:bbbb)) aa b"
assertEqual "String/alt" $ do
, testCase let ms = str_ =~ regex_ :: Matches String
= replaceAllCaptures ALL fmt ms
r
chk r"String" $ do
, testCase let ms = str_ =~ regex_ :: Matches String
= replaceAllCaptures ALL fmt ms
r
chk r"ByteString" $ do
, testCase let ms = B.pack str_ =~ regex_ :: Matches B.ByteString
= replaceAllCaptures ALL fmt ms
r
chk r"LBS.ByteString" $ do
, testCase let ms = LBS.pack str_ =~ regex_ :: Matches LBS.ByteString
= replaceAllCaptures ALL fmt ms
r
chk r"Seq Char" $ do
, testCase let ms = S.fromList str_ =~ regex_ :: Matches (S.Seq Char)
= \_ (RELocation i j) Capture{..} -> Just $ S.fromList $
f "(" M.<> show i M.<> ":" M.<> show_co j M.<> ":" M.<>
M.<> ")"
F.toList capturedText = replaceAllCaptures ALL f ms
r "replaceAllCaptures" r $
assertEqual "(0:0:(0:1:a) (0:2:bbbb)) (1:0:(1:1:aa) (1:2:b))"
S.fromList "Text" $ do
, testCase let ms = T.pack str_ =~ regex_ :: Matches T.Text
= replaceAllCaptures ALL fmt ms
r
chk r"LT.Text" $ do
, testCase let ms = LT.pack str_ =~ regex_ :: Matches LT.Text
= replaceAllCaptures ALL fmt ms
r
chk r
]where
=
chk r
assertEqual"replaceAllCaptures"
r"(0:0:(0:1:a) (0:2:bbbb)) (1:0:(1:1:aa) (1:2:b))"
fmt :: (IsString s,Replace s) => a -> RELocation -> Capture s -> Maybe s
RELocation i j) Capture{..} = Just $ "(" M.<> packR (show i) M.<> ":" M.<>
fmt _ (M.<> ":" M.<> capturedText M.<> ")"
packR (show_co j)
CaptureOrdinal j) = show j show_co (
search_replace_tests :: TestTree
= testGroup "SearchReplace" $
search_replace_tests "?=~/ [ed_| ... |]" $ "baz bar foobar" @=? "foo bar foobar" T_ST.?=~/ [ed_|foo///baz|] ()
[ testCase "*=~/ [ed_| ... |]" $ "baz bar bazbar" @=? "foo bar foobar" T_ST.*=~/ [ed_|foo///baz|] MultilineSensitive
, testCase "TDFA.ed/String" $ test_ id tdfa_eds
, testCase "PCRE.ed/String" $ test_ id pcre_eds
, testCase "TDFA.ed/B" $ test_ B.pack tdfa_eds
, testCase "PCRE.ed/B" $ test_ B.pack pcre_eds
, testCase "TDFA.ed/LBS" $ test_ LBS.pack tdfa_eds
, testCase "PCRE.ed/LBS" $ test_ LBS.pack pcre_eds
, testCase "TDFA.ed/S" $ test_ S.fromList tdfa_eds
, testCase "PCRE.ed/S" $ test_ S.fromList pcre_eds
, testCase "TDFA.ed/T" $ test_ T.pack tdfa_eds
, testCase "TDFA.ed/LT" $ test_ LT.pack tdfa_eds
, testCase "TDFA.ed/T(d)" $ test_ T.pack tdfa_eds'
, testCase "PCRE.ed/LBS(d)" $ test_ LBS.pack pcre_eds'
, testCase "TDFA.op" (T_ST.?=~/) (T_ST.*=~/) tdfa_sr
, testg "PCRE.op" (P_ST.?=~/) (P_ST.*=~/) pcre_sr
, testg "TDFA.op/String" (T_ST.?=~/) (T_ST.*=~/) tdfa_sr_str
, testg "PCRE.op/String" (P_ST.?=~/) (P_ST.*=~/) pcre_sr_str
, testg "TDFA.op/B" (T_BS.?=~/) (T_BS.*=~/) tdfa_sr_b
, testg "PCRE.op/B" (P_BS.?=~/) (P_BS.*=~/) pcre_sr_b
, testg "TDFA.op/LBS" (TLBS.?=~/) (TLBS.*=~/) tdfa_sr_lbs
, testg "PCRE.op/LBS" (PLBS.?=~/) (PLBS.*=~/) pcre_sr_lbs
, testg "TDFA.op/T" (T_TX.?=~/) (T_TX.*=~/) tdfa_sr_t
, testg "PCRE.op/T" (P_TX.?=~/) (P_TX.*=~/) pcre_sr_t
, testg "TDFA.op/LT" (TLTX.?=~/) (TLTX.*=~/) tdfa_sr_lt
, testg "PCRE.op/LT" (PLTX.?=~/) (PLTX.*=~/) pcre_sr_lt
, testg "TDFA.op/S" (T_SQ.?=~/) (T_SQ.*=~/) tdfa_sr_s
, testG "PCRE.op/S" (P_SQ.?=~/) (P_SQ.*=~/) pcre_sr_s
, testG "TDFA.U/String" id (T_ST.*=~/) [T_ST.ed|scientist///boffin|] (T_ST.*=~) [T_ST.re|λ-|]
, testu "TDFA.U/B" B.fromString (T_BS.*=~/) [T_BS.ed|scientist///boffin|] (T_BS.*=~) [T_BS.re|burble|]
, testu "TDFA.U/LBS" LBS.fromString (TLBS.*=~/) [TLBS.ed|scientist///boffin|] (TLBS.*=~) [TLBS.re|burble|]
, testu "TDFA.U/T" T.pack (T_TX.*=~/) [T_TX.ed|scientist///boffin|] (T_TX.*=~) [T_TX.re|λ-|]
, testu "TDFA.U/LT" LT.pack (TLTX.*=~/) [TLTX.ed|scientist///boffin|] (TLTX.*=~) [TLTX.re|λ-|]
, testu "TDFA.U/S" S.fromList (T_SQ.*=~/) [T_SQ.ed|scientist///boffin|] (T_SQ.*=~) [T_SQ.re|λ-|]
, testu ++ not_win32_for_now
] "PCRE.U/String" id (P_ST.*=~/) [P_ST.ed|scientist///boffin|] (P_ST.*=~) [P_ST.re|λ-|]
[ testu "PCRE.U/B" B.fromString (P_BS.*=~/) [P_BS.ed|scientist///boffin|] (P_BS.*=~) [P_BS.re|λ-|]
, testu "PCRE.U/LBS" LBS.fromString (PLBS.*=~/) [PLBS.ed|scientist///boffin|] (PLBS.*=~) [PLBS.re|λ-|]
, testu "PCRE.U/T" T.pack (P_TX.*=~/) [P_TX.ed|scientist///boffin|] (P_TX.*=~) [P_TX.re|λ-|]
, testu "PCRE.U/LT" LT.pack (PLTX.*=~/) [PLTX.ed|scientist///boffin|] (PLTX.*=~) [PLTX.re|λ-|]
, testu "PCRE.U/S" S.fromList (P_SQ.*=~/) [P_SQ.ed|scientist///boffin|] (P_SQ.*=~) [P_SQ.re|burble|]
, testu
]where
not_win32_for_now :: [a] -> [a]
= case SI.os == "mingw32" of
not_win32_for_now True -> const []
False -> id
test_ :: IsRegex re a => (String->a) -> Edits Identity re a -> Assertion
= inj rsm @=? runIdentity (sed' eds $ inj inp)
test_ inj eds
= testGroup lab
testg lab op1 opm sr "?=~/" $ rs1 @=? inp `op1` sr
[ testCase "*=~/" $ rsm @=? inp `opm` sr
, testCase
]
= testGroup lab
testG lab op1 opm sr "?=~/" $ S.fromList rs1 @=? S.fromList inp `op1` sr
[ testCase "*=~/" $ S.fromList rsm @=? S.fromList inp `opm` sr
, testCase
]
= testGroup lab
testu lab inj op sr qop rex "*=~/" $ inj unr @=? inj uni `op` sr
[ testCase "*=~" $ 1 @=? countMatches (inj uni `qop` rex)
, testCase
]
rsm :: IsString a => a
inp, rs1,= "16/03/2017 01/01/2000\n"
inp = "2017-03-16 01/01/2000\n"
rs1 = "2017-03-16 2000-01-01\n"
rsm
unr :: String
uni,= "\x2070E-\8364-\955-scientist-burble"
uni = "\x2070E-\8364-\955-boffin-burble"
unr
tdfa_eds :: IsRegex TDFA.RE a => Edits Identity TDFA.RE a
= Select [Template tdfa_sr]
tdfa_eds
pcre_eds :: IsRegex PCRE.RE a => Edits Identity PCRE.RE a
= Select [Template pcre_sr]
pcre_eds
tdfa_sr :: IsRegex TDFA.RE a => SearchReplace TDFA.RE a
= [TDFA.ed|${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})///${y}-${m}-${d}|]
tdfa_sr
pcre_sr :: IsRegex PCRE.RE a => SearchReplace PCRE.RE a
= [PCRE.ed|${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})///${y}-${m}-${d}|]
pcre_sr
tdfa_sr_str :: SearchReplace TDFA.RE String
= [T_ST.ed|${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})///${y}-${m}-${d}|]
tdfa_sr_str
pcre_sr_str :: SearchReplace PCRE.RE String
= [P_ST.ed|${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})///${y}-${m}-${d}|]
pcre_sr_str
tdfa_sr_b :: SearchReplace TDFA.RE B.ByteString
= [T_BS.ed|${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})///${y}-${m}-${d}|]
tdfa_sr_b
pcre_sr_b :: SearchReplace PCRE.RE B.ByteString
= [P_BS.ed|${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})///${y}-${m}-${d}|]
pcre_sr_b
tdfa_sr_lbs :: SearchReplace TDFA.RE LBS.ByteString
= [TLBS.ed|${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})///${y}-${m}-${d}|]
tdfa_sr_lbs
pcre_sr_lbs :: SearchReplace PCRE.RE LBS.ByteString
= [PLBS.ed|${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})///${y}-${m}-${d}|]
pcre_sr_lbs
tdfa_sr_t :: SearchReplace TDFA.RE T.Text
= [T_TX.ed|${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})///${y}-${m}-${d}|]
tdfa_sr_t
pcre_sr_t :: SearchReplace PCRE.RE T.Text
= [P_TX.ed|${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})///${y}-${m}-${d}|]
pcre_sr_t
tdfa_sr_lt :: SearchReplace TDFA.RE LT.Text
= [TLTX.ed|${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})///${y}-${m}-${d}|]
tdfa_sr_lt
pcre_sr_lt :: SearchReplace PCRE.RE LT.Text
= [PLTX.ed|${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})///${y}-${m}-${d}|]
pcre_sr_lt
tdfa_sr_s :: SearchReplace TDFA.RE (S.Seq Char)
= [T_SQ.ed|${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})///${y}-${m}-${d}|]
tdfa_sr_s
pcre_sr_s :: SearchReplace PCRE.RE (S.Seq Char)
= [P_SQ.ed|${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})///${y}-${m}-${d}|]
pcre_sr_s
tdfa_eds' :: IsRegex TDFA.RE a => Edits Identity TDFA.RE a
= Select [Template $ tdfa_csr "${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})" "${y}-${m}-${d}"]
tdfa_eds'
pcre_eds' :: IsRegex PCRE.RE a => Edits Identity PCRE.RE a
= Select [Template $ pcre_csr "${d}([0-9]{2})/${m}([0-9]{2})/${y}([0-9]{4})" "${y}-${m}-${d}"]
pcre_eds'
tdfa_csr :: IsRegex TDFA.RE s
=> String
-> String
-> SearchReplace TDFA.RE s
= maybe (error "eek") id . TDFA.compileSearchReplace re_s
tdfa_csr re_s
pcre_csr :: IsRegex PCRE.RE s
=> String
-> String
-> SearchReplace PCRE.RE s
= maybe (error "eek") id . PCRE.compileSearchReplace re_s pcre_csr re_s
options_tests :: TestTree
= testGroup "Simple REOptions"
options_tests "TDFA Simple REOptions"
[ testGroup "default (MultilineSensitive)" $ assertEqual "#" 2 $
[ testCase $ s TDFA.*=~ [TDFA.re|[0-9a-f]{2}$|]
countMatches "MultilineSensitive" $ assertEqual "#" 2 $
, testCase $ s TDFA.*=~ [TDFA.reMultilineSensitive|[0-9a-f]{2}$|]
countMatches "MultilineInsensitive" $ assertEqual "#" 4 $
, testCase $ s TDFA.*=~ [TDFA.reMultilineInsensitive|[0-9a-f]{2}$|]
countMatches "BlockSensitive" $ assertEqual "#" 0 $
, testCase $ s TDFA.*=~ [TDFA.reBlockSensitive|[0-9a-f]{2}$|]
countMatches "BlockInsensitive" $ assertEqual "#" 1 $
, testCase $ s TDFA.*=~ [TDFA.reBlockInsensitive|[0-9a-f]{2}$|]
countMatches
]"PCRE Simple REOptions"
, testGroup "default (MultilineSensitive)" $ assertEqual "#" 2 $
[ testCase $ s PCRE.*=~ [PCRE.re|[0-9a-f]{2}$|]
countMatches "MultilineSensitive" $ assertEqual "#" 2 $
, testCase $ s PCRE.*=~ [PCRE.reMultilineSensitive|[0-9a-f]{2}$|]
countMatches "MultilineInsensitive" $ assertEqual "#" 4 $
, testCase $ s PCRE.*=~ [PCRE.reMultilineInsensitive|[0-9a-f]{2}$|]
countMatches "BlockSensitive" $ assertEqual "#" 0 $
, testCase $ s PCRE.*=~ [PCRE.reBlockSensitive|[0-9a-f]{2}$|]
countMatches "BlockInsensitive" $ assertEqual "#" 1 $
, testCase $ s PCRE.*=~ [PCRE.reBlockInsensitive|[0-9a-f]{2}$|]
countMatches
]
]where
= "0a\nbb\nFe\nA5" :: String s
many_tests :: TestTree
= testGroup "Many Tests"
many_tests "PCRE a" $ test_ (PCRE.*=~) (PCRE.?=~) (PCRE.=~) (PCRE.=~~) matchOnce matchMany makeSearchReplace id re_pcre
[ testCase "PCRE ByteString" $ test_ (P_BS.*=~) (P_BS.?=~) (P_BS.=~) (P_BS.=~~) matchOnce matchMany makeSearchReplace B.pack re_pcre
, testCase "PCRE ByteString.Lazy" $ test_ (PLBS.*=~) (PLBS.?=~) (PLBS.=~) (PLBS.=~~) matchOnce matchMany makeSearchReplace LBS.pack re_pcre
, testCase "PCRE Sequence" $ test_ (P_SQ.*=~) (P_SQ.?=~) (P_SQ.=~) (P_SQ.=~~) matchOnce matchMany makeSearchReplace S.fromList re_pcre
, testCase "PCRE String" $ test_ (P_ST.*=~) (P_ST.?=~) (P_ST.=~) (P_ST.=~~) matchOnce matchMany makeSearchReplace id re_pcre
, testCase "PCRE Text" $ test_ (P_TX.*=~) (P_TX.?=~) (P_TX.=~) (P_TX.=~~) matchOnce matchMany makeSearchReplace T.pack re_pcre
, testCase "PCRE Text.Lazy" $ test_ (PLTX.*=~) (PLTX.?=~) (PLTX.=~) (PLTX.=~~) matchOnce matchMany makeSearchReplace LT.pack re_pcre
, testCase "TDFA a" $ test_ (TDFA.*=~) (TDFA.?=~) (TDFA.=~) (TDFA.=~~) matchOnce matchMany makeSearchReplace id re_tdfa
, testCase "TDFA ByteString" $ test_ (T_BS.*=~) (T_BS.?=~) (T_BS.=~) (T_BS.=~~) matchOnce matchMany makeSearchReplace B.pack re_tdfa
, testCase "TDFA ByteString.Lazy" $ test_ (TLBS.*=~) (TLBS.?=~) (TLBS.=~) (TLBS.=~~) matchOnce matchMany makeSearchReplace LBS.pack re_tdfa
, testCase "TDFA Sequence" $ test_ (T_SQ.*=~) (T_SQ.?=~) (T_SQ.=~) (T_SQ.=~~) matchOnce matchMany makeSearchReplace S.fromList re_tdfa
, testCase "TDFA String" $ test_ (T_ST.*=~) (T_ST.?=~) (T_ST.=~) (T_ST.=~~) matchOnce matchMany makeSearchReplace id re_tdfa
, testCase "TDFA Text" $ test_ (T_TX.*=~) (T_TX.?=~) (T_TX.=~) (T_TX.=~~) matchOnce matchMany makeSearchReplace T.pack re_tdfa
, testCase "TDFA Text.Lazy" $ test_ (TLTX.*=~) (TLTX.?=~) (TLTX.=~) (TLTX.=~~) matchOnce matchMany makeSearchReplace LT.pack re_tdfa
, testCase
]where
test_ :: (IsRegex r s,Show s,Eq s)
=> (s->r->Matches s)
-> (s->r->Match s)
-> (s->r->Matches s)
-> (s->r->Maybe(Match s))
-> (r->s->Match s)
-> (r->s->Matches s)
-> (s->s->Maybe (SearchReplace r s))
-> (String->s)
-> r
-> Assertion
%*=~) (%?=~) (%=~) (%=~~) mo mm mk_sr0 inj r = do
test_ (2 @=? countMatches mtchs
Just txt' @=? matchedText mtch
@=? mtchs'
mtchs @=? Just mtch
mb_mtch @=? mtch''
mtch @=? mtchs''
mtchs @=? searchReplaceAll (mk_sr re_t tpl) txt
txt'' where
= txt %*=~ r
mtchs = txt %?=~ r
mtch = txt %=~ r
mtchs' = txt %=~~ r
mb_mtch = mo r txt
mtch'' = mm r txt
mtchs''
= inj re_s
re_t = inj "${d}/${m}/${y}"
tpl
= inj "2016-01-09 2015-12-5 2015-10-05"
txt = inj "2016-01-09"
txt' = inj "09/01/2016 2015-12-5 05/10/2015"
txt''
= \r_ t_ -> maybe (error "agh") id $ mk_sr0 r_ t_
mk_sr
= fromMaybe oops $ PCRE.compileRegex "[0-9]{4}-[0-9]{2}-[0-9]{2}"
re_pcre = fromMaybe oops $ TDFA.compileRegex "[0-9]{4}-[0-9]{2}-[0-9]{2}"
re_tdfa
= "${y}([0-9]{4})-${m}([0-9]{2})-${d}([0-9]{2})"
re_s
= error "many_tests" oops
escape_tests :: TestTree
= testGroup "Escape Tests"
escape_tests "PCRE"
[ testGroup "Escaping empty string" $
[ testCase "empty string" $
assertBool P_ST.?=~) ""
tst P_ST.escape ("Escaping RE metacharacters" $
, testCase "metacharacters" $
assertBool P_ST.?=~) metacharacters
tst P_ST.escape (SmallCheckDepth 6) $
, localOption ("matched $ <s> ?=~ [re|^escape(<s>)$|]" $
SC.testProperty P_ST.?=~)
tst P_ST.escape (
]"TDFA"
, testGroup "Escaping empty string" $
[ testCase "empty string" $
assertBool T_ST.?=~) ""
tst T_ST.escape ("Escaping RE metacharacters" $
, testCase "metacharacters" $
assertBool T_ST.?=~) metacharacters
tst T_ST.escape (SmallCheckDepth 6) $
, localOption ("matched $ <s> ?=~ [re|^escape(<s>)$|]" $
SC.testProperty T_ST.?=~)
tst T_ST.escape (
]
]where
tst :: ((String->String)->String->Maybe a)
-> (String->a->Match String)
-> String
-> Bool
%=~) s = matched $ s %=~ esc s
tst esc0 (where
= un_maybe . esc0 (("^" ++) . (++ "$"))
esc
metacharacters :: String
= "^\\.|*+?()[]{}$" metacharacters
named_capture_tests :: TestTree
= localOption (SmallCheckDepth 4) $
named_capture_tests "NamedCaptures"
testGroup
[ format_scan_tests
, analyse_tokens_tests
]
instance Monad m => Serial m Token
format_scan_tests :: TestTree
=
format_scan_tests "FormatToken/Scan Properties"
testGroup SmallCheckDepth 4) $
[ localOption ("formatTokens == formatTokens0" $
SC.testProperty -> formatTokens tks == formatTokens0 tks
\tks SmallCheckDepth 4) $
, localOption ("scan . formatTokens' idFormatTokenREOptions == id" $
SC.testProperty -> all validToken tks ==>
\tks == tks
scan (formatTokens' idFormatTokenREOptions tks)
]
analyse_tokens_tests :: TestTree
=
analyse_tokens_tests "Analysing [Token] Unit Tests"
testGroup
[ tc [here|foobar|] []
, tc [here||] []
, tc [here|$([0-9]{4})|] []1,"x")]
, tc [here|${x}()|] [(
, tc [here|${}()|] []2,"foo")]
, tc [here|${}()${foo}()|] [(1,"x")]
, tc [here|${x}(${y()})|] [(1,"x"),(2,"y")]
, tc [here|${x}(${y}())|] [(1,"a")]
, tc [here|${a}(${b{}())|] [(1,"y"),(2,"m"),(3,"d")]
, tc [here|${y}([0-9]{4})-${m}([0-9]{2})-${d}([0-9]{2})|] [(2,"name")]
, tc [here|@$(@|\{${name}([^{}]+)\})|] [(
, tc [here|${y}[0-9]{4}|] []
, tc [here|${}([0-9]{4})|] []
]where
=
tc s al $ assertEqual "CaptureNames"
testCase s
(xnc s)
(HM.fromListCaptureName $ T.pack n,CaptureOrdinal i)
[ (| (i,n)<-al
]
)
= either oops (snd . fst) . extractNamedCaptures
xnc where
= error "analyse_tokens_tests: unexpected parse failure" oops
add_capture_names_tests :: TestTree
= testGroup "AddCaptureNames Tests"
add_capture_names_tests "Match String" test_match regex_str_match
[ test_add_capture_name "Matches String" test_matches regex_str_matches
, test_add_capture_name "Match B.ByteString" test_match $ B.pack <$> regex_str_match
, test_add_capture_name "Matches B.ByteString" test_matches $ B.pack <$> regex_str_matches
, test_add_capture_name "Match LBS.ByteString" test_match $ LBS.pack <$> regex_str_match
, test_add_capture_name "Matches LBS.ByteString" test_matches $ LBS.pack <$> regex_str_matches
, test_add_capture_name "Match T.Text" test_match $ T.pack <$> regex_str_match
, test_add_capture_name "Matches T.Text" test_matches $ T.pack <$> regex_str_matches
, test_add_capture_name "Match LT.Text" test_match $ LT.pack <$> regex_str_match
, test_add_capture_name "Matches LT.Text" test_matches $ LT.pack <$> regex_str_matches
, test_add_capture_name "Match (Seq Char)" test_match $ S.fromList <$> regex_str_match
, test_add_capture_name "Matches (Seq Char)" test_matches $ S.fromList <$> regex_str_matches
, test_add_capture_name
]
test_matches :: CaptureNames -> Matches a -> Bool
= all (test_match cnms) . allMatches
test_matches cnms
test_match :: CaptureNames -> Match a -> Bool
= captureNames mtch == cnms
test_match cnms mtch
test_add_capture_name :: Typeable a
=> String
-> (CaptureNames->a->Bool)
-> a
-> TestTree
= testCase lab $
test_add_capture_name lab tst x $ tst cnms $ addCaptureNames cnms x
assertBool lab where
= HM.fromList
cnms CaptureName "x",1)
[ (CaptureName "y",2)
, ( ]
find_tests :: TestTree
= testGroup "Find Tests"
find_tests "examples/" $ do
[ testCase <- findMatches_ findMethods [re|^re-.*\.lhs|] "examples/"
fps @=? filter (not . matched . (?=~ [re|master\.lhs|])) fps
example_paths
]
example_paths :: [String]
=
example_paths "examples/re-gen-cabals.lhs"
[ "examples/re-gen-modules.lhs"
, "examples/re-include.lhs"
, "examples/re-nginx-log-processor.lhs"
, "examples/re-prep.lhs"
, "examples/re-sort-imports.lhs"
, "examples/re-tests.lhs"
, "examples/re-top.lhs"
, "examples/re-tutorial-options.lhs"
, "examples/re-tutorial-replacing.lhs"
, "examples/re-tutorial-testbench.lhs"
, "examples/re-tutorial-tools.lhs"
, "examples/re-tutorial.lhs"
,
]
findMethods :: FindMethods String
=
findMethods FindMethods
= doesDirectoryExist
{ doesDirectoryExistDM = getDirectoryContents
, listDirectoryDM = (</>)
, combineDM }
backslash_tests :: TestTree
= testGroup "Backslash Tests"
backslash_tests "PCRE"
[ testGroup "backslash-a" $ "\ay" @=? "--foo\ay" P_TX.*=~/ [P_TX.edBlockSensitive|--[^\a]*///|]
[ testCase "backslash-b" $ "\by" @=? "--foo\by" P_TX.*=~/ [P_TX.edBlockSensitive|--[^\b]*///|]
, testCase "backslash-f" $ "\fy" @=? "--foo\fy" P_TX.*=~/ [P_TX.edBlockSensitive|--[^\f]*///|]
, testCase "backslash-n" $ "\ny" @=? "--foo\ny" P_TX.*=~/ [P_TX.edBlockSensitive|--[^\n]*///|]
, testCase "backslash-r" $ "\ry" @=? "--foo\ry" P_TX.*=~/ [P_TX.edBlockSensitive|--[^\r]*///|]
, testCase "backslash-t" $ "\ty" @=? "--foo\ty" P_TX.*=~/ [P_TX.edBlockSensitive|--[^\t]*///|]
, testCase "backslash-v" $ "\vy" @=? "--foo\vy" P_TX.*=~/ [P_TX.edBlockSensitive|--[^\v]*///|]
, testCase "backslash-$" $ "$y" @=? "--foo$y" P_TX.*=~/ [P_TX.edBlockSensitive|--[^\$]*///|]
, testCase "backslash-backslash" $ "\\y" @=? "--foo\\y" P_TX.*=~/ [P_TX.edBlockSensitive|--[^\\]*///|]
, testCase
]"TDFA"
, testGroup "backslash-a" $ "\ay" @=? "--foo\ay" T_TX.*=~/ [T_TX.edBlockSensitive|--[^\a]*///|]
[ testCase "backslash-b" $ "\by" @=? "--foo\by" T_TX.*=~/ [T_TX.edBlockSensitive|--[^\b]*///|]
, testCase "backslash-f" $ "\fy" @=? "--foo\fy" T_TX.*=~/ [T_TX.edBlockSensitive|--[^\f]*///|]
, testCase "backslash-n" $ "\ny" @=? "--foo\ny" T_TX.*=~/ [T_TX.edBlockSensitive|--[^\n]*///|]
, testCase "backslash-r" $ "\ry" @=? "--foo\ry" T_TX.*=~/ [T_TX.edBlockSensitive|--[^\r]*///|]
, testCase "backslash-t" $ "\ty" @=? "--foo\ty" T_TX.*=~/ [T_TX.edBlockSensitive|--[^\t]*///|]
, testCase "backslash-v" $ "\vy" @=? "--foo\vy" T_TX.*=~/ [T_TX.edBlockSensitive|--[^\v]*///|]
, testCase "backslash-$" $ "$y" @=? "--foo$y" T_TX.*=~/ [T_TX.edBlockSensitive|--[^\$]*///|]
, testCase "backslash-backslash" $ "\\y" @=? "--foo\\y" T_TX.*=~/ [T_TX.edBlockSensitive|--[^\\]*///|]
, testCase
] ]
misc_tests :: TestTree
= testGroup "Miscelaneous Tests"
misc_tests "CaptureID"
[ testGroup "CaptureID lookup failure" $ do
[ testCase <- isValidError $ unsafe_find_capture_id [cp|foo|] $ reCaptureNames [re|foo|]
ok "failed" ok
assertBool
]"QQ"
, testGroup "re" re
[ qq_tc "reMS" reMS
, qq_tc "reMI" reMI
, qq_tc "reBS" reBS
, qq_tc "reBI" reBI
, qq_tc "reMultilineSensitive" reMultilineSensitive
, qq_tc "reMultilineInsensitive" reMultilineInsensitive
, qq_tc "reBlockSensitive" reBlockSensitive
, qq_tc "reBlockInsensitive" reBlockInsensitive
, qq_tc "re_" re_
, qq_tc "ed" ed
, qq_tc "edMS" edMS
, qq_tc "edMI" edMI
, qq_tc "edBS" edBS
, qq_tc "edBI" edBI
, qq_tc "edMultilineSensitive" edMultilineSensitive
, qq_tc "edMultilineInsensitive" edMultilineInsensitive
, qq_tc "edBlockSensitive" edBlockSensitive
, qq_tc "edBlockInsensitive" edBlockInsensitive
, qq_tc "ed_" ed_
, qq_tc
]"PreludeMacros"
, testGroup "preludeMacroTable" preludeMacroTable
[ valid_string "preludeMacroSummary" preludeMacroSummary
, valid_macro "preludeMacroSources" preludeMacroSources
, valid_string "preludeMacroSource" preludeMacroSource
, valid_macro
]-- because HPC can't measure our testing of [re|..|] forms,
-- we are eliminating them from our enquiries
"RE"
, testGroup
[ valid_res TDFA.regexType
[ TDFA.re
, TDFA.reMS
, TDFA.reMI
, TDFA.reBS
, TDFA.reBI
, TDFA.reMultilineSensitive
, TDFA.reMultilineInsensitive
, TDFA.reBlockSensitive
, TDFA.reBlockInsensitive
, TDFA.re_
, TDFA.ed
, TDFA.edMS
, TDFA.edMI
, TDFA.edBS
, TDFA.edBI
, TDFA.edMultilineSensitive
, TDFA.edMultilineInsensitive
, TDFA.edBlockSensitive
, TDFA.edBlockInsensitive
, TDFA.ed_
]"TDFA.regexType" $ assertBool "TDFA" $ isTDFA TDFA.regexType
, testCase "TDFA.reOptions" $ assert_empty_macs $ optionsMacs (TDFA.reOptions tdfa_re)
, testCase "TDFA.makeREOptions md" $ assert_empty_macs $ optionsMacs tdfa_opts
, testCase "TDFA.preludeTestsFailing" $ [] @=? TDFA.preludeTestsFailing
, testCase "TDFA.preludeTable" TDFA.preludeTable
, ne_string "TDFA.preludeSources" TDFA.preludeSources
, ne_string "TDFA.preludeSummary"
, testGroup $ TDFA.preludeSummary pm
[ ne_string (presentPreludeMacro pm) | pm <- tdfa_prelude_macros
]"TDFA.preludeSource"
, testGroup $ TDFA.preludeSource pm
[ ne_string (presentPreludeMacro pm) | pm <- tdfa_prelude_macros
]-- because HPC can't measure our testing of [re|..|] forms,
-- we are eliminating them from our enquiries
, valid_res PCRE.regexType
[ PCRE.re
, PCRE.reMS
, PCRE.reMI
, PCRE.reBS
, PCRE.reBI
, PCRE.reMultilineSensitive
, PCRE.reMultilineInsensitive
, PCRE.reBlockSensitive
, PCRE.reBlockInsensitive
, PCRE.re_
, PCRE.ed
, PCRE.edMS
, PCRE.edMI
, PCRE.edBS
, PCRE.edBI
, PCRE.edMultilineSensitive
, PCRE.edMultilineInsensitive
, PCRE.edBlockSensitive
, PCRE.edBlockInsensitive
, PCRE.ed_
]"PCRE.regexType" $ assertBool "PCRE" $ isPCRE PCRE.regexType
, testCase "PCRE.reOptions" $ assert_empty_macs $ optionsMacs (PCRE.reOptions pcre_re)
, testCase "PCRE.makeREOptions md" $ assert_empty_macs $ optionsMacs pcre_opts
, testCase "PCRE.preludeTestsFailing" $ [] @=? PCRE.preludeTestsFailing
, testCase "PCRE.preludeTable" PCRE.preludeTable
, ne_string "PCRE.preludeTable" PCRE.preludeSources
, ne_string "PCRE.preludeSummary"
, testGroup $ PCRE.preludeSummary pm
[ ne_string (presentPreludeMacro pm) | pm <- pcre_prelude_macros
]"PCRE.preludeSource"
, testGroup $ PCRE.preludeSource pm
[ ne_string (presentPreludeMacro pm) | pm <- pcre_prelude_macros
]
]
]where
= fromMaybe oops $ TDFA.compileRegexWithOptions tdfa_opts ".*"
tdfa_re = fromMaybe oops $ PCRE.compileRegexWithOptions pcre_opts ".*"
pcre_re
= TDFA.makeREOptions no_macs_t :: REOptions_ TDFA.RE TDFA_.CompOption TDFA_.ExecOption
tdfa_opts = PCRE.makeREOptions no_macs_p :: REOptions_ PCRE.RE PCRE_.CompOption PCRE_.ExecOption
pcre_opts
= HM.fromList [] :: Macros TDFA.RE
no_macs_t = HM.fromList [] :: Macros PCRE.RE
no_macs_p
= error "misc_tests"
oops
= assertBool "macros not empty" . HM.null
assert_empty_macs
qq_tc :: String -> QuasiQuoter -> TestTree
= testCase lab $ quoteExp qq `seq` assertBool "qq_tc" True
qq_tc lab qq
valid_macro :: String -> (RegexType->PreludeMacro->String) -> TestTree
= testGroup label
valid_macro label f flip f pm)
[ valid_string (presentPreludeMacro pm) (| pm<-[minBound..maxBound]
]
valid_string :: String -> (RegexType->String) -> TestTree
= testGroup label
valid_string label f $ f rty
[ ne_string (presentRegexType rty) | rty<-[TDFA.regexType] -- until PCRE has a binding for all macros
]
ne_string :: String -> String -> TestTree
=
ne_string label s $ assertBool "non-empty string" $ length s > 0
testCase label
-- just evaluating quasi quoters to HNF for now -- they
-- being tested everywhere [re|...|] (etc.) calculations
-- are bings used but HPC isn't measuring this
valid_res :: RegexType -> [QuasiQuoter] -> TestTree
= testCase (show rty) . foldr seq (return ())
valid_res rty
pcre_prelude_macros :: [PreludeMacro]
= filter (/= PM_string) [minBound..maxBound]
pcre_prelude_macros
tdfa_prelude_macros :: [PreludeMacro]
= [minBound..maxBound]
tdfa_prelude_macros
s_toList :: S.Seq Char -> [Char]
= F.toList
s_toList
newtype Identity a = Identity { runIdentity :: a }
deriving (Functor)
instance Applicative Identity where
pure = Identity
<*>) (Identity f) (Identity x) = Identity $ f x
(
instance Monad Identity where
return = Identity
>>=) (Identity x) f = f x
(
isValidError :: a -> IO Bool
= catch (x `seq` return False) hdl
isValidError x where
hdl :: SomeException -> IO Bool
= return $ (length $ show se) `seq` True
hdl se
unsafe_find_capture_id :: CaptureID -> CaptureNames -> CaptureOrdinal
= either error id . findCaptureID cid
unsafe_find_capture_id cid
un_maybe :: Maybe a -> a
= maybe (error "urk") id un_maybe