add tests for addrToAny# levity

2 files changed, 45 insertions, 0 deletions

diff --git a/testsuite/tests/primops/should_compile/LevAddrToAny.hs b/testsuite/tests/primops/should_compile/LevAddrToAny.hs
new file mode 100644
index 0000000000..ff3db69817
--- /dev/null
+++ b/testsuite/tests/primops/should_compile/LevAddrToAny.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE MagicHash, TypeApplications, UnliftedDatatypes, KindSignatures, UnboxedTuples #-}
+
+module LevAddrToAny where
+
+import GHC.Exts
+  ( Int#
+  , Int (I#)
+  , addrToAny#
+  , Addr#
+  , ByteArray#
+  , UnliftedType
+  , proxy#
+  )
+
+import Data.Proxy (Proxy (..))
+import Data.Kind (Type)
+
+
+addrToAnyLifted :: forall (x :: Type). Addr# -> x
+addrToAnyLifted addr = case addrToAny# addr of (# x #) -> x
+
+addrToAnyUnlifted :: forall (x :: UnliftedType). Addr# -> x
+addrToAnyUnlifted addr = case addrToAny# addr of (# x #) -> x
+
+addrToUnit :: Addr# -> ()
+addrToUnit = addrToAnyLifted @()
+
+addrToInt :: Addr# -> Int
+addrToInt = addrToAnyLifted @Int
+
+type UnlUnit :: UnliftedType
+data UnlUnit = UnlUnit
+
+addrToUnlUnit :: Addr# -> UnlUnit
+addrToUnlUnit = addrToAnyUnlifted
+
+type Box :: UnliftedType -> Type
+data Box a = Box a
+
+addrToBoxedUnlUnit :: Addr# -> Box UnlUnit
+addrToBoxedUnlUnit a = Box (addrToAnyUnlifted a)
+
+addrToBoxByteArr :: Addr# -> Box ByteArray#
+addrToBoxByteArr a = Box (addrToAnyUnlifted a)
diff --git a/testsuite/tests/primops/should_compile/all.T b/testsuite/tests/primops/should_compile/all.T
index 5b4dcd82df..82fa474c8b 100644
--- a/testsuite/tests/primops/should_compile/all.T
+++ b/testsuite/tests/primops/should_compile/all.T
@@ -2,6 +2,7 @@ test('T6135_should_compile', normal, compile, [''])
 test('T16293a', normal, compile, [''])
 test('T19851', normal, compile, ['-O'])
 test('LevPolyPtrEquality3', normal, compile, [''])
+test('LevAddrToAny', normal, compile, [''])
 test('UnliftedMutVar_Comp', normal, compile, [''])
 test('UnliftedStableName', normal, compile, [''])
 test('KeepAliveWrapper', normal, compile, ['-O'])