[Git][ghc/ghc][master] EPA: Fix regression discarding comments in contexts

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu Mar 14 13:01:55 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
7da7f8f6 by Alan Zimmerman at 2024-03-14T09:01:15-04:00
EPA: Fix regression discarding comments in contexts

Closes #24533

- - - - -


5 changed files:

- compiler/GHC/Parser/PostProcess.hs
- testsuite/tests/printer/Makefile
- + testsuite/tests/printer/Test24533.hs
- + testsuite/tests/printer/Test24533.stdout
- testsuite/tests/printer/all.T


Changes:

=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1135,8 +1135,8 @@ checkCmdBlockArguments :: LHsCmd GhcPs -> PV ()
 --     (((Eq a)))           -->  [Eq a]
 -- @
 checkContext :: LHsType GhcPs -> P (LHsContext GhcPs)
-checkContext orig_t@(L (EpAnn l _ _) _orig_t) =
-  check ([],[],emptyComments) orig_t
+checkContext orig_t@(L (EpAnn l _ cs) _orig_t) =
+  check ([],[],cs) orig_t
  where
   check :: ([EpaLocation],[EpaLocation],EpAnnComments)
         -> LHsType GhcPs -> P (LHsContext GhcPs)


=====================================
testsuite/tests/printer/Makefile
=====================================
@@ -816,3 +816,8 @@ Test23885:
 AnnotationNoListTuplePuns:
 	$(CHECK_PPR)   $(LIBDIR) AnnotationNoListTuplePuns.hs
 	$(CHECK_EXACT) $(LIBDIR) AnnotationNoListTuplePuns.hs
+
+.PHONY: Test24533
+Test24533:
+	$(CHECK_PPR)   $(LIBDIR) Test24533.hs
+	$(CHECK_EXACT) $(LIBDIR) Test24533.hs


