[commit: packages/array] wip/rae: Fix #9220 by adding role annotations. (86225ba)

git at git.haskell.org git at git.haskell.org
Fri Nov 7 23:28:31 UTC 2014


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

On branch  : wip/rae
Link       : http://git.haskell.org/packages/array.git/commitdiff/86225ba71603ed73a338e5f658698fc87aadcae9

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

commit 86225ba71603ed73a338e5f658698fc87aadcae9
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Fri Nov 7 17:30:58 2014 -0500

    Fix #9220 by adding role annotations.


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

86225ba71603ed73a338e5f658698fc87aadcae9
 Data/Array/Base.hs               |  9 +++++++++
 Data/Array/IO/Internals.hs       | 10 +++++++++-
 Data/Array/Storable/Internals.hs |  8 +++++++-
 tests/all.T                      |  2 +-
 4 files changed, 26 insertions(+), 3 deletions(-)

diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs
index 27e69c3..eab6318 100644
--- a/Data/Array/Base.hs
+++ b/Data/Array/Base.hs
@@ -1,4 +1,7 @@
 {-# LANGUAGE BangPatterns, CPP, RankNTypes, MagicHash, UnboxedTuples, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, DeriveDataTypeable, UnliftedFFITypes #-}
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE RoleAnnotations #-}
+#endif
 {-# OPTIONS_HADDOCK hide #-}
 
 -----------------------------------------------------------------------------
@@ -402,6 +405,9 @@ instance IArray Arr.Array e where
 --
 data UArray i e = UArray !i !i !Int ByteArray#
                   deriving Typeable
+#if __GLASGOW_HASKELL__ >= 708
+type role UArray representational nominal
+#endif
 
 {-# INLINE unsafeArrayUArray #-}
 unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
@@ -985,6 +991,9 @@ instance MArray (STArray s) e (Lazy.ST s) where
 -- 'STArray' provides.
 data STUArray s i e = STUArray !i !i !Int (MutableByteArray# s)
                       deriving Typeable
+#if __GLASGOW_HASKELL__ >= 708
+type role STUArray nominal representational nominal
+#endif
 
 instance Eq (STUArray s i e) where
     STUArray _ _ _ arr1# == STUArray _ _ _ arr2# =
diff --git a/Data/Array/IO/Internals.hs b/Data/Array/IO/Internals.hs
index 6761e99..8c8655c 100644
--- a/Data/Array/IO/Internals.hs
+++ b/Data/Array/IO/Internals.hs
@@ -1,4 +1,9 @@
-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses,
+             CPP #-}
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE RoleAnnotations #-}
+#endif
+
 {-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
 -- |
@@ -47,6 +52,9 @@ import GHC.IOArray (IOArray(..))
 --
 newtype IOUArray i e = IOUArray (STUArray RealWorld i e)
                        deriving Typeable
+#if __GLASGOW_HASKELL__ >= 708
+type role IOUArray representational nominal
+#endif
 
 instance Eq (IOUArray i e) where
     IOUArray s1 == IOUArray s2  =  s1 == s2
diff --git a/Data/Array/Storable/Internals.hs b/Data/Array/Storable/Internals.hs
index c844aae..502d569 100644
--- a/Data/Array/Storable/Internals.hs
+++ b/Data/Array/Storable/Internals.hs
@@ -1,4 +1,7 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, CPP #-}
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE RoleAnnotations #-}
+#endif
 {-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
 -- |
@@ -28,6 +31,9 @@ import Foreign hiding (newArray)
 
 -- |The array type
 data StorableArray i e = StorableArray !i !i Int !(ForeignPtr e)
+#if __GLASGOW_HASKELL__ >= 708
+type role StorableArray representational nominal
+#endif
 
 instance Storable e => MArray StorableArray e IO where
     getBounds (StorableArray l u _ _) = return (l,u)
diff --git a/tests/all.T b/tests/all.T
index cd3ae47..c563441 100644
--- a/tests/all.T
+++ b/tests/all.T
@@ -3,4 +3,4 @@ test('T2120', normal, compile_and_run, [''])
 test('largeArray', normal, compile_and_run, [''])
 test('array001',    extra_clean(['array001.data']), compile_and_run, [''])
 
-test('T9220', expect_broken(9220), ghci_script, ['T9220.script'])
+test('T9220', normal, ghci_script, ['T9220.script'])



More information about the ghc-commits mailing list