summaryrefslogtreecommitdiff
path: root/testsuite/tests
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests')
-rw-r--r--testsuite/tests/codeGen/should_fail/T13233.hs7
-rw-r--r--testsuite/tests/codeGen/should_fail/T13233.stderr12
-rw-r--r--testsuite/tests/codeGen/should_fail/T13233_elab.hs10
-rw-r--r--testsuite/tests/codeGen/should_fail/T13233_elab.stderr10
-rw-r--r--testsuite/tests/typecheck/should_compile/T17817b.hs21
-rw-r--r--testsuite/tests/typecheck/should_compile/all.T1
-rw-r--r--testsuite/tests/typecheck/should_fail/T17817.hs16
-rw-r--r--testsuite/tests/typecheck/should_fail/T17817.stderr13
-rw-r--r--testsuite/tests/typecheck/should_fail/T17817_elab.hs17
-rw-r--r--testsuite/tests/typecheck/should_fail/T17817_elab.stderr10
-rw-r--r--testsuite/tests/typecheck/should_fail/all.T2
11 files changed, 82 insertions, 37 deletions
diff --git a/testsuite/tests/codeGen/should_fail/T13233.hs b/testsuite/tests/codeGen/should_fail/T13233.hs
index f24fc03bfb..c4c0480a75 100644
--- a/testsuite/tests/codeGen/should_fail/T13233.hs
+++ b/testsuite/tests/codeGen/should_fail/T13233.hs
@@ -5,7 +5,7 @@
{-# LANGUAGE MagicHash #-}
module Bug where
-import GHC.Exts (TYPE, RuntimeRep, Weak#, State#, RealWorld, mkWeak# )
+import GHC.Exts ( TYPE, RuntimeRep )
class Foo (a :: TYPE rep) where
bar :: forall rep2 (b :: TYPE rep2). (a -> a -> b) -> a -> a -> b
@@ -20,8 +20,3 @@ obscure _ = ()
quux :: ()
quux = obscure (#,#)
-
-primop :: forall (rep :: RuntimeRep) (a :: TYPE rep) b c.
- a -> b -> (State# RealWorld -> (# State# RealWorld, c #))
- -> State# RealWorld -> (# State# RealWorld, Weak# b #)
-primop = mkWeak#
diff --git a/testsuite/tests/codeGen/should_fail/T13233.stderr b/testsuite/tests/codeGen/should_fail/T13233.stderr
index 0208b2695a..2609e41d97 100644
--- a/testsuite/tests/codeGen/should_fail/T13233.stderr
+++ b/testsuite/tests/codeGen/should_fail/T13233.stderr
@@ -18,15 +18,3 @@ T13233.hs:22:16: error:
Levity-polymorphic arguments:
a :: TYPE rep1
b :: TYPE rep2
-
-T13233.hs:27:10: error:
- Cannot use function with levity-polymorphic arguments:
- mkWeak# :: a
- -> b
- -> (State# RealWorld -> (# State# RealWorld, c #))
- -> State# RealWorld
- -> (# State# RealWorld, Weak# b #)
- (Note that levity-polymorphic primops such as 'coerce' and unboxed tuples
- are eta-expanded internally because they must occur fully saturated.
- Use -fprint-typechecker-elaboration to display the full expression.)
- Levity-polymorphic arguments: a :: TYPE rep
diff --git a/testsuite/tests/codeGen/should_fail/T13233_elab.hs b/testsuite/tests/codeGen/should_fail/T13233_elab.hs
index 8f62332af6..96adc5ff9a 100644
--- a/testsuite/tests/codeGen/should_fail/T13233_elab.hs
+++ b/testsuite/tests/codeGen/should_fail/T13233_elab.hs
@@ -8,7 +8,7 @@
{-# LANGUAGE MagicHash #-}
module Bug where
-import GHC.Exts (TYPE, RuntimeRep, Weak#, State#, RealWorld, mkWeak# )
+import GHC.Exts ( TYPE, RuntimeRep )
class Foo (a :: TYPE rep) where
bar :: forall rep2 (b :: TYPE rep2). (a -> a -> b) -> a -> a -> b
@@ -23,11 +23,3 @@ obscure _ = ()
quux :: ()
quux = obscure (#,#)
-
--- It used to be that primops has no binding. However, as described in
--- Note [Primop wrappers] in GHC.Builtin.PrimOps we now rewrite unsaturated primop
--- applications to their wrapper, which allows safe use of levity polymorphism.
-primop :: forall (rep :: RuntimeRep) (a :: TYPE rep) b c.
- a -> b -> (State# RealWorld -> (# State# RealWorld, c #))
- -> State# RealWorld -> (# State# RealWorld, Weak# b #)
-primop = mkWeak#
diff --git a/testsuite/tests/codeGen/should_fail/T13233_elab.stderr b/testsuite/tests/codeGen/should_fail/T13233_elab.stderr
index ec9a04d726..1b84b9bf95 100644
--- a/testsuite/tests/codeGen/should_fail/T13233_elab.stderr
+++ b/testsuite/tests/codeGen/should_fail/T13233_elab.stderr
@@ -12,13 +12,3 @@ T13233_elab.hs:25:16: error:
Levity-polymorphic arguments:
a :: TYPE rep1
b :: TYPE rep2
-
-T13233_elab.hs:33:10: error:
- Cannot use function with levity-polymorphic arguments:
- mkWeak# @rep @a @b @c
- :: a
- -> b
- -> (State# RealWorld -> (# State# RealWorld, c #))
- -> State# RealWorld
- -> (# State# RealWorld, Weak# b #)
- Levity-polymorphic arguments: a :: TYPE rep
diff --git a/testsuite/tests/typecheck/should_compile/T17817b.hs b/testsuite/tests/typecheck/should_compile/T17817b.hs
new file mode 100644
index 0000000000..b4fac8ba87
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T17817b.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE TypeApplications #-}
+module Bug where
+
+import GHC.Exts ( Weak#, State#, RealWorld, mkWeak# )
+import GHC.Types ( UnliftedType )
+
+primop1 :: forall a b c.
+ a -> b -> (State# RealWorld -> (# State# RealWorld, c #))
+ -> State# RealWorld -> (# State# RealWorld, Weak# b #)
+primop1 = mkWeak# @a @b @c
+
+primop2 :: forall (a :: UnliftedType) b c.
+ a -> b -> (State# RealWorld -> (# State# RealWorld, c #))
+ -> State# RealWorld -> (# State# RealWorld, Weak# b #)
+primop2 = mkWeak# @a @b @c
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 7ebb9ae65c..8183fe06a7 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -789,3 +789,4 @@ test('T19742', normal, compile, [''])
test('T18481', normal, compile, [''])
test('T18481a', normal, compile, [''])
test('T19775', normal, compile, [''])
+test('T17817b', normal, compile, [''])
diff --git a/testsuite/tests/typecheck/should_fail/T17817.hs b/testsuite/tests/typecheck/should_fail/T17817.hs
new file mode 100644
index 0000000000..b87178f909
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17817.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE MagicHash #-}
+module Bug where
+
+import GHC.Exts ( TYPE, RuntimeRep(BoxedRep), Levity
+ , Weak#, State#, RealWorld, mkWeak#
+ )
+
+primop :: forall (l :: Levity) (a :: TYPE ('BoxedRep l)) b c.
+ a -> b -> (State# RealWorld -> (# State# RealWorld, c #))
+ -> State# RealWorld -> (# State# RealWorld, Weak# b #)
+primop = mkWeak#
diff --git a/testsuite/tests/typecheck/should_fail/T17817.stderr b/testsuite/tests/typecheck/should_fail/T17817.stderr
new file mode 100644
index 0000000000..56753cb34b
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17817.stderr
@@ -0,0 +1,13 @@
+
+T17817.hs:16:10: error:
+ Cannot use function with levity-polymorphic arguments:
+ mkWeak#
+ :: a
+ -> b
+ -> (State# RealWorld -> (# State# RealWorld, c #))
+ -> State# RealWorld
+ -> (# State# RealWorld, Weak# b #)
+ (Note that levity-polymorphic primops such as 'coerce' and unboxed tuples
+ are eta-expanded internally because they must occur fully saturated.
+ Use -fprint-typechecker-elaboration to display the full expression.)
+ Levity-polymorphic arguments: a :: TYPE ('BoxedRep l)
diff --git a/testsuite/tests/typecheck/should_fail/T17817_elab.hs b/testsuite/tests/typecheck/should_fail/T17817_elab.hs
new file mode 100644
index 0000000000..7c0b09a98c
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17817_elab.hs
@@ -0,0 +1,17 @@
+-- Same as T17817, but we compile with -fprint-typechecker-elaboration.
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE MagicHash #-}
+module Bug where
+
+import GHC.Exts ( TYPE, RuntimeRep(BoxedRep), Levity
+ , Weak#, State#, RealWorld, mkWeak#
+ )
+
+primop :: forall (l :: Levity) (a :: TYPE ('BoxedRep l)) b c.
+ a -> b -> (State# RealWorld -> (# State# RealWorld, c #))
+ -> State# RealWorld -> (# State# RealWorld, Weak# b #)
+primop = mkWeak#
diff --git a/testsuite/tests/typecheck/should_fail/T17817_elab.stderr b/testsuite/tests/typecheck/should_fail/T17817_elab.stderr
new file mode 100644
index 0000000000..aaa48448d2
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17817_elab.stderr
@@ -0,0 +1,10 @@
+
+T17817_elab.hs:17:10: error:
+ Cannot use function with levity-polymorphic arguments:
+ mkWeak# @l @a @b @c
+ :: a
+ -> b
+ -> (State# RealWorld -> (# State# RealWorld, c #))
+ -> State# RealWorld
+ -> (# State# RealWorld, Weak# b #)
+ Levity-polymorphic arguments: a :: TYPE ('BoxedRep l)
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 65f80a1e13..54af02c6f5 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -629,3 +629,5 @@ test('T19397E4', extra_files(['T19397S.hs']), multimod_compile_fail,
['T19397E4.hs', '-v0 -main-is foo'])
test('T19415', normal, compile_fail, [''])
test('T19615', normal, compile_fail, [''])
+test('T17817', normal, compile_fail, [''])
+test('T17817_elab', normal, compile_fail, ['-fprint-typechecker-elaboration'])
View Lorry Controller Status