Add tests; extended patterns.

Author: galenhuntington

Base.hs

@@ -30,7 +30,7 @@ import System.IO as X (Handle, hClose)
 import System.IO.Unsafe as X
 import Text.Printf as X
 import Text.Read as X (readMaybe)
-import Text.Regex.Posix (match, makeRegexOptsM, compIgnoreCase)
+import Text.Regex.Posix (match, makeRegexOptsM, compIgnoreCase, compExtended)
 
 import System.Clock
 
@@ -81,9 +81,8 @@ matches s =
 -}
 
 -- regex-posix version (reputed to be slow and buggy)
-matches s = case makeRegexOptsM compIgnoreCase 0 s of
-    Just p -> match p
-    _      -> const False
+matches s = maybe (const False) match $
+    makeRegexOptsM (compIgnoreCase + compExtended) 0 s
 
 -- not yet tried:
 -- regex-tdfa (mass Text conversion, parsec dep) text import

hmp3-ng.cabal

@@ -99,6 +99,7 @@ test-suite test
   main-is: Main.hs
   hs-source-dirs: test
   other-modules:
+    BaseSpec
     ConfigSpec
     CoreSpec
     DecoderSpec

test/BaseSpec.hs

@@ -0,0 +1,30 @@
+module BaseSpec (tests) where
+
+import Data.ByteString.UTF8 qualified as UTF8
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import Base (matches)
+
+tests :: TestTree
+tests = testGroup "Base"
+    [ testGroup "match"
+        [ t True "exact"         "foo"       "fooBar"
+        , t True "caseless"      "FOO"       "fooBar"
+        , t False "invalid"      "["         "any[thing"
+        , t True "alt"           "(foo|az)Q" "bazQux"
+        , t True "dot"           "o.a"       "foobar"
+        , t True "Unicode"       "jör"       "Björk"
+        , t True "dot Unicode"   "j.r"       "Björk"
+        , t True "Nordic case"   "bør"       "BØrnE"
+        , t True "Greek case"    "Λω"        "ΦλΩα"
+        , t True "dot CJK"       "中.人"     "中國人"
+        ]
+    ]
+
+
+t :: Bool -> String -> String -> String -> TestTree
+t b tag pat str =
+    testCase tag $ matches (UTF8.fromString pat) (UTF8.fromString str) @?= b
+

test/Main.hs

@@ -2,6 +2,7 @@ module Main (main) where
 
 import Test.Tasty
 
+import BaseSpec qualified
 import ConfigSpec qualified
 import CoreSpec qualified
 import DecoderSpec qualified
@@ -11,7 +12,8 @@ import WidthSpec qualified
 
 main :: IO ()
 main = defaultMain $ testGroup "hmp3-ng"
-    [ ConfigSpec.tests
+    [ BaseSpec.tests
+    , ConfigSpec.tests
     , CoreSpec.tests
     , DecoderSpec.tests
     , StyleSpec.tests