[commit: ghc] wip/T3384: Use SourceText to ppr Overlap Pragma (379da58)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T3384
Link       : http://ghc.haskell.org/trac/ghc/changeset/379da5809e8b2d6019b68340f61b326a49b58b24/ghc

>---------------------------------------------------------------

commit 379da5809e8b2d6019b68340f61b326a49b58b24
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date:   Sun Nov 13 12:56:13 2016 +0200

    Use SourceText to ppr Overlap Pragma


>---------------------------------------------------------------

379da5809e8b2d6019b68340f61b326a49b58b24
 compiler/hsSyn/HsDecls.hs             | 13 ++++++++-----
 testsuite/tests/printer/Makefile      |  4 ++++
 testsuite/tests/printer/Ppr013.hs     | 14 ++++++++++++++
 testsuite/tests/printer/Ppr013.stderr |  6 ++++++
 testsuite/tests/printer/all.T         |  1 +
 5 files changed, 33 insertions(+), 5 deletions(-)

diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs
index 6ad658d..840106c 100644
--- a/compiler/hsSyn/HsDecls.hs
+++ b/compiler/hsSyn/HsDecls.hs
@@ -1491,11 +1491,14 @@ ppOverlapPragma :: Maybe (Located OverlapMode) -> SDoc
 ppOverlapPragma mb =
   case mb of
     Nothing           -> empty
-    Just (L _ (NoOverlap _))    -> text "{-# NO_OVERLAP #-}"
-    Just (L _ (Overlappable _)) -> text "{-# OVERLAPPABLE #-}"
-    Just (L _ (Overlapping _))  -> text "{-# OVERLAPPING #-}"
-    Just (L _ (Overlaps _))     -> text "{-# OVERLAPS #-}"
-    Just (L _ (Incoherent _))   -> text "{-# INCOHERENT #-}"
+    Just (L _ (NoOverlap s))    -> maybe_stext s "{-# NO_OVERLAP #-}"
+    Just (L _ (Overlappable s)) -> maybe_stext s "{-# OVERLAPPABLE #-}"
+    Just (L _ (Overlapping s))  -> maybe_stext s "{-# OVERLAPPING #-}"
+    Just (L _ (Overlaps s))     -> maybe_stext s "{-# OVERLAPS #-}"
+    Just (L _ (Incoherent s))   -> maybe_stext s "{-# INCOHERENT #-}"
+  where
+    maybe_stext "" alt = text alt
+    maybe_stext src _  = text src <+> text "#-}"
 
 
 instance (OutputableBndrId name) => Outputable (InstDecl name) where
diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile
index 4c7d6bf..0c4ad7e 100644
--- a/testsuite/tests/printer/Makefile
+++ b/testsuite/tests/printer/Makefile
@@ -53,3 +53,7 @@ ppr011:
 .PHONY: ppr012
 ppr012:
 	$(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr012.hs
+
+.PHONY: ppr013
+ppr013:
+	$(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr013.hs
diff --git a/testsuite/tests/printer/Ppr013.hs b/testsuite/tests/printer/Ppr013.hs
new file mode 100644
index 0000000..74788bf
--- /dev/null
+++ b/testsuite/tests/printer/Ppr013.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+import Data.Data
+
+data Foo = FooA | FooB
+
+deriving instance Show Foo
+
+deriving instance {-# Overlappable #-} Eq Foo
+deriving instance {-# Overlapping  #-} Ord Foo
+deriving instance {-# Overlaps     #-} Typeable Foo
+deriving instance {-# Incoherent   #-} Data Foo
+
diff --git a/testsuite/tests/printer/Ppr013.stderr b/testsuite/tests/printer/Ppr013.stderr
new file mode 100644
index 0000000..5bfa1c7
--- /dev/null
+++ b/testsuite/tests/printer/Ppr013.stderr
@@ -0,0 +1,6 @@
+
+Ppr013.hs:1:1: error:
+    The IO action ‘main’ is not defined in module ‘Main’
+
+Ppr013.ppr.hs:1:1: error:
+    The IO action ‘main’ is not defined in module ‘Main’
diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T
index 4443b15..c2adc00 100644
--- a/testsuite/tests/printer/all.T
+++ b/testsuite/tests/printer/all.T
@@ -10,3 +10,4 @@ test('Ppr009', normal, run_command, ['$MAKE -s --no-print-directory ppr009'])
 test('Ppr010', normal, run_command, ['$MAKE -s --no-print-directory ppr010'])
 test('Ppr011', normal, run_command, ['$MAKE -s --no-print-directory ppr011'])
 test('Ppr012', normal, run_command, ['$MAKE -s --no-print-directory ppr012'])
+test('Ppr013', normal, run_command, ['$MAKE -s --no-print-directory ppr013'])