parser : the API annotation on opt_sig is being discarded

The opt_sig production is defined as

  opt_sig :: { ([AddAnn],Maybe (LHsType RdrName)) }
          : {- empty -}                   { ([],Nothing) }
          | '::' sigtype                  { ([mj AnnDcolon $1],Just $2) }

It is used in the alt and decl_no_th productions, but neither of them
add the returned annotations.

This commit captures the annotations in the calling productions.

Reviewed By: austin

Differential Revision: https://phabricator.haskell.org/D822

GHC Trac Issues: #10254

4 files changed, 23 insertions, 9 deletions

diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 3a879ba2f6..48bc637d87 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1999,9 +1999,9 @@ decl_no_th :: { Located (OrdList (LHsDecl RdrName)) }
                                         let { l = comb2 $1 $> };
                                         case r of {
                                           (FunBind n _ _ _ _ _) ->
-                                                ams (L l ()) [mj AnnFunId n] >> return () ;
+                                                ams (L l ()) (mj AnnFunId n:(fst $2)) >> return () ;
                                           _ -> return () } ;
-                                        _ <- ams (L l ()) (fst $ unLoc $3);
+                                        _ <- ams (L l ()) ((fst $2) ++ (fst $ unLoc $3));
                                         return $! (sL l (unitOL $! (sL l $ ValD r))) } }
         | pattern_synonym_decl  { sLL $1 $> $ unitOL $1 }
         | docdecl               { sLL $1 $> $ unitOL $1 }
@@ -2573,7 +2573,7 @@ alts1   :: { Located ([AddAnn],[LMatch RdrName (LHsExpr RdrName)]) }
 alt     :: { LMatch RdrName (LHsExpr RdrName) }
         : pat opt_sig alt_rhs      {%ams (sLL $1 $> (Match Nothing [$1] (snd $2)
                                                               (snd $ unLoc $3)))
-                                         (fst $ unLoc $3)}
+                                         ((fst $2) ++ (fst $ unLoc $3))}
 
 alt_rhs :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
         : ralt wherebinds           { sLL $1 $> (fst $ unLoc $2,
diff --git a/testsuite/tests/ghc-api/annotations/AnnotationTuple.hs b/testsuite/tests/ghc-api/annotations/AnnotationTuple.hs
index 5df7cf72ef..73015a6bc5 100644
--- a/testsuite/tests/ghc-api/annotations/AnnotationTuple.hs
+++ b/testsuite/tests/ghc-api/annotations/AnnotationTuple.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE TupleSections,TypeFamilies #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE PatternGuards,ScopedTypeVariables #-}
 module AnnotationTuple (foo) where
 
 {
@@ -22,6 +22,8 @@ match n
       , Just 6 <- Nothing
       , Just 7 <- Just 9
       = Just 8
+;
+boo :: Int = 3
 }
 -- Note: the trailing whitespace in this file is used to check that we
 -- have an annotation for it.
diff --git a/testsuite/tests/ghc-api/annotations/exampleTest.stdout b/testsuite/tests/ghc-api/annotations/exampleTest.stdout
index 1c3eed51d8..128b70a598 100644
--- a/testsuite/tests/ghc-api/annotations/exampleTest.stdout
+++ b/testsuite/tests/ghc-api/annotations/exampleTest.stdout
@@ -2,12 +2,12 @@
 [
 (AK AnnotationTuple.hs:14:39 AnnComma = [AnnotationTuple.hs:14:39])
 
-(AK <no location info> AnnEofPos = [AnnotationTuple.hs:30:1])
+(AK <no location info> AnnEofPos = [AnnotationTuple.hs:32:1])
 ]
 
 --------------------------------
 [
-(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:25:1])
+(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:27:1])
 
 (AK AnnotationTuple.hs:1:1 AnnModule = [AnnotationTuple.hs:3:1-6])
 
@@ -133,6 +133,8 @@
 
 (AK AnnotationTuple.hs:(20,1)-(24,14) AnnFunId = [AnnotationTuple.hs:20:1-5])
 
+(AK AnnotationTuple.hs:(20,1)-(24,14) AnnSemi = [AnnotationTuple.hs:25:1])
+
 (AK AnnotationTuple.hs:(21,7)-(24,14) AnnEqual = [AnnotationTuple.hs:24:7])
 
 (AK AnnotationTuple.hs:(21,7)-(24,14) AnnVbar = [AnnotationTuple.hs:21:7])
@@ -147,6 +149,10 @@
 
 (AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17])
 
-(AK <no location info> AnnEofPos = [AnnotationTuple.hs:30:1])
+(AK AnnotationTuple.hs:26:1-14 AnnDcolon = [AnnotationTuple.hs:26:5-6])
+
+(AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12])
+
+(AK <no location info> AnnEofPos = [AnnotationTuple.hs:32:1])
 ]
 
diff --git a/testsuite/tests/ghc-api/annotations/parseTree.stdout b/testsuite/tests/ghc-api/annotations/parseTree.stdout
index 90f9d8c7a4..9965fd21b1 100644
--- a/testsuite/tests/ghc-api/annotations/parseTree.stdout
+++ b/testsuite/tests/ghc-api/annotations/parseTree.stdout
@@ -11,7 +11,7 @@
  (AnnotationTuple.hs:16:25, [m], ()),
  (AnnotationTuple.hs:16:26, [m], ())]
 [
-(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:25:1])
+(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:27:1])
 
 (AK AnnotationTuple.hs:1:1 AnnModule = [AnnotationTuple.hs:3:1-6])
 
@@ -137,6 +137,8 @@
 
 (AK AnnotationTuple.hs:(20,1)-(24,14) AnnFunId = [AnnotationTuple.hs:20:1-5])
 
+(AK AnnotationTuple.hs:(20,1)-(24,14) AnnSemi = [AnnotationTuple.hs:25:1])
+
 (AK AnnotationTuple.hs:(21,7)-(24,14) AnnEqual = [AnnotationTuple.hs:24:7])
 
 (AK AnnotationTuple.hs:(21,7)-(24,14) AnnVbar = [AnnotationTuple.hs:21:7])
@@ -151,6 +153,10 @@
 
 (AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17])
 
-(AK <no location info> AnnEofPos = [AnnotationTuple.hs:30:1])
+(AK AnnotationTuple.hs:26:1-14 AnnDcolon = [AnnotationTuple.hs:26:5-6])
+
+(AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12])
+
+(AK <no location info> AnnEofPos = [AnnotationTuple.hs:32:1])
 ]