summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2018-02-06 17:33:21 -0500
committerBen Gamari <ben@smart-cactus.org>2018-02-06 17:33:21 -0500
commitda4681303892804ea08b60bfd47cbb82ca8e6589 (patch)
tree85b97a9a25f1ee3fde84eb2bd8a421804c091a8a
parent00f1a4ab80b201ce15c509126f89c5a108786f32 (diff)
downloadhaskell-da4681303892804ea08b60bfd47cbb82ca8e6589.tar.gz
testsuite: Add test for #14768
-rw-r--r--testsuite/tests/simplCore/should_run/T14768.hs59
-rw-r--r--testsuite/tests/simplCore/should_run/all.T1
2 files changed, 60 insertions, 0 deletions
diff --git a/testsuite/tests/simplCore/should_run/T14768.hs b/testsuite/tests/simplCore/should_run/T14768.hs
new file mode 100644
index 0000000000..116cb825cb
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T14768.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Main where
+
+import Control.Monad (forM_, liftM)
+import qualified Data.Vector.Generic as G
+import qualified Data.Vector.Generic.Mutable as M
+import qualified Data.Vector.Primitive as P
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as MU
+import GHC.Exts
+
+vec :: U.Vector Moebius
+vec = U.singleton Moebius0
+
+main :: IO ()
+main = print $ U.head vec == U.head vec
+
+data Moebius = Moebius0 | Moebius1 | Moebius2
+ deriving (Eq)
+
+fromMoebius :: Moebius -> Int
+fromMoebius Moebius0 = 0
+fromMoebius Moebius1 = 1
+fromMoebius Moebius2 = 2
+
+toMoebius :: Int -> Moebius
+toMoebius (I# i#) = tagToEnum# i#
+
+newtype instance U.MVector s Moebius = MV_Moebius (P.MVector s Int)
+newtype instance U.Vector Moebius = V_Moebius (P.Vector Int)
+
+instance U.Unbox Moebius
+
+instance M.MVector U.MVector Moebius where
+ basicLength (MV_Moebius v) = M.basicLength v
+ basicUnsafeSlice i n (MV_Moebius v) = MV_Moebius $ M.basicUnsafeSlice i n v
+ basicOverlaps (MV_Moebius v1) (MV_Moebius v2) = M.basicOverlaps v1 v2
+ basicUnsafeNew n = MV_Moebius `liftM` M.basicUnsafeNew n
+ basicInitialize (MV_Moebius v) = M.basicInitialize v
+ basicUnsafeReplicate n x = MV_Moebius `liftM` M.basicUnsafeReplicate n (fromMoebius x)
+ basicUnsafeRead (MV_Moebius v) i = toMoebius `liftM` M.basicUnsafeRead v i
+ basicUnsafeWrite (MV_Moebius v) i x = M.basicUnsafeWrite v i (fromMoebius x)
+ basicClear (MV_Moebius v) = M.basicClear v
+ basicSet (MV_Moebius v) x = M.basicSet v (fromMoebius x)
+ basicUnsafeCopy (MV_Moebius v1) (MV_Moebius v2) = M.basicUnsafeCopy v1 v2
+ basicUnsafeMove (MV_Moebius v1) (MV_Moebius v2) = M.basicUnsafeMove v1 v2
+ basicUnsafeGrow (MV_Moebius v) n = MV_Moebius `liftM` M.basicUnsafeGrow v n
+
+instance G.Vector U.Vector Moebius where
+ basicUnsafeFreeze (MV_Moebius v) = V_Moebius `liftM` G.basicUnsafeFreeze v
+ basicUnsafeThaw (V_Moebius v) = MV_Moebius `liftM` G.basicUnsafeThaw v
+ basicLength (V_Moebius v) = G.basicLength v
+ basicUnsafeSlice i n (V_Moebius v) = V_Moebius $ G.basicUnsafeSlice i n v
+ basicUnsafeIndexM (V_Moebius v) i = toMoebius `liftM` G.basicUnsafeIndexM v i
+ basicUnsafeCopy (MV_Moebius mv) (V_Moebius v) = G.basicUnsafeCopy mv v
+ elemseq _ = seq
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index 4ba5a71e94..d922f90e75 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -78,3 +78,4 @@ test('T13429', normal, compile_and_run, [''])
test('T13429_2', normal, compile_and_run, [''])
test('T13750', normal, compile_and_run, [''])
test('T14178', normal, compile_and_run, [''])
+test('T14768', reqlib('vector'), compile_and_run, [''])