=====================================
testsuite/tests/printer/Test24533.hs
=====================================
@@ -0,0 +1,8 @@
+{-# OPTIONS -ddump-parsed-ast #-}
+module Test24533 where
+
+instance
+  ( Read a, -- Weird
+    Read b
+  ) =>
+  Read (a, b)


=====================================
testsuite/tests/printer/Test24533.stdout
=====================================
@@ -0,0 +1,548 @@
+
+==================== Parser AST ====================
+
+(L
+ { Test24533.hs:1:1 }
+ (HsModule
+  (XModulePs
+   (EpAnn
+    (EpaSpan { Test24533.hs:1:1 })
+    (AnnsModule
+     [(AddEpAnn AnnModule (EpaSpan { Test24533.hs:2:1-6 }))
+     ,(AddEpAnn AnnWhere (EpaSpan { Test24533.hs:2:18-22 }))]
+     []
+     (Just
+      ((,)
+       { Test24533.hs:9:1 }
+       { Test24533.hs:8:13 })))
+    (EpaCommentsBalanced
+     [(L
+       (EpaSpan
+        { Test24533.hs:1:1-33 })
+       (EpaComment
+        (EpaBlockComment
+         "{-# OPTIONS -ddump-parsed-ast #-}")
+        { Test24533.hs:1:1 }))]
+     []))
+   (EpVirtualBraces
+    (1))
+   (Nothing)
+   (Nothing))
+  (Just
+   (L
+    (EpAnn
+     (EpaSpan { Test24533.hs:2:8-16 })
+     (AnnListItem
+      [])
+     (EpaComments
+      []))
+    {ModuleName: Test24533}))
+  (Nothing)
+  []
+  [(L
+    (EpAnn
+     (EpaSpan { Test24533.hs:(4,1)-(8,13) })
+     (AnnListItem
+      [])
+     (EpaComments
+      []))
+    (InstD
+     (NoExtField)
+     (ClsInstD
+      (NoExtField)
+      (ClsInstDecl
+       ((,,)
+        (Nothing)
+        [(AddEpAnn AnnInstance (EpaSpan { Test24533.hs:4:1-8 }))]
+        (NoAnnSortKey))
+       (L
+        (EpAnn
+         (EpaSpan { Test24533.hs:(5,3)-(8,13) })
+         (AnnListItem
+          [])
+         (EpaComments
+          []))
+        (HsSig
+         (NoExtField)
+         (HsOuterImplicit
+          (NoExtField))
+         (L
+          (EpAnn
+           (EpaSpan { Test24533.hs:(5,3)-(8,13) })
+           (AnnListItem
+            [])
+           (EpaComments
+            []))
+          (HsQualTy
+           (NoExtField)
+           (L
+            (EpAnn
+             (EpaSpan { Test24533.hs:(5,3)-(7,3) })
+             (AnnContext
+              (Just
+               ((,)
+                (NormalSyntax)
+                (EpaSpan { Test24533.hs:7:5-6 })))
+              [(EpaSpan { Test24533.hs:5:3 })]
+              [(EpaSpan { Test24533.hs:7:3 })])
+             (EpaComments
+              [(L
+                (EpaSpan
+                 { Test24533.hs:5:13-20 })
+                (EpaComment
+                 (EpaLineComment
+                  "-- Weird")
+                 { Test24533.hs:5:11 }))]))
+            [(L
+              (EpAnn
+               (EpaSpan { Test24533.hs:5:5-10 })
+               (AnnListItem
+                [(AddCommaAnn
+                  (EpaSpan { Test24533.hs:5:11 }))])
+               (EpaComments
+                []))
+              (HsAppTy
+               (NoExtField)
+               (L
+                (EpAnn
+                 (EpaSpan { Test24533.hs:5:5-8 })
+                 (AnnListItem
+                  [])
+                 (EpaComments
+                  []))
+                (HsTyVar
+                 []
+                 (NotPromoted)
+                 (L
+                  (EpAnn
+                   (EpaSpan { Test24533.hs:5:5-8 })
+                   (NameAnnTrailing
+                    [])
+                   (EpaComments
+                    []))
+                  (Unqual
+                   {OccName: Read}))))
+               (L
+                (EpAnn
+                 (EpaSpan { Test24533.hs:5:10 })
+                 (AnnListItem
+                  [])
+                 (EpaComments
+                  []))
+                (HsTyVar
+                 []
+                 (NotPromoted)
+                 (L
+                  (EpAnn
+                   (EpaSpan { Test24533.hs:5:10 })
+                   (NameAnnTrailing
+                    [])
+                   (EpaComments
+                    []))
+                  (Unqual
+                   {OccName: a}))))))
+            ,(L
+              (EpAnn
+               (EpaSpan { Test24533.hs:6:5-10 })
+               (AnnListItem
+                [])
+               (EpaComments
+                []))
+              (HsAppTy
+               (NoExtField)
+               (L
+                (EpAnn
+                 (EpaSpan { Test24533.hs:6:5-8 })
+                 (AnnListItem
+                  [])
+                 (EpaComments
+                  []))
+                (HsTyVar
+                 []
+                 (NotPromoted)
+                 (L
+                  (EpAnn
+                   (EpaSpan { Test24533.hs:6:5-8 })
+                   (NameAnnTrailing
+                    [])
+                   (EpaComments
+                    []))
+                  (Unqual
+                   {OccName: Read}))))
+               (L
+                (EpAnn
+                 (EpaSpan { Test24533.hs:6:10 })
+                 (AnnListItem
+                  [])
+                 (EpaComments
+                  []))
+                (HsTyVar
+                 []
+                 (NotPromoted)
+                 (L
+                  (EpAnn
+                   (EpaSpan { Test24533.hs:6:10 })
+                   (NameAnnTrailing
+                    [])
+                   (EpaComments
+                    []))
+                  (Unqual
+                   {OccName: b}))))))])
+           (L
+            (EpAnn
+             (EpaSpan { Test24533.hs:8:3-13 })
+             (AnnListItem
+              [])
+             (EpaComments
+              []))
+            (HsAppTy
+             (NoExtField)
+             (L
+              (EpAnn
+               (EpaSpan { Test24533.hs:8:3-6 })
+               (AnnListItem
+                [])
+               (EpaComments
+                []))
+              (HsTyVar
+               []
+               (NotPromoted)
+               (L
+                (EpAnn
+                 (EpaSpan { Test24533.hs:8:3-6 })
+                 (NameAnnTrailing
+                  [])
+                 (EpaComments
+                  []))
+                (Unqual
+                 {OccName: Read}))))
+             (L
+              (EpAnn
+               (EpaSpan { Test24533.hs:8:8-13 })
+               (AnnListItem
+                [])
+               (EpaComments
+                []))
+              (HsTupleTy
+               (AnnParen
+                AnnParens
+                (EpaSpan { Test24533.hs:8:8 })
+                (EpaSpan { Test24533.hs:8:13 }))
+               (HsBoxedOrConstraintTuple)
+               [(L
+                 (EpAnn
+                  (EpaSpan { Test24533.hs:8:9 })
+                  (AnnListItem
+                   [(AddCommaAnn
+                     (EpaSpan { Test24533.hs:8:10 }))])
+                  (EpaComments
+                   []))
+                 (HsTyVar
+                  []
+                  (NotPromoted)
+                  (L
+                   (EpAnn
+                    (EpaSpan { Test24533.hs:8:9 })
+                    (NameAnnTrailing
+                     [])
+                    (EpaComments
+                     []))
+                   (Unqual
+                    {OccName: a}))))
+               ,(L
+                 (EpAnn
+                  (EpaSpan { Test24533.hs:8:12 })
+                  (AnnListItem
+                   [])
+                  (EpaComments
+                   []))
+                 (HsTyVar
+                  []
+                  (NotPromoted)
+                  (L
+                   (EpAnn
+                    (EpaSpan { Test24533.hs:8:12 })
+                    (NameAnnTrailing
+                     [])
+                    (EpaComments
+                     []))
+                   (Unqual
+                    {OccName: b}))))]))))))))
+       {Bag(LocatedA (HsBind GhcPs)):
+        []}
+       []
+       []
+       []
+       (Nothing)))))]))
+
+
+
+==================== Parser AST ====================
+
+(L
+ { Test24533.ppr.hs:1:1 }
+ (HsModule
+  (XModulePs
+   (EpAnn
+    (EpaSpan { Test24533.ppr.hs:1:1 })
+    (AnnsModule
+     [(AddEpAnn AnnModule (EpaSpan { Test24533.ppr.hs:2:1-6 }))
+     ,(AddEpAnn AnnWhere (EpaSpan { Test24533.ppr.hs:2:18-22 }))]
+     []
+     (Just
+      ((,)
+       { Test24533.ppr.hs:3:41 }
+       { Test24533.ppr.hs:3:40 })))
+    (EpaCommentsBalanced
+     [(L
+       (EpaSpan
+        { Test24533.ppr.hs:1:1-33 })
+       (EpaComment
+        (EpaBlockComment
+         "{-# OPTIONS -ddump-parsed-ast #-}")
+        { Test24533.ppr.hs:1:1 }))]
+     []))
+   (EpVirtualBraces
+    (1))
+   (Nothing)
+   (Nothing))
+  (Just
+   (L
+    (EpAnn
+     (EpaSpan { Test24533.ppr.hs:2:8-16 })
+     (AnnListItem
+      [])
+     (EpaComments
+      []))
+    {ModuleName: Test24533}))
+  (Nothing)
+  []
+  [(L
+    (EpAnn
+     (EpaSpan { Test24533.ppr.hs:3:1-40 })
+     (AnnListItem
+      [])
+     (EpaComments
+      []))
+    (InstD
+     (NoExtField)
+     (ClsInstD
+      (NoExtField)
+      (ClsInstDecl
+       ((,,)
+        (Nothing)
+        [(AddEpAnn AnnInstance (EpaSpan { Test24533.ppr.hs:3:1-8 }))]
+        (NoAnnSortKey))
+       (L
+        (EpAnn
+         (EpaSpan { Test24533.ppr.hs:3:10-40 })
+         (AnnListItem
+          [])
+         (EpaComments
+          []))
+        (HsSig
+         (NoExtField)
+         (HsOuterImplicit
+          (NoExtField))
+         (L
+          (EpAnn
+           (EpaSpan { Test24533.ppr.hs:3:10-40 })
+           (AnnListItem
+            [])
+           (EpaComments
+            []))
+          (HsQualTy
+           (NoExtField)
+           (L
+            (EpAnn
+             (EpaSpan { Test24533.ppr.hs:3:10-25 })
+             (AnnContext
+              (Just
+               ((,)
+                (NormalSyntax)
+                (EpaSpan { Test24533.ppr.hs:3:27-28 })))
+              [(EpaSpan { Test24533.ppr.hs:3:10 })]
+              [(EpaSpan { Test24533.ppr.hs:3:25 })])
+             (EpaComments
+              []))
+            [(L
+              (EpAnn
+               (EpaSpan { Test24533.ppr.hs:3:11-16 })
+               (AnnListItem
+                [(AddCommaAnn
+                  (EpaSpan { Test24533.ppr.hs:3:17 }))])
+               (EpaComments
+                []))
+              (HsAppTy
+               (NoExtField)
+               (L
+                (EpAnn
+                 (EpaSpan { Test24533.ppr.hs:3:11-14 })
+                 (AnnListItem
+                  [])
+                 (EpaComments
+                  []))
+                (HsTyVar
+                 []
+                 (NotPromoted)
+                 (L
+                  (EpAnn
+                   (EpaSpan { Test24533.ppr.hs:3:11-14 })
+                   (NameAnnTrailing
+                    [])
+                   (EpaComments
+                    []))
+                  (Unqual
+                   {OccName: Read}))))
+               (L
+                (EpAnn
+                 (EpaSpan { Test24533.ppr.hs:3:16 })
+                 (AnnListItem
+                  [])
+                 (EpaComments
+                  []))
+                (HsTyVar
+                 []
+                 (NotPromoted)
+                 (L
+                  (EpAnn
+                   (EpaSpan { Test24533.ppr.hs:3:16 })
+                   (NameAnnTrailing
+                    [])
+                   (EpaComments
+                    []))
+                  (Unqual
+                   {OccName: a}))))))
+            ,(L
+              (EpAnn
+               (EpaSpan { Test24533.ppr.hs:3:19-24 })
+               (AnnListItem
+                [])
+               (EpaComments
+                []))
+              (HsAppTy
+               (NoExtField)
+               (L
+                (EpAnn
+                 (EpaSpan { Test24533.ppr.hs:3:19-22 })
+                 (AnnListItem
+                  [])
+                 (EpaComments
+                  []))
+                (HsTyVar
+                 []
+                 (NotPromoted)
+                 (L
+                  (EpAnn
+                   (EpaSpan { Test24533.ppr.hs:3:19-22 })
+                   (NameAnnTrailing
+                    [])
+                   (EpaComments
+                    []))
+                  (Unqual
+                   {OccName: Read}))))
+               (L
+                (EpAnn
+                 (EpaSpan { Test24533.ppr.hs:3:24 })
+                 (AnnListItem
+                  [])
+                 (EpaComments
+                  []))
+                (HsTyVar
+                 []
+                 (NotPromoted)
+                 (L
+                  (EpAnn
+                   (EpaSpan { Test24533.ppr.hs:3:24 })
+                   (NameAnnTrailing
+                    [])
+                   (EpaComments
+                    []))
+                  (Unqual
+                   {OccName: b}))))))])
+           (L
+            (EpAnn
+             (EpaSpan { Test24533.ppr.hs:3:30-40 })
+             (AnnListItem
+              [])
+             (EpaComments
+              []))
+            (HsAppTy
+             (NoExtField)
+             (L
+              (EpAnn
+               (EpaSpan { Test24533.ppr.hs:3:30-33 })
+               (AnnListItem
+                [])
+               (EpaComments
+                []))
+              (HsTyVar
+               []
+               (NotPromoted)
+               (L
+                (EpAnn
+                 (EpaSpan { Test24533.ppr.hs:3:30-33 })
+                 (NameAnnTrailing
+                  [])
+                 (EpaComments
+                  []))
+                (Unqual
+                 {OccName: Read}))))
+             (L
+              (EpAnn
+               (EpaSpan { Test24533.ppr.hs:3:35-40 })
+               (AnnListItem
+                [])
+               (EpaComments
+                []))
+              (HsTupleTy
+               (AnnParen
+                AnnParens
+                (EpaSpan { Test24533.ppr.hs:3:35 })
+                (EpaSpan { Test24533.ppr.hs:3:40 }))
+               (HsBoxedOrConstraintTuple)
+               [(L
+                 (EpAnn
+                  (EpaSpan { Test24533.ppr.hs:3:36 })
+                  (AnnListItem
+                   [(AddCommaAnn
+                     (EpaSpan { Test24533.ppr.hs:3:37 }))])
+                  (EpaComments
+                   []))
+                 (HsTyVar
+                  []
+                  (NotPromoted)
+                  (L
+                   (EpAnn
+                    (EpaSpan { Test24533.ppr.hs:3:36 })
+                    (NameAnnTrailing
+                     [])
+                    (EpaComments
+                     []))
+                   (Unqual
+                    {OccName: a}))))
+               ,(L
+                 (EpAnn
+                  (EpaSpan { Test24533.ppr.hs:3:39 })
+                  (AnnListItem
+                   [])
+                  (EpaComments
+                   []))
+                 (HsTyVar
+                  []
+                  (NotPromoted)
+                  (L
+                   (EpAnn
+                    (EpaSpan { Test24533.ppr.hs:3:39 })
+                    (NameAnnTrailing
+                     [])
+                    (EpaComments
+                     []))
+                   (Unqual
+                    {OccName: b}))))]))))))))
+       {Bag(LocatedA (HsBind GhcPs)):
+        []}
+       []
+       []
+       []
+       (Nothing)))))]))
\ No newline at end of file


=====================================
testsuite/tests/printer/all.T
=====================================
@@ -196,3 +196,4 @@ test('Test23887', [ignore_stderr, req_ppr_deps], makefile_test, ['Test23887'])
 test('Test23885', [ignore_stderr, req_ppr_deps], makefile_test, ['Test23885'])
 test('ListTuplePuns', extra_files(['ListTuplePuns.hs']), ghci_script, ['ListTuplePuns.script'])
 test('AnnotationNoListTuplePuns', [ignore_stderr, req_ppr_deps], makefile_test, ['AnnotationNoListTuplePuns'])
+test('Test24533', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24533'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7da7f8f643f1bfc4aa034a731f2f85cda007b286

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7da7f8f643f1bfc4aa034a731f2f85cda007b286
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240314/8cf88320/attachment-0001.html>


More information about the ghc-commits mailing list