From 3a3fc3061eaeea44db33499aa7c40480dcd5ffe4 Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Sun, 19 Jul 2009 15:29:31 +0000
Subject: [PATCH] Improve the index checking for array accesses; fixes #2120
#2669 As well as checking that offset we are reading is actually inside the
array, we now also check that it is "in range" as defined by the Ix instance.
This fixes confusing behaviour (#2120) and improves some error messages
(#2669).
---
Data/Array/Base.hs | 5 +++--
tests/Makefile | 7 +++++++
tests/T2120.hs | 17 +++++++++++++++++
tests/T2120.stdout | 2 ++
tests/all.T | 3 +++
5 files changed, 32 insertions(+), 2 deletions(-)
create mode 100644 tests/Makefile
create mode 100644 tests/T2120.hs
create mode 100644 tests/T2120.stdout
create mode 100644 tests/all.T
diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs
index f9cc0c5b..52e4c18d 100644
--- a/Data/Array/Base.hs
+++ b/Data/Array/Base.hs
@@ -108,10 +108,11 @@ safeRangeSize (l,u) = let r = rangeSize (l, u)
{-# INLINE safeIndex #-}
safeIndex :: Ix i => (i, i) -> Int -> i -> Int
-safeIndex (l,u) n i = let i' = unsafeIndex (l,u) i
+safeIndex (l,u) n i = let i' = index (l,u) i
in if (0 <= i') && (i' < n)
then i'
- else error "Error in array index"
+ else error ("Error in array index; " ++ show i' ++
+ " not in range [0.." ++ show n ++ ")")
{-# INLINE unsafeReplaceST #-}
unsafeReplaceST :: (IArray a e, Ix i) => a i e -> [(Int, e)] -> ST s (STArray s i e)
diff --git a/tests/Makefile b/tests/Makefile
new file mode 100644
index 00000000..6a0abcf1
--- /dev/null
+++ b/tests/Makefile
@@ -0,0 +1,7 @@
+# This Makefile runs the tests using GHC's testsuite framework. It
+# assumes the package is part of a GHC build tree with the testsuite
+# installed in ../../../testsuite.
+
+TOP=../../../testsuite
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/tests/T2120.hs b/tests/T2120.hs
new file mode 100644
index 00000000..82150ef1
--- /dev/null
+++ b/tests/T2120.hs
@@ -0,0 +1,17 @@
+
+module Main (main) where
+
+import Control.Exception
+import Data.Array.IArray
+import Prelude hiding (catch)
+
+a :: Array Int Int
+a = listArray (1,4) [1..4]
+
+b :: Array (Int,Int) Int
+b = listArray ((0,0), (3,3)) (repeat 0)
+
+main :: IO ()
+main = do print (a ! 5) `catch` \e -> print (e :: SomeException)
+ print (b ! (0,5)) `catch` \e -> print (e :: SomeException)
+
diff --git a/tests/T2120.stdout b/tests/T2120.stdout
new file mode 100644
index 00000000..518a3e88
--- /dev/null
+++ b/tests/T2120.stdout
@@ -0,0 +1,2 @@
+Ix{Int}.index: Index (5) out of range ((1,4))
+Error in array index
diff --git a/tests/all.T b/tests/all.T
new file mode 100644
index 00000000..9814b76d
--- /dev/null
+++ b/tests/all.T
@@ -0,0 +1,3 @@
+
+test('T2120', normal, compile_and_run, [''])
+
--
GitLab