Commits

Bryan O'Sullivan  committed 4c578d7

Fix a subtle bug in match grouping.

  • Participants
  • Parent commits e3b2609

Comments (0)

Files changed (3)

File Data/Text/ICU/Regex.hs

   withForeignPtr reRe $ \rePtr ->
     withForeignPtr hayfp $ \hayPtr -> handleError $
       uregex_setText rePtr hayPtr (fromIntegral hayLen)
-  writeIORef reText hayfp
+  writeIORef reText $! H hayfp hayLen
 
 -- | Get the subject text that is currently associated with this
 -- regular expression object.
 getText :: Regex -> IO (ForeignPtr Word16, I16)
-getText Regex{..} =
-  alloca $ \lenPtr -> do
-    _ <- withForeignPtr reRe $ \rePtr -> handleError $
-         uregex_getText rePtr lenPtr
-    len <- peek lenPtr
-    fp <- readIORef reText
-    return (fp, fromIntegral len)
+getText Regex{..} = do
+  H fp len <- readIORef reText
+  return (fp, len)
 
 -- | Return the source form of the pattern used to construct this
 -- regular expression or match.
 {-# INLINE clone #-}
 clone Regex{..} = do
   fp <- newForeignPtr uregex_close =<< withForeignPtr reRe (handleError . uregex_clone)
-  Regex fp `fmap` newIORef emptyForeignPtr
+  Regex fp `fmap` newIORef (H emptyForeignPtr 0)
 
 -- | Return the number of capturing groups in this regular
 -- expression's pattern.

File Data/Text/ICU/Regex/Internal.hsc

     (
     -- * Types
       MatchOption(..)
+    , Haystack(..)
     , Regex(..)
     , URegularExpression
     -- * Functions
     -- process.  A limit is enabled by default.
       deriving (Eq, Show, Typeable)
 
+data Haystack = H (ForeignPtr Word16) {-# UNPACK #-} !T.I16
+
 -- | A compiled regular expression.
 --
 -- 'Regex' values are usually constructed using the 'regex' or
 -- quotes (though this does not allow you to specify any 'Option's).
 data Regex = Regex {
       reRe :: ForeignPtr URegularExpression
-    , reText :: IORef (ForeignPtr Word16)
+    , reText :: IORef Haystack
     }
 
 emptyForeignPtr :: ForeignPtr Word16
   when (stackLimit > -1) .
     handleError $ uregex_setStackLimit ptr (fromIntegral stackLimit)
   touchForeignPtr refp
-  Regex refp `fmap` newIORef hayfp
+  Regex refp `fmap` newIORef (H hayfp 0)
 
 data URegularExpression
 

File Data/Text/ICU/Regex/Pure.hs

 findAll :: Regex -> Text -> [Match]
 findAll re0 haystack = unsafePerformIO . unsafeInterleaveIO $ go 0
   where
-    go !n = matching re0 haystack $ \re -> do
-      f <- IO.find re n
-      if f
+    len = fromIntegral . T.lengthWord16 $ haystack
+    go !n | n >= len  = return []
+          | otherwise = matching re0 haystack $ \re -> do
+      found <- IO.find re n
+      if found
         then do
           n' <- IO.end_ re 0
           (Match re n:) `fmap` go n'
 -- expression or match's pattern.
 groupCount :: Regular r => r -> Int
 groupCount = unsafePerformIO . IO.groupCount . regRe
+{-# INLINE groupCount #-}
 
 -- | A combinator for returning a list of all capturing groups on a
 -- 'Match'.
 grouping n (Match m _) act = unsafePerformIO $ do
   count <- IO.groupCount m
   let n' = fromIntegral n
-  if n < 0 || (n' >= count && count > 0)
-    then return Nothing
-    else Just `fmap` act m
+  if n' == 0 || (n' >= 0 && n' < count)
+    then Just `fmap` act m
+    else return Nothing