diff --git a/configure.sh b/configure.sh index 4758f127..2cc860b6 100755 --- a/configure.sh +++ b/configure.sh @@ -242,5 +242,6 @@ rm -fr dist* # cabal configure -fdev --enable-tests --with-compiler=ghc-9.10.1 # cabal configure -fdev --enable-tests --with-compiler=ghc-9.101 --allow-newer # cabal configure -fdev -froundtrip --enable-tests --with-compiler=ghc-9.10.1 -cabal configure -froundtrip --enable-tests --with-compiler=ghc-9.10.1 +# cabal configure -froundtrip --enable-tests --with-compiler=ghc-9.10.1 +cabal configure -fdev -froundtrip --enable-tests --with-compiler=ghc-9.10.1 diff --git a/tests/Test/Transform.hs b/tests/Test/Transform.hs index c0e6362e..9f3134b8 100644 --- a/tests/Test/Transform.hs +++ b/tests/Test/Transform.hs @@ -30,7 +30,7 @@ import Test.HUnit transformTestsTT :: LibDir -> Test transformTestsTT libdir = TestLabel "transformTestsTT" $ TestList [ - mkTestModChange libdir changeWhereIn3b "WhereIn3b.hs" + mkTestModChange libdir addArg1 "AddArg1.hs" ] transformTests :: LibDir -> Test @@ -304,6 +304,8 @@ transformHighLevelTests libdir = , mkTestModChange libdir addHiding2 "AddHiding2.hs" , mkTestModChange libdir cloneDecl1 "CloneDecl1.hs" + + , mkTestModChange libdir addArg1 "AddArg1.hs" ] -- --------------------------------------------------------------------- @@ -467,10 +469,10 @@ rmDecl2 _libdir lp = do rmDecl3 :: Changer rmDecl3 _libdir lp = do let - doRmDecl = replaceDecls lp [de1',sd1,d2] + doRmDecl = replaceDecls lp [de1',sd1'',d2] where [de1,d2] = hsDecls lp - (de1',Just sd1) = modifyValD (getLocA de1) de1 $ \_m [sd1] -> + (de1',Just sd1'') = modifyValD (getLocA de1) de1 $ \_m [sd1] -> let sd1' = setEntryDP sd1 (DifferentLine 2 0) in ([],Just sd1') @@ -483,10 +485,10 @@ rmDecl3 _libdir lp = do rmDecl4 :: Changer rmDecl4 _libdir lp = do let - doRmDecl = replaceDecls (anchorEof lp) [de1',sd1] + doRmDecl = replaceDecls (anchorEof lp) [de1',sd1''] where [de1] = hsDecls lp - (de1',Just sd1) = modifyValD (getLocA de1) de1 $ \_m [sd1,sd2] -> + (de1',Just sd1'') = modifyValD (getLocA de1) de1 $ \_m [sd1,sd2] -> let sd2' = transferEntryDP' sd1 sd2 sd1' = setEntryDP sd1 (DifferentLine 2 0) @@ -649,3 +651,32 @@ cloneDecl1 _libdir lp = do return lp' -- --------------------------------------------------------------------- + +addArg1 :: Changer +addArg1 _libdir lp = return $ replaceDecls lp [d'] + where + -- GHC 9.10 has + -- noLocA = L (noAnnSrcSpan noSrcSpan) + -- noSrcSpan = UnhelpfulSpan UnhelpfulNoLocationInfo + -- + -- instance (NoAnn ann) => NoAnn (EpAnn ann) where + -- noAnn = EpAnn noSpanAnchor noAnn emptyComments + -- noSpanAnchor :: (NoAnn a) => (EpaLocation' a) + -- noSpanAnchor = EpaDelta (SameLine 0) noAnn + + + unqualName = (mkRdrUnqual $ mkVarOcc "new_arg") :: IdP GhcPs + -- newPat = (L noAnnSrcSpanDP1 $ VarPat NoExtField (noLocA unqualName)) :: LPat GhcPs + newPat = (L noAnnSrcSpanDP1 $ VarPat NoExtField (L noAnn unqualName)) :: LPat GhcPs + + [(L l (ValD xd funbind))] = hsDecls lp + FunBind x n (MG mgx (L lmm [L lm m])) = funbind + Match mx c pats grhs = m + pats' = pats ++ [newPat] + -- GRHSs gc [L gl (GRHS ga gg rhs)] binds = grhs + d' = (L l (ValD xd (FunBind x n (MG mgx (L lmm [L lm (Match mx c pats' grhs)]))))) + -- d' = error $ "addArg1:" ++ showAst ga + + + +-- --------------------------------------------------------------------- diff --git a/tests/examples/transform/AddArg1.hs b/tests/examples/transform/AddArg1.hs new file mode 100644 index 00000000..cd34d21d --- /dev/null +++ b/tests/examples/transform/AddArg1.hs @@ -0,0 +1,4 @@ +module AddArg1 where + +-- When #24862 is fixed, the space should move automatically +foo x = new_def diff --git a/tests/examples/transform/AddArg1.hs.expected b/tests/examples/transform/AddArg1.hs.expected new file mode 100644 index 00000000..59399bc6 --- /dev/null +++ b/tests/examples/transform/AddArg1.hs.expected @@ -0,0 +1,4 @@ +module AddArg1 where + +-- When #24862 is fixed, the space should move automatically +foo x new_arg= new_def