[Git][ghc/ghc][master] EPA: Correctly capture leading semis in decl list

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Nov 13 13:50:13 UTC 2024



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


Commits:
0614abef by Alan Zimmerman at 2024-11-13T08:49:34-05:00
EPA: Correctly capture leading semis in decl list

Closes #25467

- - - - -


7 changed files:

- compiler/GHC/Parser.y
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/printer/Makefile
- testsuite/tests/printer/Test20297.stdout
- + testsuite/tests/printer/Test25467.hs
- testsuite/tests/printer/all.T
- utils/check-exact/Main.hs


Changes:

=====================================
compiler/GHC/Parser.y
=====================================
@@ -1853,7 +1853,7 @@ where_inst :: { Located ((EpToken "where", (EpToken "{", EpToken "}", [EpToken "
 --
 decls   :: { Located (EpaLocation, [EpToken ";"], OrdList (LHsDecl GhcPs)) }
         : decls ';' decl    {% if isNilOL (thdOf3 $ unLoc $1)
-                                 then return (sLL $1 $> (glEE $2 $3, (sndOf3 $ unLoc $1) ++ (msemiA $2)
+                                 then return (sLL $2 $> (glR $3, (sndOf3 $ unLoc $1) ++ (msemiA $2)
                                                         , unitOL $3))
                                  else case (thdOf3 $ unLoc $1) of
                                    SnocOL hs t -> do
@@ -1862,7 +1862,7 @@ decls   :: { Located (EpaLocation, [EpToken ";"], OrdList (LHsDecl GhcPs)) }
                                             rest = snocOL hs t';
                                             these = rest `appOL` this }
                                       return (rest `seq` this `seq` these `seq`
-                                                 (sLL $1 $> (glEE $1 $3, sndOf3 $ unLoc $1, these))) }
+                                                 (sLL $1 $> (glEE (fstOf3 $ unLoc $1) $3, sndOf3 $ unLoc $1, these))) }
         | decls ';'          {% if isNilOL (thdOf3 $ unLoc $1)
                                   then return (sLZ $1 $> (glR $2, (sndOf3 $ unLoc $1) ++ (msemiA $2)
                                                           ,thdOf3 $ unLoc $1))
@@ -1876,7 +1876,7 @@ decls   :: { Located (EpaLocation, [EpToken ";"], OrdList (LHsDecl GhcPs)) }
 decllist :: { Located (AnnList (),Located (OrdList (LHsDecl GhcPs))) }
         : '{'            decls '}'     { sLL $1 $> (AnnList (Just (fstOf3 $ unLoc $2)) (ListBraces (epTok $1) (epTok $3)) (sndOf3 $ unLoc $2) noAnn []
                                                    ,sL1 $2 $ thdOf3 $ unLoc $2) }
-        |     vocurly    decls close   { L (getHasLoc $ fstOf3 $ unLoc $2) (AnnList (Just (glR $2)) ListNone (sndOf3 $ unLoc $2) noAnn []
+        |     vocurly    decls close   { sL1 $2    (AnnList (Just (fstOf3 $ unLoc $2)) ListNone (sndOf3 $ unLoc $2) noAnn []
                                                    ,sL1 $2 $ thdOf3 $ unLoc $2) }
 
 -- Binding groups other than those of class and instance declarations


=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -1971,7 +1971,7 @@
                    (EpaSpan { DumpSemis.hs:34:13-31 })
                    (AnnList
                     (Just
-                     (EpaSpan { DumpSemis.hs:34:14-30 }))
+                     (EpaSpan { DumpSemis.hs:34:18-30 }))
                     (ListBraces
                      (EpTok (EpaSpan { DumpSemis.hs:34:13 }))
                      (EpTok (EpaSpan { DumpSemis.hs:34:31 })))


=====================================
testsuite/tests/printer/Makefile
=====================================
@@ -891,3 +891,8 @@ Test25132:
 Test25454:
 	$(CHECK_PPR)   $(LIBDIR) Test25454.hs
 	$(CHECK_EXACT) $(LIBDIR) Test25454.hs
+
+.PHONY: Test25467
+Test25467:
+	$(CHECK_PPR)   $(LIBDIR) Test25467.hs
+	$(CHECK_EXACT) $(LIBDIR) Test25467.hs


=====================================
testsuite/tests/printer/Test20297.stdout
=====================================
@@ -153,7 +153,7 @@
               (EpaSpan { <no location info> })
               (AnnList
                (Just
-                (EpaSpan { <no location info> }))
+                (EpaSpan { Test20297.hs:7:3-7 }))
                (ListNone)
                []
                (EpTok
@@ -582,7 +582,7 @@
               (EpaSpan { <no location info> })
               (AnnList
                (Just
-                (EpaSpan { <no location info> }))
+                (EpaSpan { Test20297.ppr.hs:5:3-7 }))
                (ListNone)
                []
                (EpTok


=====================================
testsuite/tests/printer/Test25467.hs
=====================================
@@ -0,0 +1,21 @@
+module Test25467 where
+
+fff = do
+     let {
+         ; (a, b) = foo
+         }
+     pure ()
+
+foo = do
+  let ;x =1
+
+bar1 = do
+    let {
+        ; labels1     = getFieldLabels
+        ; argexprA    = vhdlNameToVHDLExpr
+        }
+
+bar2 = do
+    let {
+        ; labels2      = getFieldLabels
+        }


=====================================
testsuite/tests/printer/all.T
=====================================
@@ -210,6 +210,7 @@ test('Test24753', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24753'])
 test('Test24771', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24771'])
 test('Test24159', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24159'])
 test('Test25132', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25132'])
+test('Test25467', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25467'])
 
 test('T24237', normal, compile_fail, [''])
 


=====================================
utils/check-exact/Main.hs
=====================================
@@ -213,10 +213,11 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/epw/_buil
  -- "../../testsuite/tests/printer/Test16279.hs" Nothing
  -- "../../testsuite/tests/printer/HsDocTy.hs" Nothing
  -- "../../testsuite/tests/printer/Test21355.hs" Nothing
---  "../../testsuite/tests/printer/Test22765.hs" Nothing
+ --  "../../testsuite/tests/printer/Test22765.hs" Nothing
  -- "../../testsuite/tests/printer/Test22771.hs" Nothing
  -- "../../testsuite/tests/printer/Test23465.hs" Nothing
- "../../testsuite/tests/printer/Test25454.hs" Nothing
+ -- "../../testsuite/tests/printer/Test25454.hs" Nothing
+ "../../testsuite/tests/printer/Test25467.hs" Nothing
 
 -- cloneT does not need a test, function can be retired
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0614abef967c2ee9fb83955f18460715160a557a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0614abef967c2ee9fb83955f18460715160a557a
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/20241113/3616887f/attachment-0001.html>


More information about the ghc-commits mailing list