[commit: ghc] master: Allow annotations though addTopDecls (#10486) (ba5554e)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/ba5554ec2753cc41f5e087a91f23e1f612a9eb29/ghc

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

commit ba5554ec2753cc41f5e087a91f23e1f612a9eb29
Author: Michael Smith <michael at diglumi.com>
Date:   Wed Sep 2 13:56:27 2015 +0200

    Allow annotations though addTopDecls (#10486)
    
    addTopDecls restricts what declarations it can be used to add. Adding
    annotations via this method works fine with no special changes apart
    from adding AnnD to the declaration whitelist.
    
    Test Plan: validate
    
    Reviewers: austin, goldfire, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D1201
    
    GHC Trac Issues: #10486


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

ba5554ec2753cc41f5e087a91f23e1f612a9eb29
 compiler/typecheck/TcSplice.hs                                 |  4 +++-
 docs/users_guide/7.12.1-notes.xml                              |  6 ++++++
 testsuite/tests/annotations/should_compile/th/TestModuleTH.hs  | 10 ++++++++++
 .../tests/annotations/should_compile/th/annth_compunits.stdout |  8 ++++----
 .../tests/annotations/should_compile/th/annth_make.stdout      |  8 ++++----
 5 files changed, 27 insertions(+), 9 deletions(-)

diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index 7c9882b..a018e4a 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -817,10 +817,12 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where
         = mapM_ bindName (collectHsBindBinders binds)
       checkTopDecl (SigD _)
         = return ()
+      checkTopDecl (AnnD _)
+        = return ()
       checkTopDecl (ForD (ForeignImport (L _ name) _ _ _))
         = bindName name
       checkTopDecl _
-        = addErr $ text "Only function, value, and foreign import declarations may be added with addTopDecl"
+        = addErr $ text "Only function, value, annotation, and foreign import declarations may be added with addTopDecl"
 
       bindName :: RdrName -> TcM ()
       bindName (Exact n)
diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml
index 5829666..3916e71 100644
--- a/docs/users_guide/7.12.1-notes.xml
+++ b/docs/users_guide/7.12.1-notes.xml
@@ -188,6 +188,12 @@
                      char literals.
                 </para>
             </listitem>
+             <listitem>
+                 <para>
+                     <literal>addTopDecls</literal> now accepts annotation
+                     pragmas.
+                </para>
+            </listitem>
        </itemizedlist>
     </sect3>
 
diff --git a/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs b/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs
index f21b137..715cc25 100644
--- a/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs
+++ b/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs
@@ -3,16 +3,26 @@
 module TestModuleTH where
 
 import Language.Haskell.TH
+import Language.Haskell.TH.Syntax (addTopDecls)
 
 $(do
      modAnn <- pragAnnD ModuleAnnotation
                         (stringE "TH module annotation")
+     modAnn' <- pragAnnD ModuleAnnotation
+                         (stringE "addTopDecls module annotation")
      [typ] <- [d| data TestTypeTH = TestTypeTH |]
      conAnn <- pragAnnD (ValueAnnotation $ mkName "TestTypeTH")
                         (stringE "TH Constructor annotation")
+     conAnn' <- pragAnnD (ValueAnnotation $ mkName "TestTypeTH")
+                         (stringE "addTopDecls Constructor annotation")
      typAnn <- pragAnnD (TypeAnnotation $ mkName "TestTypeTH")
                         (stringE "TH Type annotation")
+     typAnn' <- pragAnnD (TypeAnnotation $ mkName "TestTypeTH")
+                         (stringE "addTopDecls Type annotation")
      valAnn <- pragAnnD (ValueAnnotation $ mkName "testValueTH")
                         (stringE "TH Value annotation")
+     valAnn' <- pragAnnD (ValueAnnotation $ mkName "testValueTH")
+                         (stringE "addTopDecls value annotation")
      [val] <- [d| testValueTH = (42 :: Int) |]
+     addTopDecls [modAnn', conAnn', typAnn', valAnn']
      return [modAnn, conAnn, typAnn, typ, valAnn, val] )
diff --git a/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout b/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout
index 96e4642..51fa405 100644
--- a/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout
+++ b/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout
@@ -1,7 +1,7 @@
-["TH module annotation","Module annotation"]
+["TH module annotation","addTopDecls module annotation","Module annotation"]
 ["Value annotation"]
-["TH Value annotation"]
+["TH Value annotation","addTopDecls value annotation"]
 ["Type annotation"]
-["TH Type annotation"]
+["TH Type annotation","addTopDecls Type annotation"]
 ["Constructor annotation"]
-["TH Constructor annotation"]
+["TH Constructor annotation","addTopDecls Constructor annotation"]
diff --git a/testsuite/tests/annotations/should_compile/th/annth_make.stdout b/testsuite/tests/annotations/should_compile/th/annth_make.stdout
index 96e4642..51fa405 100644
--- a/testsuite/tests/annotations/should_compile/th/annth_make.stdout
+++ b/testsuite/tests/annotations/should_compile/th/annth_make.stdout
@@ -1,7 +1,7 @@
-["TH module annotation","Module annotation"]
+["TH module annotation","addTopDecls module annotation","Module annotation"]
 ["Value annotation"]
-["TH Value annotation"]
+["TH Value annotation","addTopDecls value annotation"]
 ["Type annotation"]
-["TH Type annotation"]
+["TH Type annotation","addTopDecls Type annotation"]
 ["Constructor annotation"]
-["TH Constructor annotation"]
+["TH Constructor annotation","addTopDecls Constructor annotation"]