[Git][ghc/ghc][wip/expand-do] 2 commits: new test outputs for T18324 and T22086

[Apoorv Ingle (@ani)]

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


Commits:
4523b344 by Apoorv Ingle at 2023-07-26T14:12:49-05:00
new test outputs for T18324 and T22086

- - - - -
2c24c037 by Apoorv Ingle at 2023-07-26T15:55:46-05:00
get locations right for bind statement expressions

- - - - -


5 changed files:

- compiler/GHC/Tc/Gen/App.hs
- testsuite/tests/typecheck/should_fail/DoExpansion2.hs
- testsuite/tests/typecheck/should_fail/DoExpansion2.stderr
- testsuite/tests/typecheck/should_run/T18324.stdout
- + testsuite/tests/typecheck/should_run/T22086.stdout


Changes:

=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -379,7 +379,8 @@ tcApp rn_expr exp_res_ty
                       addHeadCtxt fun_ctxt thing_inside
                  | otherwise
                  = do traceTc "tcApp" (vcat [text "no expansion", ppr rn_fun, ppr fun_ctxt])
-                      addFunResCtxt rn_fun rn_args app_res_rho exp_res_ty $
+                      setSrcSpan (appCtxtLoc fun_ctxt) $
+                        addFunResCtxt rn_fun rn_args app_res_rho exp_res_ty $
                         thing_inside
 
        -- Match up app_res_rho: the result type of rn_expr
@@ -838,9 +839,9 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside
                      addStmtCtxt ((text "addArgCtxt last 2e")) (unLoc stmt) $
                      thing_inside
 
-           VAExpansionStmt stmt@(L _ BindStmt {}) loc
+           VAExpansionStmt stmt@(L _ BindStmt {}) _
              -> do traceTc "addArgCtxt 2e bind" empty
-                   setSrcSpan loc $
+                   setSrcSpanA arg_loc $
                       addStmtCtxt ((text "addArgCtxt bind 2e")) (unLoc stmt) $
                      thing_inside
            VAExpansionStmt (L _ LetStmt {}) _


=====================================
testsuite/tests/typecheck/should_fail/DoExpansion2.hs
=====================================
@@ -6,7 +6,7 @@ module DoExpansion2 where
 getVal :: Int -> IO String
 getVal _ = return "x"
 
-ffff1, ffff2, ffff3, ffff4, ffff5, ffff6 :: IO Int
+ffff1, ffff2, ffff3, ffff4, ffff5, ffff6, ffff7, ffff8 :: IO Int
 
 
 ffff1 = do x <- getChar
@@ -29,3 +29,11 @@ ffff5 = do x <- getChar
 
 ffff6 = do _ <- (getVal 1)
            return ()         -- should error here
+
+
+ffff7 = do Just x <- getVal 3 4 -- should error here
+           return x
+
+
+ffff8 = do x <- getVal 3
+           return x   -- should error here


=====================================
testsuite/tests/typecheck/should_fail/DoExpansion2.stderr
=====================================
@@ -11,9 +11,10 @@ DoExpansion2.hs:16:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul
         Actual: String
     • In the first argument of ‘return’, namely ‘x’
       In a stmt of a 'do' block: return x
-      In the expression:
-        do x <- (getVal 3)
-           return x
+      In an equation for ‘ffff2’:
+          ffff2
+            = do x <- (getVal 3)
+                 return x
 
 DoExpansion2.hs:20:20: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
     • Couldn't match expected type ‘Int’ with actual type ‘Char’
@@ -39,15 +40,38 @@ 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
 
 DoExpansion2.hs:31:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
     • Couldn't match expected type ‘Int’ with actual type ‘()’
     • In the first argument of ‘return’, namely ‘()’
       In a stmt of a 'do' block: return ()
+      In an equation for ‘ffff6’:
+          ffff6
+            = do _ <- (getVal 1)
+                 return ()
+
+DoExpansion2.hs:34:22: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+    • Couldn't match expected type: t0 -> IO (Maybe Int)
+                  with actual type: IO String
+    • The function ‘getVal’ is applied to two value arguments,
+        but its type ‘Int -> IO String’ has only one
+      In a stmt of a 'do' block: Just x <- getVal 3 4
       In the expression:
-        do _ <- (getVal 1)
-           return ()
+        do Just x <- getVal 3 4
+           return x
+
+DoExpansion2.hs:39:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
+    • Couldn't match type ‘[Char]’ with ‘Int’
+      Expected: Int
+        Actual: String
+    • In the first argument of ‘return’, namely ‘x’
+      In a stmt of a 'do' block: return x
+      In an equation for ‘ffff8’:
+          ffff8
+            = do x <- getVal 3
+                 return x


=====================================
testsuite/tests/typecheck/should_run/T18324.stdout
=====================================
@@ -1 +1,2 @@
 (True,3)
+(True,3)


=====================================
testsuite/tests/typecheck/should_run/T22086.stdout
=====================================
@@ -0,0 +1,4 @@
+CallStack (from HasCallStack):
+  a do statement, called at T22086.hs:15:5 in main:Main
+CallStack (from HasCallStack):
+  >>, called at T22086.hs:19:11 in main:Main



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5916867163003619fe52b5c6730fbfcf37721bff...2c24c03761c4fea50bc76ce9cfe392e4e837d172

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5916867163003619fe52b5c6730fbfcf37721bff...2c24c03761c4fea50bc76ce9cfe392e4e837d172
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/20230726/a3dec8e3/attachment-0001.html>