[Git][ghc/ghc][wip/expand-do] - fixing tests for do expansion

Apoorv Ingle (@ani) gitlab at gitlab.haskell.org
Mon Jul 24 04:14:42 UTC 2023



Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC


Commits:
9276c721 by Apoorv Ingle at 2023-07-23T23:14:05-05:00
- fixing tests for do expansion

- - - - -


12 changed files:

- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Types/Basic.hs
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.stderr
- testsuite/tests/safeHaskell/safeLanguage/SafeLang10.stderr
- testsuite/tests/safeHaskell/safeLanguage/SafeLang17.stderr
- testsuite/tests/typecheck/should_fail/DoExpansion2.stderr
- testsuite/tests/typecheck/should_fail/DoExpansion3.hs
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/typecheck/should_fail/tcfail165.hs
- − testsuite/tests/typecheck/should_fail/tcfail165.stderr


Changes:

=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -228,9 +228,9 @@ tcExpr (XExpr (PopErrCtxt (L loc e))) res_ty
   , L l (LetStmt{}) <- stmt
   = do traceTc "tcExpr" (text "PopErrCtxt let stmt")
        popErrCtxt $
-         setSrcSpanA l $
-         addStmtCtxt (text "tcExpr last stmt") stmt $
-         tcExpr expanded_expr res_ty
+         setSrcSpanA loc $
+         -- addStmtCtxt (text "tcExpr let stmt") stmt $
+         tcExpr e res_ty
                 -- It is important that we call tcExpr and not tcApp here as
                 -- `e` is just the last statement's body expression
                 -- This improves error messages e.g. T18324b.hs


=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -1557,7 +1557,7 @@ addExprCtxt :: SDoc -> HsExpr GhcRn -> TcRn a -> TcRn a
 addExprCtxt doc e thing_inside
   = case e of
       HsUnboundVar {} -> thing_inside
-      XExpr (ExpandedStmt (HsExpanded stmt _)) -> addStmtCtxt doc stmt thing_inside
+      --- XExpr (ExpandedStmt (HsExpanded stmt _)) -> addStmtCtxt doc stmt thing_inside
       _ -> addErrCtxt (exprCtxt doc e) thing_inside
    -- The HsUnboundVar special case addresses situations like
    --    f x = _


=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -1447,8 +1447,8 @@ The expanded version (performed by expand_do_stmts) looks as follows:
 
 The points to consider are:
 1. Generating appropriate type error messages that blame the correct source spans
-2. Generate appropriate warnings for discarded results, eg. say g p :: m Int
-3. Decorate an expression a fail block if the pattern match is irrefutable
+2. Generate appropriate warnings for discarded results in a body statement eg. say g p :: m Int
+3. Decorate an expression a fail block if the pattern match is not irrefutable
 
 
 TODO expand using examples


=====================================
compiler/GHC/Types/Basic.hs
=====================================
@@ -595,6 +595,9 @@ isGenerated :: Origin -> Bool
 isGenerated Generated {} = True
 isGenerated FromSource   = False
 
+-- | Why was the piece of code generated?
+--
+-- See Note [Expanding HsDo with HsExpansion].
 data GenReason = DoExpansion
                | OtherExpansion
                deriving (Eq, Data)


=====================================
testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.stderr
=====================================
@@ -4,7 +4,4 @@ RecordDotSyntaxFail9.hs:7:11: error: [GHC-18872]
         arising from selecting the field ‘foo’
     • In the expression: a.foo :: String
       In a pattern binding: _ = a.foo :: String
-      In the expression:
-        do let a = ...
-           let _ = ...
-           undefined
+      In a stmt of a 'do' block: let _ = a.foo :: String


=====================================
testsuite/tests/safeHaskell/safeLanguage/SafeLang10.stderr
=====================================
@@ -14,7 +14,4 @@ SafeLang10.hs:9:13: error: [GHC-36705]
         instance Pos [a] -- Defined at SafeLang10_A.hs:14:10
     • In the expression: res [(1 :: Int)]
       In an equation for ‘r’: r = res [(1 :: Int)]
-      In the expression:
-        do let r = res ...
-           putStrLn $ "Result: " ++ show r
-           putStrLn $ "Result: " ++ show function
+      In a stmt of a 'do' block: let r = res [(1 :: Int)]


