summaryrefslogtreecommitdiff
path: root/testsuite/tests
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests')
-rw-r--r--testsuite/tests/typecheck/should_fail/T15067.stderr12
-rw-r--r--testsuite/tests/unboxedsums/T20858.hs26
-rw-r--r--testsuite/tests/unboxedsums/T20858.script5
-rw-r--r--testsuite/tests/unboxedsums/T20858.stdout18
-rw-r--r--testsuite/tests/unboxedsums/T20858b.script5
-rw-r--r--testsuite/tests/unboxedsums/T20858b.stdout52
-rw-r--r--testsuite/tests/unboxedsums/T20859.hs10
-rw-r--r--testsuite/tests/unboxedsums/UnboxedSumsTH.hs12
-rw-r--r--testsuite/tests/unboxedsums/UnboxedSumsTH_Fail.hs13
-rw-r--r--testsuite/tests/unboxedsums/UnboxedSumsTH_Fail.stderr2
-rw-r--r--testsuite/tests/unboxedsums/all.T8
11 files changed, 156 insertions, 7 deletions
diff --git a/testsuite/tests/typecheck/should_fail/T15067.stderr b/testsuite/tests/typecheck/should_fail/T15067.stderr
index a2ecc4326c..a1000205c1 100644
--- a/testsuite/tests/typecheck/should_fail/T15067.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15067.stderr
@@ -1,13 +1,11 @@
T15067.hs:9:14: error:
- • No instance for (Typeable (# GHC.Types.LiftedRep #))
+ • No instance for (Typeable (# | #))
arising from a use of ‘typeRep’
GHC can't yet do polykinded
- Typeable ((# GHC.Types.LiftedRep #) :: *
- -> *
- -> TYPE
- ('GHC.Types.SumRep
- '[GHC.Types.LiftedRep,
- GHC.Types.LiftedRep]))
+ Typeable ((# | #) :: *
+ -> *
+ -> TYPE
+ ('GHC.Types.SumRep '[GHC.Types.LiftedRep, GHC.Types.LiftedRep]))
• In the expression: typeRep
In an equation for ‘floopadoop’: floopadoop = typeRep
diff --git a/testsuite/tests/unboxedsums/T20858.hs b/testsuite/tests/unboxedsums/T20858.hs
new file mode 100644
index 0000000000..cada160764
--- /dev/null
+++ b/testsuite/tests/unboxedsums/T20858.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnboxedSums #-}
+
+module T20858 where
+
+import Data.Kind
+ ( Type )
+import GHC.Exts
+ ( Double#, Int#, Word# )
+
+type GetFunKind :: k -> Type
+type family GetFunKind x where
+ forall arg_k res_k (a :: arg_k -> res_k) (b :: arg_k). GetFunKind (a b) = arg_k -> res_k
+
+type GetFun :: forall res_k. forall (x :: res_k) -> GetFunKind x
+type family GetFun x where
+ GetFun (a b) = a
+
+type S1 = GetFun (# Int# | Double# | Word# #)
+type S2 = GetFun S1
+type S3 = GetFun S2
diff --git a/testsuite/tests/unboxedsums/T20858.script b/testsuite/tests/unboxedsums/T20858.script
new file mode 100644
index 0000000000..ab91eb1444
--- /dev/null
+++ b/testsuite/tests/unboxedsums/T20858.script
@@ -0,0 +1,5 @@
+:seti -XUnboxedSums
+:l T20858
+:kind! S1
+:kind! S2
+:kind! S3
diff --git a/testsuite/tests/unboxedsums/T20858.stdout b/testsuite/tests/unboxedsums/T20858.stdout
new file mode 100644
index 0000000000..2c50fc3e80
--- /dev/null
+++ b/testsuite/tests/unboxedsums/T20858.stdout
@@ -0,0 +1,18 @@
+S1 :: TYPE 'GHC.Types.WordRep
+ -> TYPE
+ ('GHC.Types.SumRep
+ '[ 'GHC.Types.IntRep, 'GHC.Types.DoubleRep, 'GHC.Types.WordRep])
+= (# | | #) Int# Double#
+S2 :: TYPE 'GHC.Types.DoubleRep
+ -> TYPE 'GHC.Types.WordRep
+ -> TYPE
+ ('GHC.Types.SumRep
+ '[ 'GHC.Types.IntRep, 'GHC.Types.DoubleRep, 'GHC.Types.WordRep])
+= (# | | #) Int#
+S3 :: TYPE 'GHC.Types.IntRep
+ -> TYPE 'GHC.Types.DoubleRep
+ -> TYPE 'GHC.Types.WordRep
+ -> TYPE
+ ('GHC.Types.SumRep
+ '[ 'GHC.Types.IntRep, 'GHC.Types.DoubleRep, 'GHC.Types.WordRep])
+= (# | | #)
diff --git a/testsuite/tests/unboxedsums/T20858b.script b/testsuite/tests/unboxedsums/T20858b.script
new file mode 100644
index 0000000000..ab91eb1444
--- /dev/null
+++ b/testsuite/tests/unboxedsums/T20858b.script
@@ -0,0 +1,5 @@
+:seti -XUnboxedSums
+:l T20858
+:kind! S1
+:kind! S2
+:kind! S3
diff --git a/testsuite/tests/unboxedsums/T20858b.stdout b/testsuite/tests/unboxedsums/T20858b.stdout
new file mode 100644
index 0000000000..e9818ad468
--- /dev/null
+++ b/testsuite/tests/unboxedsums/T20858b.stdout
@@ -0,0 +1,52 @@
+S1 :: TYPE 'GHC.Types.WordRep
+ -> TYPE
+ ('GHC.Types.SumRep
+ ((':)
+ @GHC.Types.RuntimeRep
+ 'GHC.Types.IntRep
+ ((':)
+ @GHC.Types.RuntimeRep
+ 'GHC.Types.DoubleRep
+ ((':)
+ @GHC.Types.RuntimeRep
+ 'GHC.Types.WordRep
+ ('[] @GHC.Types.RuntimeRep)))))
+= (# | | #)
+ @'GHC.Types.IntRep
+ @'GHC.Types.DoubleRep
+ @'GHC.Types.WordRep
+ Int#
+ Double#
+S2 :: TYPE 'GHC.Types.DoubleRep
+ -> TYPE 'GHC.Types.WordRep
+ -> TYPE
+ ('GHC.Types.SumRep
+ ((':)
+ @GHC.Types.RuntimeRep
+ 'GHC.Types.IntRep
+ ((':)
+ @GHC.Types.RuntimeRep
+ 'GHC.Types.DoubleRep
+ ((':)
+ @GHC.Types.RuntimeRep
+ 'GHC.Types.WordRep
+ ('[] @GHC.Types.RuntimeRep)))))
+= (# | | #)
+ @'GHC.Types.IntRep @'GHC.Types.DoubleRep @'GHC.Types.WordRep Int#
+S3 :: TYPE 'GHC.Types.IntRep
+ -> TYPE 'GHC.Types.DoubleRep
+ -> TYPE 'GHC.Types.WordRep
+ -> TYPE
+ ('GHC.Types.SumRep
+ ((':)
+ @GHC.Types.RuntimeRep
+ 'GHC.Types.IntRep
+ ((':)
+ @GHC.Types.RuntimeRep
+ 'GHC.Types.DoubleRep
+ ((':)
+ @GHC.Types.RuntimeRep
+ 'GHC.Types.WordRep
+ ('[] @GHC.Types.RuntimeRep)))))
+= (# | | #)
+ @'GHC.Types.IntRep @'GHC.Types.DoubleRep @'GHC.Types.WordRep
diff --git a/testsuite/tests/unboxedsums/T20859.hs b/testsuite/tests/unboxedsums/T20859.hs
new file mode 100644
index 0000000000..5e7c14bab1
--- /dev/null
+++ b/testsuite/tests/unboxedsums/T20859.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedSums #-}
+
+module T20859 where
+
+import GHC.Exts
+ ( Double#, Int#, Word# )
+
+foo :: (# Int# | Double# | Word# #) -> (# | | #) Int# Double# Word#
+foo x = x
diff --git a/testsuite/tests/unboxedsums/UnboxedSumsTH.hs b/testsuite/tests/unboxedsums/UnboxedSumsTH.hs
new file mode 100644
index 0000000000..5bf912bc11
--- /dev/null
+++ b/testsuite/tests/unboxedsums/UnboxedSumsTH.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UnboxedSums #-}
+
+module UnboxedSumsTH where
+
+import Data.Proxy
+import Language.Haskell.TH
+
+-- Check that we can quote the type constructor (# | #).
+testTC :: Proxy (# | #)
+testTC = $( conE 'Proxy `appTypeE` conT ''(# | #) )
diff --git a/testsuite/tests/unboxedsums/UnboxedSumsTH_Fail.hs b/testsuite/tests/unboxedsums/UnboxedSumsTH_Fail.hs
new file mode 100644
index 0000000000..46ed1c13c1
--- /dev/null
+++ b/testsuite/tests/unboxedsums/UnboxedSumsTH_Fail.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UnboxedSums #-}
+
+module UnboxedSumsTH_Fail where
+
+import Data.Proxy
+import Language.Haskell.TH
+
+-- (# | #) is not a valid data constructor,
+-- as it doesn't indicate which alternative we are taking.
+testDC :: (# Integer | Bool #)
+testDC = $( conE '(# | #) `appE` litE (IntegerL 77) )
diff --git a/testsuite/tests/unboxedsums/UnboxedSumsTH_Fail.stderr b/testsuite/tests/unboxedsums/UnboxedSumsTH_Fail.stderr
new file mode 100644
index 0000000000..d8b7f25bd8
--- /dev/null
+++ b/testsuite/tests/unboxedsums/UnboxedSumsTH_Fail.stderr
@@ -0,0 +1,2 @@
+
+UnboxedSumsTH_Fail.hs:13:22: error: parse error on input ‘|’
diff --git a/testsuite/tests/unboxedsums/all.T b/testsuite/tests/unboxedsums/all.T
index c3cf9f1559..ba25543d54 100644
--- a/testsuite/tests/unboxedsums/all.T
+++ b/testsuite/tests/unboxedsums/all.T
@@ -17,6 +17,9 @@ test('unboxedsums10', omit_ways(['ghci']), compile_and_run, [''])
test('unboxedsums11', omit_ways(['ghci']), compile_and_run, [''])
test('unboxedsums12', omit_ways(['ghci']), compile, [''])
+test('UnboxedSumsTH', omit_ways(['ghci']), compile, [''])
+test('UnboxedSumsTH_Fail', omit_ways(['ghci']), compile_fail, [''])
+
test('ffi1', normal, compile_fail, [''])
test('thunk', only_ways(['normal']), compile_and_run, [''])
test('T12375', only_ways(['normal']), compile_and_run, [''])
@@ -27,3 +30,8 @@ test('T12711', only_ways(['ghci']), ghci_script, ['T12711.script'])
test('UbxSumLevPoly', normal, compile, ['-Wno-overlapping-patterns'])
test('T14051', normal, multi_compile, ['T14051.hs', [('T14051a.hs', '')], '-O2 -v0'])
test('T19645', normal, compile_and_run, [''])
+test('T20858', normal, ghci_script, ['T20858.script'])
+test('T20858b', [extra_files(['T20858.hs'])
+ ,extra_hc_opts("-fprint-explicit-runtime-reps -fprint-explicit-kinds")]
+ , ghci_script, ['T20858b.script'])
+test('T20859', normal, compile, [''])
View Lorry Controller Status