From c506f8353755333e21d5ee35bc71d2c8f9ddcb1b Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Mon, 10 Jul 2017 13:00:36 +0200
Subject: Pretty-printer no longer butchers function arrow fixity

It now correctly prints the parens around '(Int -> Int)' in

    {-# LANGUAGE TemplateHaskell #-}
    {-# OPTIONS_GHC -ddump-splices #-}
    module Bug where

    $([d| f :: Either Int (Int -> Int)
          f = undefined
        |])

Closes #13942
---
 testsuite/tests/printer/Makefile      |  4 ++++
 testsuite/tests/printer/T13942.hs     | 36 +++++++++++++++++++++++++++++++++++
 testsuite/tests/printer/T13942.stdout | 12 ++++++++++++
 testsuite/tests/printer/all.T         |  1 +
 4 files changed, 53 insertions(+)
 create mode 100644 testsuite/tests/printer/T13942.hs
 create mode 100644 testsuite/tests/printer/T13942.stdout

(limited to 'testsuite/tests')

diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile
index 9cb968f2b4..1c2f2995d0 100644
--- a/testsuite/tests/printer/Makefile
+++ b/testsuite/tests/printer/Makefile
@@ -209,3 +209,7 @@ T13050p:
 .PHONY: T13550
 T13550:
 	$(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T13550.hs
+
+.PHONY: T13942
+T13942:
+	$(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T13942.hs
diff --git a/testsuite/tests/printer/T13942.hs b/testsuite/tests/printer/T13942.hs
new file mode 100644
index 0000000000..8899e1c58d
--- /dev/null
+++ b/testsuite/tests/printer/T13942.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}
+module T13942 where
+
+$([d| f :: Either Int (Int -> Int)
+      f = undefined
+    |])
+
+{-
+
+Note: to debug
+
+~/inplace/bin/ghc-stage2 --interactive
+load the following
+--------------------------------------
+import Language.Haskell.TH
+
+foo :: IO ()
+foo = do
+  r <- runQ ([d| f :: Either Int (Int -> Int)
+                 f = undefined
+             |])
+  print r
+
+----------------------------------------
+foo
+[SigD f_0 (AppT (AppT (ConT Data.Either.Either) (ConT GHC.Types.Int)) (AppT (AppT ArrowT (ConT GHC.Types.Int)) (ConT GHC.Types.Int)))
+,ValD (VarP f_0) (NormalB (VarE GHC.Err.undefined)) []]
+
+[SigD f_0
+  (AppT (AppT (ConT Data.Either.Either)
+              (ConT GHC.Types.Int))
+        (AppT (AppT ArrowT
+                    (ConT GHC.Types.Int))
+              (ConT GHC.Types.Int)))
+-}
diff --git a/testsuite/tests/printer/T13942.stdout b/testsuite/tests/printer/T13942.stdout
new file mode 100644
index 0000000000..2d0f617074
--- /dev/null
+++ b/testsuite/tests/printer/T13942.stdout
@@ -0,0 +1,12 @@
+T13942.hs:(5,3)-(7,6): Splicing declarations
+    [d| f :: Either Int (Int -> Int)
+        f = undefined |]
+  ======>
+    f :: Either Int (Int -> Int)
+    f = undefined
+T13942.ppr.hs:(4,3)-(5,22): Splicing declarations
+    [d| f :: Either Int (Int -> Int)
+        f = undefined |]
+  ======>
+    f :: Either Int (Int -> Int)
+    f = undefined
diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T
index c939e49300..a71d6e3534 100644
--- a/testsuite/tests/printer/all.T
+++ b/testsuite/tests/printer/all.T
@@ -49,3 +49,4 @@ test('Ppr048', ignore_stderr, run_command, ['$MAKE -s --no-print-directory ppr04
 test('T13199', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13199'])
 test('T13050p', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13050p'])
 test('T13550', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13550'])
+test('T13942', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13942'])
-- 
cgit v1.2.1