=====================================
testsuite/tests/safeHaskell/safeLanguage/SafeLang17.stderr
=====================================
@@ -14,7 +14,4 @@ SafeLang17.hs:9:13: error: [GHC-36705]
         instance Pos [a] -- Defined at SafeLang17_A.hs:14:10
     • In the expression: res [(1 :: Int)]
       In an equation for ‘r’: r = res [(1 :: Int)]
-      In the expression:
-        do let r = res ...
-           putStrLn $ "Result: " ++ show r
-           putStrLn $ "Result: " ++ show function
+      In a stmt of a 'do' block: let r = res [(1 :: Int)]


=====================================
testsuite/tests/typecheck/should_fail/DoExpansion2.stderr
=====================================
@@ -39,7 +39,8 @@ DoExpansion2.hs:27:12: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul
     • Couldn't match expected type ‘Char’ with actual type ‘Maybe Int’
     • In the pattern: Just x
       In a stmt of a 'do' block: Just x <- getChar
-      In the expression:
-        do x <- getChar
-           Just x <- getChar
-           return x
+      In an equation for ‘ffff5’:
+          ffff5
+            = do x <- getChar
+                 Just x <- getChar
+                 return x


=====================================
testsuite/tests/typecheck/should_fail/DoExpansion3.hs
=====================================
@@ -6,7 +6,7 @@ module DoExpansion3 where
 getVal :: Int -> IO String
 getVal _ = return "x"
 
-gggg1, gggg2, gggg3, gggg4 :: IO Int
+gggg1, gggg2, gggg3, gggg4, gggg5 :: IO Int
 
 
 gggg1 = do let x = 1
@@ -26,3 +26,8 @@ gggg3 = do x <- getChar
 
 gggg4 = do Just x <- getChar -- should error here
            return x
+
+gggg5 = do
+  let z :: Int = 3
+  let a = 1
+  putStrLn $ a + ""


=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -146,7 +146,7 @@ test('tcfail160', normal, compile_fail, [''])
 test('tcfail161', normal, compile_fail, [''])
 test('tcfail162', normal, compile_fail, [''])
 test('tcfail164', normal, compile_fail, [''])
-test('tcfail165', normal, compile_fail, [''])
+test('tcfail165', normal, compile, [''])
 test('tcfail166', normal, compile_fail, [''])
 test('tcfail167', normal, compile_fail, ['-Werror'])
 test('tcfail168', normal, compile_fail, [''])


=====================================
testsuite/tests/typecheck/should_fail/tcfail165.hs
=====================================
@@ -14,6 +14,8 @@ import Control.Concurrent
 -- With the Visible Type Application patch, this succeeds again.
 --
 -- Sept 16: fails again as it should
+--
+-- DoExpansion makes it pass again. RAE says this should be okay
 
 foo = do var <- newEmptyMVar :: IO (MVar (forall a. Show a => a -> String))
          putMVar var (show :: forall b. Show b => b -> String)


=====================================
testsuite/tests/typecheck/should_fail/tcfail165.stderr deleted
=====================================
@@ -1,17 +0,0 @@
-
-tcfail165.hs:18:17: error: [GHC-83865]
-    • Couldn't match type: forall a. Show a => a -> String
-                     with: b0 -> String
-      Expected: IO (MVar (b0 -> String))
-        Actual: IO (MVar (forall a. Show a => a -> String))
-    • In a stmt of a 'do' block:
-        var <- newEmptyMVar :: IO (MVar (forall a. Show a => a -> String))
-      In the expression:
-        do var <- newEmptyMVar ::
-                    IO (MVar (forall a. Show a => a -> String))
-           putMVar var (show :: forall b. Show b => b -> String)
-      In an equation for ‘foo’:
-          foo
-            = do var <- newEmptyMVar ::
-                          IO (MVar (forall a. Show a => a -> String))
-                 putMVar var (show :: forall b. Show b => b -> String)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9276c72152e0c6c16686ca08f08d45dff477938e

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9276c72152e0c6c16686ca08f08d45dff477938e
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/20230724/94dedf86/attachment-0001.html>


More information about the ghc-commits mailing list