diff --git a/liquidhaskell-boot/ghc-api-tests/GhcApiTests.hs b/liquidhaskell-boot/ghc-api-tests/GhcApiTests.hs index a0a7b3a921..797f75feb2 100644 --- a/liquidhaskell-boot/ghc-api-tests/GhcApiTests.hs +++ b/liquidhaskell-boot/ghc-api-tests/GhcApiTests.hs @@ -51,6 +51,7 @@ testTree = , testCase "caseDesugaring" testCaseDesugaring , testCase "numericLiteralDesugaring" testNumLitDesugaring , testCase "dollarDesugaring" testDollarDesugaring + , testCase "localBindingsDesugaring" testLocalBindingsDesugaring ] -- Tests that Liquid.GHC.API.Extra.apiComments can retrieve the comments in @@ -196,6 +197,32 @@ testDollarDesugaring = do fail $ unlines $ "Unexpected desugaring:" : map showPprQualified coreProgram +-- | Test that local bindings are preserved. +testLocalBindingsDesugaring :: IO () +testLocalBindingsDesugaring = do + let inputSource = unlines + [ "module LocalBindingsDesugaring where" + , "f :: ()" + , "f = z" + , " where" + , " z = ()" + ] + + fBind (GHC.NonRec b _e) = + occNameString (GHC.occName b) == "f" + fBind _ = False + + isExpectedDesugaring p = case find fBind p of + Just (GHC.NonRec _ (Let (GHC.NonRec b _) _)) + -> occNameString (GHC.occName b) == "z" + _ -> False + + coreProgram <- compileToCore "LocalBindingsDesugaring" inputSource + unless (isExpectedDesugaring coreProgram) $ + fail $ unlines $ + "Unexpected desugaring:" : map showPprQualified coreProgram + + compileToCore :: String -> String -> IO [GHC.CoreBind] compileToCore modName inputSource = do now <- getCurrentTime