[commit: packages/vector] ghc-head: Add internal checks (6d54109)

git at git.haskell.org git at git.haskell.org
Thu Sep 26 11:54:26 CEST 2013


Repository : ssh://git@git.haskell.org/vector

On branch  : ghc-head
Link       : http://git.haskell.org/packages/vector.git/commitdiff/6d54109c2343b2466f8e5723728c0f9c189b2de7

>---------------------------------------------------------------

commit 6d54109c2343b2466f8e5723728c0f9c189b2de7
Author: Roman Leshchinskiy <rl at cse.unsw.edu.au>
Date:   Sat Oct 6 21:48:17 2012 +0000

    Add internal checks


>---------------------------------------------------------------

6d54109c2343b2466f8e5723728c0f9c189b2de7
 Data/Vector/Fusion/Bundle/Monadic.hs |    8 ++++++--
 Data/Vector/Generic/Mutable.hs       |   10 ++++++----
 2 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/Data/Vector/Fusion/Bundle/Monadic.hs b/Data/Vector/Fusion/Bundle/Monadic.hs
index 4cbe3af..a487d7f 100644
--- a/Data/Vector/Fusion/Bundle/Monadic.hs
+++ b/Data/Vector/Fusion/Bundle/Monadic.hs
@@ -1704,7 +1704,9 @@ fromVectors vs = Bundle (Unf pstep (Left vs))
     vstep :: [v a] -> m (Step [v a] (Chunk v a))
     vstep [] = return Done
     vstep (v:vs) = return $ Yield (Chunk (basicLength v)
-                                         (\mv -> basicUnsafeCopy mv v)) vs
+                                         (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch"
+                                                                       (M.basicLength mv == basicLength v)
+                                                 $ basicUnsafeCopy mv v)) vs
 
 
 concatVectors :: (Monad m, Vector v a) => Bundle m u (v a) -> Bundle m v a
@@ -1732,7 +1734,9 @@ concatVectors Bundle{sElems = Unf step s}
       r <- step s
       case r of
         Yield v s' -> return (Yield (Chunk (basicLength v)
-                                           (\mv -> basicUnsafeCopy mv v)) s')
+                                           (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch"
+                                                                          (M.basicLength mv == basicLength v)
+                                                   $ basicUnsafeCopy mv v)) s')
         Skip    s' -> return (Skip s')
         Done       -> return Done
 
diff --git a/Data/Vector/Generic/Mutable.hs b/Data/Vector/Generic/Mutable.hs
index 6726e64..12d9143 100644
--- a/Data/Vector/Generic/Mutable.hs
+++ b/Data/Vector/Generic/Mutable.hs
@@ -413,9 +413,10 @@ vmunstreamMax s n
       v <- INTERNAL_CHECK(checkLength) "munstreamMax" n
            $ unsafeNew n
       let {-# INLINE_INNER copy #-}
-          copy i (Chunk n f) = do
-                                 f (basicUnsafeSlice i n v)
-                                 return (i+n)
+          copy i (Chunk n f) =
+            INTERNAL_CHECK(checkSlice) "munstreamMax.copy" i n (length v) $ do
+              f (basicUnsafeSlice i n v)
+              return (i+n)
 
       n' <- MBundle.vfoldlM' copy 0 s
       return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n
@@ -438,7 +439,8 @@ vmunstreamUnknown s
           v' <- if basicLength v < j
                   then unsafeGrow v (delay_inline max (enlarge_delta v) (j - basicLength v))
                   else return v
-          f (basicUnsafeSlice i n v')
+          INTERNAL_CHECK(checkSlice) "munstreamUnknown.copy" i n (length v')
+            $ f (basicUnsafeSlice i n v')
           return (v',j)
 
 




More information about the ghc-commits mailing list