6 files changed, 107 insertions, 2 deletions
diff --git a/testsuite/tests/th/T15843.hs b/testsuite/tests/th/T15843.hs
new file mode 100644
index 0000000000..9f807a8cb6
--- /dev/null
+++ b/testsuite/tests/th/T15843.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE UnboxedTuples #-}
+module Main where
+
+import Language.Haskell.TH
+
+import T15843a
+
+ppr_and_show a = print a >> (putStrLn $ pprint a)
+
+main :: IO ()
+main = do
+  mapM_ (\q -> runQ q >>= ppr_and_show)
+        [first_of_2, second_of_2, empty_2, full_2, third_of_3]
+
+  mapM_ (\q -> runQ (fmap unType q) >>= ppr_and_show)
+        [first_of_2_T, second_of_2_T]
+
+  runQ (fmap unType empty_2_T) >>= ppr_and_show
+  runQ (fmap unType full_2_T) >>= ppr_and_show
+  runQ (fmap unType third_of_3_T) >>= ppr_and_show
+
+  print $ "(909,) applied to 'c' should be (909, 'c') ===> "
+            ++ (show $ (909, 'c') == ($first_of_2 'c'))
+
+  print $ "(,909) applied to False should be (False, 909) ===> "
+            ++ (show $ (False, 909) == ($second_of_2 False))
+
+  print $ "(,,909) applied to 606 and True should be (606, True, 909) ===> "
+            ++ (show $ (606, True, 909) == ($third_of_3 606 True))
+
+  mapM_ (\q -> runQ q >>= ppr_and_show)
+        [unb0, unb1, unb2, unb3, unb4]
diff --git a/testsuite/tests/th/T15843.stdout b/testsuite/tests/th/T15843.stdout
new file mode 100644
index 0000000000..b7fede7e46
--- /dev/null
+++ b/testsuite/tests/th/T15843.stdout
@@ -0,0 +1,33 @@
+TupE [Just (LitE (IntegerL 909)),Nothing]
+(909,)
+TupE [Nothing,Just (LitE (IntegerL 909))]
+(, 909)
+ConE GHC.Tuple.(,)
+GHC.Tuple.(,)
+TupE [Just (LitE (IntegerL 909)),Just (LitE (IntegerL 606))]
+(909, 606)
+TupE [Nothing,Nothing,Just (LitE (IntegerL 909))]
+(, , 909)
+TupE [Just (LitE (IntegerL 909)),Nothing]
+(909,)
+TupE [Nothing,Just (LitE (IntegerL 909))]
+(, 909)
+ConE GHC.Tuple.(,)
+GHC.Tuple.(,)
+TupE [Just (LitE (IntegerL 909)),Just (LitE (IntegerL 606))]
+(909, 606)
+TupE [Nothing,Nothing,Just (LitE (IntegerL 909))]
+(, , 909)
+"(909,) applied to 'c' should be (909, 'c') ===> True"
+"(,909) applied to False should be (False, 909) ===> True"
+"(,,909) applied to 606 and True should be (606, True, 909) ===> True"
+ConE GHC.Prim.(#,#)
+GHC.Prim.(#,#)
+UnboxedTupE [Just (LitE (CharL 'c')),Just (ConE GHC.Types.False)]
+(# 'c', GHC.Types.False #)
+UnboxedTupE [Just (LitE (CharL 'c')),Nothing]
+(# 'c', #)
+UnboxedTupE [Nothing,Just (ConE GHC.Types.False)]
+(# , GHC.Types.False #)
+AppE (UnboxedTupE [Nothing,Just (ConE GHC.Types.False)]) (LitE (CharL 'c'))
+(# , GHC.Types.False #) 'c'
diff --git a/testsuite/tests/th/T15843a.hs b/testsuite/tests/th/T15843a.hs
new file mode 100644
index 0000000000..2f413fd2c1
--- /dev/null
+++ b/testsuite/tests/th/T15843a.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE UnboxedTuples #-}
+module T15843a where
+
+import Language.Haskell.TH
+
+first_of_2 = [| (909,) |]
+
+second_of_2 = [| (,909) |]
+
+empty_2 = [| (,) |]
+
+full_2 = [| (909,606) |]
+
+third_of_3 = [| (,,909) |]
+
+first_of_2_T = [|| (909,) ||]
+
+second_of_2_T = [|| (,909) ||]
+
+empty_2_T = [|| (,) ||]
+
+full_2_T = [|| (909,606) ||]
+
+third_of_3_T = [|| (,,909) ||]
+
+unb0 = [| (# , #) |]
+
+unb1 = [| (# 'c', False #) |]
+
+unb2  = [| (# 'c', #) |]
+
+unb3 = [| (# ,False #) |]
+
+unb4 = [| (# ,False #) 'c' |]
diff --git a/testsuite/tests/th/T3899a.hs b/testsuite/tests/th/T3899a.hs
index 73ed534786..a63c17b0d3 100644
--- a/testsuite/tests/th/T3899a.hs
+++ b/testsuite/tests/th/T3899a.hs
@@ -12,4 +12,4 @@ nestedTuple n = do
      xs <- replicateM n (newName "x")
      return $ LamE [foldr (\v prev -> ParensP (ConP 'Cons [VarP v,prev]))
                        (ConP 'Nil []) xs]
-                   (TupE $ map VarE xs)
+                   (TupE $ map (Just . VarE) xs)
diff --git a/testsuite/tests/th/TH_repUnboxedTuples.stderr b/testsuite/tests/th/TH_repUnboxedTuples.stderr
index 45cb29cdef..5b1f2b386e 100644
--- a/testsuite/tests/th/TH_repUnboxedTuples.stderr
+++ b/testsuite/tests/th/TH_repUnboxedTuples.stderr
@@ -1,4 +1,4 @@
-CaseE (UnboxedTupE [LitE (CharL 'b'),ConE GHC.Types.False]) [Match (UnboxedTupP [LitP (CharL 'a'),ConP GHC.Types.True []]) (NormalB (UnboxedTupE [LitE (StringL "One"),LitE (IntegerL 1)])) [],Match (UnboxedTupP [LitP (CharL 'b'),ConP GHC.Types.False []]) (NormalB (UnboxedTupE [LitE (StringL "Two"),LitE (IntegerL 2)])) [],Match (UnboxedTupP [WildP,WildP]) (NormalB (UnboxedTupE [LitE (StringL "Three"),LitE (IntegerL 3)])) []]
+CaseE (UnboxedTupE [Just (LitE (CharL 'b')),Just (ConE GHC.Types.False)]) [Match (UnboxedTupP [LitP (CharL 'a'),ConP GHC.Types.True []]) (NormalB (UnboxedTupE [Just (LitE (StringL "One")),Just (LitE (IntegerL 1))])) [],Match (UnboxedTupP [LitP (CharL 'b'),ConP GHC.Types.False []]) (NormalB (UnboxedTupE [Just (LitE (StringL "Two")),Just (LitE (IntegerL 2))])) [],Match (UnboxedTupP [WildP,WildP]) (NormalB (UnboxedTupE [Just (LitE (StringL "Three")),Just (LitE (IntegerL 3))])) []]
 case (# 'b', GHC.Types.False #) of
     (# 'a', GHC.Types.True #) -> (# "One", 1 #)
     (# 'b', GHC.Types.False #) -> (# "Two", 2 #)
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 73b4cf48c3..def7a843c8 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -461,6 +461,9 @@ test('T15783', normal, multimod_compile,
 test('T15792', normal, compile, ['-v0 -dsuppress-uniques'])
 test('T15815', normal, multimod_compile,
     ['T15815B', '-v0 ' + config.ghc_th_way_flags])
+test('T15843', [], multimod_compile_and_run,
+     ['T15843.hs',
+      '-v0 ' + config.ghc_th_way_flags])
 test('T15845', normal, compile, ['-v0 -dsuppress-uniques'])
 test('T15437', expect_broken(15437), multimod_compile,
      ['T15437', '-v0 ' + config.ghc_th_way_flags])