[Git][ghc/ghc][wip/expand-do] - fixing tests for do expansion
Apoorv Ingle (@ani)
gitlab at gitlab.haskell.org
Mon Jul 24 04:40:22 UTC 2023
Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC
Commits:
25fed7b3 by Apoorv Ingle at 2023-07-23T23:40:08-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
=====================================
@@ -224,13 +224,13 @@ tcExpr (XExpr (PopErrCtxt (L loc e))) res_ty
setSrcSpanA l $
addStmtCtxt (text "tcExpr last stmt") stmt $
tcExpr expanded_expr res_ty
- | XExpr (ExpandedStmt (HsExpanded stmt expanded_expr)) <- e
- , L l (LetStmt{}) <- stmt
+ | XExpr (ExpandedStmt (HsExpanded stmt _)) <- e
+ , 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/25fed7b3b5c9efb49e42ec57d5ade4e45cfe892a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25fed7b3b5c9efb49e42ec57d5ade4e45cfe892a
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/766daa1d/attachment-0001.html>
More information about the ghc-commits
mailing list