Commit 0bab375a authored by Simon Marlow's avatar Simon Marlow

Fix T8761 (#12219, #12077)

parent eb732195
...@@ -6,6 +6,7 @@ module T8761 where ...@@ -6,6 +6,7 @@ module T8761 where
import Control.Monad import Control.Monad
import Language.Haskell.TH import Language.Haskell.TH
import System.IO
data Ex where MkEx :: forall a. a -> Ex data Ex where MkEx :: forall a. a -> Ex
data ExProv where MkExProv :: forall a. (Show a) => a -> ExProv data ExProv where MkExProv :: forall a. (Show a) => a -> ExProv
...@@ -108,4 +109,9 @@ do ...@@ -108,4 +109,9 @@ do
infos <- mapM reify [ 'P, 'Pe, 'Pu, 'Pue, 'Pur, 'Purp infos <- mapM reify [ 'P, 'Pe, 'Pu, 'Pue, 'Pur, 'Purp
, 'Pure, 'Purep, 'Pep, 'Pup, 'Puep ] , 'Pure, 'Purep, 'Pep, 'Pup, 'Puep ]
mapM_ (runIO . putStrLn . pprint) infos mapM_ (runIO . putStrLn . pprint) infos
runIO $ hFlush stdout
-- GHC does not guarantee to do this after TH code. In particular
-- when the output is going to a file, and we're using GHC with
-- the runtime linker or with -fexternal-interpreter, stdout will
-- not get flushed.
[d| theAnswerIs = 42 |] [d| theAnswerIs = 42 |]
pattern Q1 x1_0 x2_1 x3_2 <- ((x1_0, x2_1), [x3_2], _, _) T8761.hs:(16,1)-(39,13): Splicing declarations
pattern x1_0 Q2 x2_1 = ((x1_0, x2_1))
pattern Q3 {qx3, qy3, qz3} <- ((qx3, qy3), [qz3]) where
Q3 qx3 qy3 qz3 = ((qx3, qy3), [qz3])
T8761.hs:(15,1)-(38,13): Splicing declarations
do { [qx1, qy1, qz1] <- mapM do { [qx1, qy1, qz1] <- mapM
(\ i -> newName $ "x" ++ show i) [1, 2, 3]; (\ i -> newName $ "x" ++ show i) [1, 2, 3];
let nm1 = mkName "Q1" let nm1 = mkName "Q1"
...@@ -36,7 +32,7 @@ T8761.hs:(15,1)-(38,13): Splicing declarations ...@@ -36,7 +32,7 @@ T8761.hs:(15,1)-(38,13): Splicing declarations
pattern x1 `Q2` x2 = ((x1, x2)) pattern x1 `Q2` x2 = ((x1, x2))
pattern Q3{qx3, qy3, qz3} <- ((qx3, qy3), [qz3]) where pattern Q3{qx3, qy3, qz3} <- ((qx3, qy3), [qz3]) where
Q3 qx3 qy3 qz3 = ((qx3, qy3), [qz3]) Q3 qx3 qy3 qz3 = ((qx3, qy3), [qz3])
T8761.hs:(41,1)-(45,29): Splicing declarations T8761.hs:(42,1)-(46,29): Splicing declarations
[d| pattern P1 x y z <- ((x, y), [z], _, _) [d| pattern P1 x y z <- ((x, y), [z], _, _)
pattern P2 x y z = ((x, y), [z]) pattern P2 x y z = ((x, y), [z])
pattern P3 x y z <- ((x, y), [z]) where pattern P3 x y z <- ((x, y), [z]) where
...@@ -46,7 +42,7 @@ T8761.hs:(41,1)-(45,29): Splicing declarations ...@@ -46,7 +42,7 @@ T8761.hs:(41,1)-(45,29): Splicing declarations
pattern P2 x y z = ((x, y), [z]) pattern P2 x y z = ((x, y), [z])
pattern P3 x y z <- ((x, y), [z]) where pattern P3 x y z <- ((x, y), [z]) where
P3 x y z = ((x, y), [z]) P3 x y z = ((x, y), [z])
T8761.hs:(48,1)-(52,21): Splicing declarations T8761.hs:(49,1)-(53,21): Splicing declarations
[d| pattern x :*: y <- ((x, _), [y]) [d| pattern x :*: y <- ((x, _), [y])
pattern x :+: y = (x, y) pattern x :+: y = (x, y)
pattern x :~: y <- (x, y) where pattern x :~: y <- (x, y) where
...@@ -56,7 +52,7 @@ T8761.hs:(48,1)-(52,21): Splicing declarations ...@@ -56,7 +52,7 @@ T8761.hs:(48,1)-(52,21): Splicing declarations
pattern x :+: y = (x, y) pattern x :+: y = (x, y)
pattern x :~: y <- (x, y) where pattern x :~: y <- (x, y) where
(:~:) x y = (x, y) (:~:) x y = (x, y)
T8761.hs:(55,1)-(61,23): Splicing declarations T8761.hs:(56,1)-(62,23): Splicing declarations
[d| pattern R1{x1, y1} <- ((x1, _), [y1]) [d| pattern R1{x1, y1} <- ((x1, _), [y1])
getX1 = x1 ((1, 2), [3]) getX1 = x1 ((1, 2), [3])
getY1 = y1 ((1, 2), [3]) getY1 = y1 ((1, 2), [3])
...@@ -70,7 +66,7 @@ T8761.hs:(55,1)-(61,23): Splicing declarations ...@@ -70,7 +66,7 @@ T8761.hs:(55,1)-(61,23): Splicing declarations
pattern R2{x2, y2} = (x2, [y2]) pattern R2{x2, y2} = (x2, [y2])
pattern R3{x3, y3} <- (x3, [y3]) where pattern R3{x3, y3} <- (x3, [y3]) where
R3 x y = (x, [y]) R3 x y = (x, [y])
T8761.hs:(70,1)-(104,39): Splicing declarations T8761.hs:(71,1)-(105,39): Splicing declarations
[d| pattern P :: Bool [d| pattern P :: Bool
pattern P <- True pattern P <- True
pattern Pe :: forall a. a -> Ex pattern Pe :: forall a. a -> Ex
...@@ -123,6 +119,10 @@ T8761.hs:(70,1)-(104,39): Splicing declarations ...@@ -123,6 +119,10 @@ T8761.hs:(70,1)-(104,39): Splicing declarations
pattern Pup x <- MkUnivProv x pattern Pup x <- MkUnivProv x
pattern Puep :: forall a. forall b. Show b => a -> b -> (ExProv, a) pattern Puep :: forall a. forall b. Show b => a -> b -> (ExProv, a)
pattern Puep x y <- (MkExProv y, x) pattern Puep x y <- (MkExProv y, x)
pattern Q1 x1_0 x2_1 x3_2 <- ((x1_0, x2_1), [x3_2], _, _)
pattern x1_0 Q2 x2_1 = ((x1_0, x2_1))
pattern Q3 {qx3, qy3, qz3} <- ((qx3, qy3), [qz3]) where
Q3 qx3 qy3 qz3 = ((qx3, qy3), [qz3])
pattern T8761.P :: GHC.Types.Bool pattern T8761.P :: GHC.Types.Bool
pattern T8761.Pe :: () => forall (a0_0 :: *) . a0_0 -> T8761.Ex pattern T8761.Pe :: () => forall (a0_0 :: *) . a0_0 -> T8761.Ex
pattern T8761.Pu :: forall (a0_0 :: *) . a0_0 -> a0_0 pattern T8761.Pu :: forall (a0_0 :: *) . a0_0 -> a0_0
...@@ -147,12 +147,13 @@ pattern T8761.Pup :: forall (a0_0 :: *) . () => GHC.Show.Show a0_0 => ...@@ -147,12 +147,13 @@ pattern T8761.Pup :: forall (a0_0 :: *) . () => GHC.Show.Show a0_0 =>
a0_0 -> T8761.UnivProv a0_0 a0_0 -> T8761.UnivProv a0_0
pattern T8761.Puep :: forall (a0_0 :: *) . () => forall (b0_1 :: *) . GHC.Show.Show b0_1 => pattern T8761.Puep :: forall (a0_0 :: *) . () => forall (b0_1 :: *) . GHC.Show.Show b0_1 =>
a0_0 -> b0_1 -> (T8761.ExProv, a0_0) a0_0 -> b0_1 -> (T8761.ExProv, a0_0)
T8761.hs:(107,1)-(111,25): Splicing declarations T8761.hs:(108,1)-(117,25): Splicing declarations
do { infos <- mapM do { infos <- mapM
reify reify
['P, 'Pe, 'Pu, 'Pue, 'Pur, 'Purp, 'Pure, 'Purep, 'Pep, 'Pup, ['P, 'Pe, 'Pu, 'Pue, 'Pur, 'Purp, 'Pure, 'Purep, 'Pep, 'Pup,
'Puep]; 'Puep];
mapM_ (runIO . putStrLn . pprint) infos; mapM_ (runIO . putStrLn . pprint) infos;
runIO $ hFlush stdout;
[d| theAnswerIs = 42 |] } [d| theAnswerIs = 42 |] }
======> ======>
theAnswerIs = 42 theAnswerIs = 42
...@@ -406,7 +406,6 @@ test('T11809', normal, compile, ['-v0']) ...@@ -406,7 +406,6 @@ test('T11809', normal, compile, ['-v0'])
test('T11797', normal, compile, ['-v0 -dsuppress-uniques']) test('T11797', normal, compile, ['-v0 -dsuppress-uniques'])
test('T11941', normal, compile_fail, ['-v0']) test('T11941', normal, compile_fail, ['-v0'])
test('T11484', normal, compile, ['-v0']) test('T11484', normal, compile, ['-v0'])
test('T8761', unless(ghc_dynamic(), expect_broken(12077)), compile, test('T8761', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
['-v0 -ddump-splices -dsuppress-uniques'])
test('T12130', extra_clean(['T12130a.hi','T12130a.o']), test('T12130', extra_clean(['T12130a.hi','T12130a.o']),
multimod_compile, ['T12130', '-v0 ' + config.ghc_th_way_flags]) multimod_compile, ['T12130', '-v0 ' + config.ghc_th_way_flags])
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment