diff options
Diffstat (limited to 'testsuite/tests')
44 files changed, 91 insertions, 95 deletions
diff --git a/testsuite/tests/codeGen/should_run/cgrun025.hs b/testsuite/tests/codeGen/should_run/cgrun025.hs index 39255c147d..522116b3a6 100644 --- a/testsuite/tests/codeGen/should_run/cgrun025.hs +++ b/testsuite/tests/codeGen/should_run/cgrun025.hs @@ -22,4 +22,4 @@ main = do file_cts <- readFile (head args) hPutStr stderr file_cts trace "hello, trace" $ - catch (getEnv "__WURBLE__" >> return ()) (\ (e :: SomeException) -> error "hello, error") + catch (getEnv "__WURBLE__" >> return ()) (\ (e :: SomeExceptionWithLocation) -> error "hello, error") diff --git a/testsuite/tests/codeGen/should_run/cgrun025.stderr b/testsuite/tests/codeGen/should_run/cgrun025.stderr index 35ad64c79c..cf09b76c2b 100644 --- a/testsuite/tests/codeGen/should_run/cgrun025.stderr +++ b/testsuite/tests/codeGen/should_run/cgrun025.stderr @@ -25,7 +25,7 @@ main = do file_cts <- readFile (head args) hPutStr stderr file_cts trace "hello, trace" $ - catch (getEnv "__WURBLE__" >> return ()) (\ (e :: SomeException) -> error "hello, error") + catch (getEnv "__WURBLE__" >> return ()) (\ (e :: SomeExceptionWithLocation) -> error "hello, error") hello, trace cgrun025: hello, error CallStack (from HasCallStack): diff --git a/testsuite/tests/codeGen/should_run/cgrun057.hs b/testsuite/tests/codeGen/should_run/cgrun057.hs index 98f90db15a..ea4636d169 100644 --- a/testsuite/tests/codeGen/should_run/cgrun057.hs +++ b/testsuite/tests/codeGen/should_run/cgrun057.hs @@ -1,6 +1,6 @@ -- For testing +RTS -xc import Control.Exception -main = try (evaluate (f ())) :: IO (Either SomeException ()) +main = try (evaluate (f ())) :: IO (Either SomeExceptionWithLocation ()) f x = g x diff --git a/testsuite/tests/concurrent/should_run/T3279.hs b/testsuite/tests/concurrent/should_run/T3279.hs index b721a6113c..a5ac0d7497 100644 --- a/testsuite/tests/concurrent/should_run/T3279.hs +++ b/testsuite/tests/concurrent/should_run/T3279.hs @@ -7,14 +7,14 @@ import GHC.IO (unsafeUnmask) f :: Int f = (1 +) . unsafePerformIO $ do - throwIO (ErrorCall "foo") `catch` \(SomeException e) -> do + throwIO (ErrorCall "foo") `catch` \(SomeExceptionWithLocation e) -> do myThreadId >>= flip throwTo e -- point X unsafeUnmask $ return 1 main :: IO () main = do - evaluate f `catch` \(SomeException e) -> return 0 + evaluate f `catch` \(SomeExceptionWithLocation e) -> return 0 -- the evaluation of 'x' is now suspended at point X tid <- mask_ $ forkIO (evaluate f >> return ()) killThread tid @@ -22,4 +22,3 @@ main = do yield -- should print 1 + 1 = 2 print f - diff --git a/testsuite/tests/concurrent/should_run/T5238.hs b/testsuite/tests/concurrent/should_run/T5238.hs index 1de60c4e80..5f85753db2 100644 --- a/testsuite/tests/concurrent/should_run/T5238.hs +++ b/testsuite/tests/concurrent/should_run/T5238.hs @@ -7,6 +7,6 @@ import GHC.Conc main = do ms1 ← getMaskingState atomically $ (throwSTM Overflow) `catchSTM` - (\(e ∷ SomeException) → return ()) + (\(e ∷ SomeExceptionWithLocation) → return ()) ms2 ← getMaskingState putStrLn $ show (ms1, ms2) diff --git a/testsuite/tests/concurrent/should_run/T7970.hs b/testsuite/tests/concurrent/should_run/T7970.hs index 986cb66b27..003ae4da06 100644 --- a/testsuite/tests/concurrent/should_run/T7970.hs +++ b/testsuite/tests/concurrent/should_run/T7970.hs @@ -15,6 +15,6 @@ main = do m <- newEmptyMVar check takeMVar m `catch` \ex -> do - putStrLn $ "caught exception: " ++ show (ex :: SomeException) + putStrLn $ "caught exception: " ++ show (ex :: SomeExceptionWithLocation) check readIORef ref >>= print diff --git a/testsuite/tests/concurrent/should_run/allocLimit3.hs b/testsuite/tests/concurrent/should_run/allocLimit3.hs index 28881dc016..bdebf3cde1 100644 --- a/testsuite/tests/concurrent/should_run/allocLimit3.hs +++ b/testsuite/tests/concurrent/should_run/allocLimit3.hs @@ -12,4 +12,4 @@ main = do -- result, and then immediately raise the exception r <- mask_ $ try $ print (length [1..100000]) - print (r :: Either SomeException ()) + print (r :: Either SomeExceptionWithLocation ()) diff --git a/testsuite/tests/concurrent/should_run/async001.hs b/testsuite/tests/concurrent/should_run/async001.hs index 7d765e26f9..777ecf92c3 100644 --- a/testsuite/tests/concurrent/should_run/async001.hs +++ b/testsuite/tests/concurrent/should_run/async001.hs @@ -8,7 +8,7 @@ import System.IO.Unsafe -- 'onException'. main = do - let x = unsafePerformIO $ + let x = unsafePerformIO $ (do threadDelay 1000000; return 42) `onException` return () @@ -16,4 +16,4 @@ main = do threadDelay 1000 killThread t - print x `E.catch` \e -> putStrLn ("main caught: " ++ show (e::SomeException)) + print x `E.catch` \e -> putStrLn ("main caught: " ++ show (e::SomeExceptionWithLocation)) diff --git a/testsuite/tests/concurrent/should_run/conc008.hs b/testsuite/tests/concurrent/should_run/conc008.hs index 66a4b5f973..6bdc14508d 100644 --- a/testsuite/tests/concurrent/should_run/conc008.hs +++ b/testsuite/tests/concurrent/should_run/conc008.hs @@ -6,7 +6,7 @@ import Control.Exception -- Send ourselves a KillThread signal, catch it and recover. -main = do +main = do id <- myThreadId Control.Exception.catch (killThread id) $ - \e -> putStr (show (e::SomeException)) + \e -> putStr (show (e::SomeExceptionWithLocation)) diff --git a/testsuite/tests/concurrent/should_run/conc010.hs b/testsuite/tests/concurrent/should_run/conc010.hs index 21ced56f5a..1b037dc4d6 100644 --- a/testsuite/tests/concurrent/should_run/conc010.hs +++ b/testsuite/tests/concurrent/should_run/conc010.hs @@ -22,7 +22,7 @@ main = do ready <- newEmptyMVar ready2 <- newEmptyMVar id <- forkIO (Control.Exception.catch (putMVar ready () >> takeMVar block) - (\e -> putStr (show (e::SomeException)) >> putMVar ready2 ())) + (\e -> putStr (show (e::SomeExceptionWithLocation)) >> putMVar ready2 ())) takeMVar ready throwTo id (ErrorCall "hello") takeMVar ready2 diff --git a/testsuite/tests/concurrent/should_run/conc012.hs b/testsuite/tests/concurrent/should_run/conc012.hs index 9a94351ed6..e41744e49f 100644 --- a/testsuite/tests/concurrent/should_run/conc012.hs +++ b/testsuite/tests/concurrent/should_run/conc012.hs @@ -4,7 +4,7 @@ import Control.Concurrent import Control.Exception --import GlaExts -data Result = Died SomeException | Finished +data Result = Died SomeExceptionWithLocation | Finished -- Test stack overflow catching. Should print "Died: stack overflow". diff --git a/testsuite/tests/concurrent/should_run/conc014.hs b/testsuite/tests/concurrent/should_run/conc014.hs index 8078f9907c..23c464ccc9 100644 --- a/testsuite/tests/concurrent/should_run/conc014.hs +++ b/testsuite/tests/concurrent/should_run/conc014.hs @@ -14,7 +14,7 @@ main = do do putMVar m (); evaluate (sum [1..10000]); putStrLn "done.") ; myDelay 500000 }) `Control.Exception.catch` - \e -> putStrLn ("caught: " ++ show (e::SomeException)) + \e -> putStrLn ("caught: " ++ show (e::SomeExceptionWithLocation)) -- compensate for the fact that threadDelay is non-interruptible -- on Windows with the threaded RTS in 6.6. @@ -22,4 +22,3 @@ myDelay usec = do m <- newEmptyMVar forkIO $ do threadDelay usec; putMVar m () takeMVar m - diff --git a/testsuite/tests/concurrent/should_run/conc015.hs b/testsuite/tests/concurrent/should_run/conc015.hs index e7215097ca..8c102fa0c8 100644 --- a/testsuite/tests/concurrent/should_run/conc015.hs +++ b/testsuite/tests/concurrent/should_run/conc015.hs @@ -27,13 +27,13 @@ main = do sum [1..1] `seq` -- give 'foo' a chance to be raised (restore $ myDelay 500000) `Control.Exception.catch` - \e -> putStrLn ("caught1: " ++ show (e::SomeException)) + \e -> putStrLn ("caught1: " ++ show (e::SomeExceptionWithLocation)) threadDelay 10000 takeMVar m2 ) `Control.Exception.catch` \e -> do print =<< getMaskingState - putStrLn ("caught2: " ++ show (e::SomeException)) + putStrLn ("caught2: " ++ show (e::SomeExceptionWithLocation)) -- compensate for the fact that threadDelay is non-interruptible -- on Windows with the threaded RTS in 6.6. diff --git a/testsuite/tests/concurrent/should_run/conc015a.hs b/testsuite/tests/concurrent/should_run/conc015a.hs index a6a55c12cd..641a7fbc0c 100644 --- a/testsuite/tests/concurrent/should_run/conc015a.hs +++ b/testsuite/tests/concurrent/should_run/conc015a.hs @@ -30,14 +30,14 @@ main = do sum [1..100000] `seq` -- give 'foo' a chance to be raised (restore (myDelay 500000) `Control.Exception.catch` - \e -> putStrLn ("caught1: " ++ show (e::SomeException))) + \e -> putStrLn ("caught1: " ++ show (e::SomeExceptionWithLocation))) threadDelay 10000 takeMVar m2 ) `Control.Exception.catch` \e -> do print =<< getMaskingState - putStrLn ("caught2: " ++ show (e::SomeException)) + putStrLn ("caught2: " ++ show (e::SomeExceptionWithLocation)) -- compensate for the fact that threadDelay is non-interruptible -- on Windows with the threaded RTS in 6.6. diff --git a/testsuite/tests/concurrent/should_run/conc017.hs b/testsuite/tests/concurrent/should_run/conc017.hs index 69c171732e..f80531633f 100644 --- a/testsuite/tests/concurrent/should_run/conc017.hs +++ b/testsuite/tests/concurrent/should_run/conc017.hs @@ -24,17 +24,17 @@ main = do myDelay 100000 ) ) `Control.Exception.catch` - \e -> putStrLn ("caught1: " ++ show (e::SomeException)) + \e -> putStrLn ("caught1: " ++ show (e::SomeExceptionWithLocation)) putMVar m2 () -- blocked here, "bar" can't be delivered (sum [1..10000] `seq` return ()) `Control.Exception.catch` - \e -> putStrLn ("caught2: " ++ show (e::SomeException)) + \e -> putStrLn ("caught2: " ++ show (e::SomeExceptionWithLocation)) -- unblocked here, "bar" delivered to "caught3" takeMVar m3 ) `Control.Exception.catch` - \e -> putStrLn ("caught3: " ++ show (e::SomeException)) + \e -> putStrLn ("caught3: " ++ show (e::SomeExceptionWithLocation)) -- compensate for the fact that threadDelay is non-interruptible -- on Windows with the threaded RTS in 6.6. diff --git a/testsuite/tests/concurrent/should_run/conc017a.hs b/testsuite/tests/concurrent/should_run/conc017a.hs index 69c171732e..f80531633f 100644 --- a/testsuite/tests/concurrent/should_run/conc017a.hs +++ b/testsuite/tests/concurrent/should_run/conc017a.hs @@ -24,17 +24,17 @@ main = do myDelay 100000 ) ) `Control.Exception.catch` - \e -> putStrLn ("caught1: " ++ show (e::SomeException)) + \e -> putStrLn ("caught1: " ++ show (e::SomeExceptionWithLocation)) putMVar m2 () -- blocked here, "bar" can't be delivered (sum [1..10000] `seq` return ()) `Control.Exception.catch` - \e -> putStrLn ("caught2: " ++ show (e::SomeException)) + \e -> putStrLn ("caught2: " ++ show (e::SomeExceptionWithLocation)) -- unblocked here, "bar" delivered to "caught3" takeMVar m3 ) `Control.Exception.catch` - \e -> putStrLn ("caught3: " ++ show (e::SomeException)) + \e -> putStrLn ("caught3: " ++ show (e::SomeExceptionWithLocation)) -- compensate for the fact that threadDelay is non-interruptible -- on Windows with the threaded RTS in 6.6. diff --git a/testsuite/tests/concurrent/should_run/conc018.hs b/testsuite/tests/concurrent/should_run/conc018.hs index 7caf32613e..ea89a8f30f 100644 --- a/testsuite/tests/concurrent/should_run/conc018.hs +++ b/testsuite/tests/concurrent/should_run/conc018.hs @@ -21,6 +21,6 @@ main = do m <- newMVar () putMVar m () ) - (\e -> putMVar m (e::SomeException)) + (\e -> putMVar m (e::SomeExceptionWithLocation)) takeMVar m >>= print -- should print "thread blocked indefinitely" diff --git a/testsuite/tests/concurrent/should_run/conc019.hs b/testsuite/tests/concurrent/should_run/conc019.hs index 9804657aab..b514ce2675 100644 --- a/testsuite/tests/concurrent/should_run/conc019.hs +++ b/testsuite/tests/concurrent/should_run/conc019.hs @@ -7,7 +7,7 @@ import System.Mem main = do forkIO (Control.Exception.catch (do { m <- newEmptyMVar; takeMVar m }) - $ \e -> putStrLn ("caught: " ++ show (e::SomeException))) + $ \e -> putStrLn ("caught: " ++ show (e::SomeExceptionWithLocation))) threadDelay 10000 System.Mem.performGC threadDelay 10000 diff --git a/testsuite/tests/concurrent/should_run/conc024.hs b/testsuite/tests/concurrent/should_run/conc024.hs index 7d8662ae08..e7f9b38033 100644 --- a/testsuite/tests/concurrent/should_run/conc024.hs +++ b/testsuite/tests/concurrent/should_run/conc024.hs @@ -10,6 +10,6 @@ import System.Mem main = do id <- myThreadId forkIO (catch (do m <- newEmptyMVar; takeMVar m) - (\e -> throwTo id (e::SomeException))) + (\e -> throwTo id (e::SomeExceptionWithLocation))) catch (do yield; performGC; threadDelay 1000000) - (\e -> print (e::SomeException)) + (\e -> print (e::SomeExceptionWithLocation)) diff --git a/testsuite/tests/concurrent/should_run/conc033.hs b/testsuite/tests/concurrent/should_run/conc033.hs index 47c46d366f..06e78ddbff 100644 --- a/testsuite/tests/concurrent/should_run/conc033.hs +++ b/testsuite/tests/concurrent/should_run/conc033.hs @@ -7,4 +7,4 @@ main = do m <- newEmptyMVar takeMVar m return () - print (r::Either SomeException ()) + print (r::Either SomeExceptionWithLocation ()) diff --git a/testsuite/tests/concurrent/should_run/conc035.hs b/testsuite/tests/concurrent/should_run/conc035.hs index 328b0f3307..e78794bf08 100644 --- a/testsuite/tests/concurrent/should_run/conc035.hs +++ b/testsuite/tests/concurrent/should_run/conc035.hs @@ -13,7 +13,7 @@ trapHandler inVar caughtVar = `E.catch` (trapExc inVar caughtVar) -trapExc :: MVar Int -> MVar () -> E.SomeException -> IO () +trapExc :: MVar Int -> MVar () -> E.SomeExceptionWithLocation -> IO () -- If we have been killed then we are done trapExc inVar caughtVar e | Just E.ThreadKilled <- E.fromException e = return () diff --git a/testsuite/tests/concurrent/should_run/conc073.hs b/testsuite/tests/concurrent/should_run/conc073.hs index 64d9d998a6..5957334add 100644 --- a/testsuite/tests/concurrent/should_run/conc073.hs +++ b/testsuite/tests/concurrent/should_run/conc073.hs @@ -8,7 +8,7 @@ main = do mask_ $ return () throwIO (ErrorCall "test") `catch` \e -> do - let _ = e::SomeException + let _ = e::SomeExceptionWithLocation print =<< getMaskingState putMVar m1 () takeMVar m2 diff --git a/testsuite/tests/concurrent/should_run/mask002.hs b/testsuite/tests/concurrent/should_run/mask002.hs index 069af8f2fc..b8d3012927 100644 --- a/testsuite/tests/concurrent/should_run/mask002.hs +++ b/testsuite/tests/concurrent/should_run/mask002.hs @@ -9,12 +9,12 @@ main = do m <- newEmptyMVar t1 <- mask_ $ forkIO $ do takeMVar m `catch` \e -> do stat 1 MaskedInterruptible - print (e::SomeException) + print (e::SomeExceptionWithLocation) throwIO e killThread t1 t2 <- uninterruptibleMask_ $ forkIO $ do takeMVar m `catch` \e -> do stat 2 MaskedUninterruptible - print (e::SomeException) + print (e::SomeExceptionWithLocation) throwIO e killThread t2 t3 <- mask_ $ forkIOWithUnmask $ \unmask -> @@ -25,9 +25,8 @@ main = do takeMVar m stat :: Int -> MaskingState -> IO () -stat n m = do +stat n m = do s <- getMaskingState - if (s /= m) + if (s /= m) then error (printf "%2d: %s\n" n (show s)) else return () - diff --git a/testsuite/tests/concurrent/should_run/throwto002.hs b/testsuite/tests/concurrent/should_run/throwto002.hs index eaaae0c0cb..cf6b0d0e30 100644 --- a/testsuite/tests/concurrent/should_run/throwto002.hs +++ b/testsuite/tests/concurrent/should_run/throwto002.hs @@ -20,4 +20,4 @@ thread restore r t = run run = (restore $ forever $ do killThread t i <- atomicModifyIORef r (\i -> (i + 1, i)) evaluate i) - `catch` \(e::SomeException) -> run + `catch` \(e::SomeExceptionWithLocation) -> run diff --git a/testsuite/tests/concurrent/should_run/throwto003.hs b/testsuite/tests/concurrent/should_run/throwto003.hs index 37540cc68a..500a6fb329 100644 --- a/testsuite/tests/concurrent/should_run/throwto003.hs +++ b/testsuite/tests/concurrent/should_run/throwto003.hs @@ -11,6 +11,6 @@ main = do takeMVar m thread restore m = run - where + where run = (restore $ forever $ modifyMVar_ m $ \v -> if v `mod` 2 == 1 then return (v*2) else return (v-1)) - `catch` \(e::SomeException) -> run + `catch` \(e::SomeExceptionWithLocation) -> run diff --git a/testsuite/tests/deSugar/should_run/T246.hs b/testsuite/tests/deSugar/should_run/T246.hs index 2845db3ab0..f791cdb3c0 100644 --- a/testsuite/tests/deSugar/should_run/T246.hs +++ b/testsuite/tests/deSugar/should_run/T246.hs @@ -21,5 +21,5 @@ main = do { print (f funny) -- Should work, because we test ; Control.Exception.catch (print (g funny)) -- Should fail, because we test - (\(_::SomeException) -> print "caught") -- x first, and hit "undefined" + (\(_::SomeExceptionWithLocation) -> print "caught") -- x first, and hit "undefined" } diff --git a/testsuite/tests/dependent/should_compile/dynamic-paper.hs b/testsuite/tests/dependent/should_compile/dynamic-paper.hs index eaba011625..41ff423f0a 100644 --- a/testsuite/tests/dependent/should_compile/dynamic-paper.hs +++ b/testsuite/tests/dependent/should_compile/dynamic-paper.hs @@ -268,10 +268,10 @@ delta ra x = case (eqT ra rt) of Nothing -> x loop = delta rt (MkT delta) -throw# :: SomeException -> a +throw# :: SomeExceptionWithLocation -> a -data SomeException where - SomeException :: Exception e => e -> SomeException +data SomeExceptionWithLocation where + SomeExceptionWithLocation :: Exception e => e -> SomeExceptionWithLocation class (Typeable e, Show e) => Exception e where { } diff --git a/testsuite/tests/ffi/should_run/IncallAffinity.hs b/testsuite/tests/ffi/should_run/IncallAffinity.hs index 386e9950e8..9b271e83c0 100644 --- a/testsuite/tests/ffi/should_run/IncallAffinity.hs +++ b/testsuite/tests/ffi/should_run/IncallAffinity.hs @@ -11,7 +11,7 @@ foreign export ccall "capTest" capTest :: IO Int capTest :: IO Int capTest = catch go handle where - handle :: SomeException -> IO Int + handle :: SomeExceptionWithLocation -> IO Int handle e = do putStrLn $ "Failed " ++ (show e) return (-1) diff --git a/testsuite/tests/ghc-api/T8628.hs b/testsuite/tests/ghc-api/T8628.hs index 3874d6ed68..c328dac77f 100644 --- a/testsuite/tests/ghc-api/T8628.hs +++ b/testsuite/tests/ghc-api/T8628.hs @@ -26,7 +26,7 @@ main , IIDecl (simpleImportDecl (mkModuleNameFS (fsLit "System.IO")))] runDecls "data X = Y ()" execStmt "print True" execOptions - MC.try $ execStmt "print (Y ())" execOptions :: GhcMonad m => m (Either SomeException ExecResult) + MC.try $ execStmt "print (Y ())" execOptions :: GhcMonad m => m (Either SomeExceptionWithLocation ExecResult) runDecls "data X = Y () deriving Show" _ <- dynCompileExpr "'x'" execStmt "print (Y ())" execOptions diff --git a/testsuite/tests/ghci.debugger/scripts/T8487.hs b/testsuite/tests/ghci.debugger/scripts/T8487.hs index d77738e3c9..7a277b1f9b 100644 --- a/testsuite/tests/ghci.debugger/scripts/T8487.hs +++ b/testsuite/tests/ghci.debugger/scripts/T8487.hs @@ -4,7 +4,7 @@ f = do ma <- try $ evaluate a x <- case ma of Right str -> return a - Left err -> return $ show (err :: SomeException) + Left err -> return $ show (err :: SomeExceptionWithLocation) putStrLn x where a :: String diff --git a/testsuite/tests/ghci.debugger/scripts/T8487.stdout b/testsuite/tests/ghci.debugger/scripts/T8487.stdout index ab7151a563..1bdd8d5740 100644 --- a/testsuite/tests/ghci.debugger/scripts/T8487.stdout +++ b/testsuite/tests/ghci.debugger/scripts/T8487.stdout @@ -1,4 +1,4 @@ -Breakpoint 0 activated at T8487.hs:(5,8)-(7,53) -Stopped in Main.f, T8487.hs:(5,8)-(7,53) +Breakpoint 0 activated at T8487.hs:(5,8)-(7,65) +Stopped in Main.f, T8487.hs:(5,8)-(7,65) _result :: IO String = _ -ma :: Either SomeException String = Left _ +ma :: Either SomeExceptionWithLocation String = Left _ diff --git a/testsuite/tests/ghci.debugger/scripts/break011.stdout b/testsuite/tests/ghci.debugger/scripts/break011.stdout index 47fb7b135d..93e6a8e3ec 100644 --- a/testsuite/tests/ghci.debugger/scripts/break011.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break011.stdout @@ -18,28 +18,28 @@ _result :: a Stopped at <unknown> _exception :: e already at the beginning of the history -_exception = SomeException +_exception = SomeExceptionWithLocation (ErrorCallWithLocation "foo" "CallStack (from HasCallStack): error, called at Test7.hs:2:18 in main:Main") _result :: a = _ -_exception :: SomeException = SomeException - (ErrorCallWithLocation - "foo" - "CallStack (from HasCallStack): +_exception :: SomeExceptionWithLocation = SomeExceptionWithLocation + (ErrorCallWithLocation + "foo" + "CallStack (from HasCallStack): error, called at Test7.hs:2:18 in main:Main") *** Exception: foo CallStack (from HasCallStack): error, called at Test7.hs:2:18 in main:Main Stopped in <exception thrown>, <unknown> -_exception :: e = SomeException +_exception :: e = SomeExceptionWithLocation (ErrorCallWithLocation "foo" "CallStack (from HasCallStack): error, called at Test7.hs:2:18 in main:Main") Stopped in <exception thrown>, <unknown> -_exception :: e = SomeException +_exception :: e = SomeExceptionWithLocation (ErrorCallWithLocation "foo" "CallStack (from HasCallStack): diff --git a/testsuite/tests/ghci.debugger/scripts/break024.stdout b/testsuite/tests/ghci.debugger/scripts/break024.stdout index 8c09cb5533..211b1cf348 100644 --- a/testsuite/tests/ghci.debugger/scripts/break024.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break024.stdout @@ -1,21 +1,21 @@ Left user error (error) Stopped in <exception thrown>, <unknown> _exception :: e = _ -_exception = SomeException +_exception = SomeExceptionWithLocation (GHC.IO.Exception.IOError Nothing GHC.IO.Exception.UserError [] "error" Nothing Nothing) *** Exception: user error (error) Stopped in <exception thrown>, <unknown> _exception :: e = _ -_exception = SomeException +_exception = SomeExceptionWithLocation (GHC.IO.Exception.IOError Nothing GHC.IO.Exception.UserError [] "error" Nothing Nothing) Stopped in <exception thrown>, <unknown> -_exception :: e = SomeException +_exception :: e = SomeExceptionWithLocation (GHC.IO.Exception.IOError Nothing GHC.IO.Exception.UserError ....) Stopped in <exception thrown>, <unknown> _exception :: e = _ -_exception = SomeException +_exception = SomeExceptionWithLocation (GHC.IO.Exception.IOError Nothing GHC.IO.Exception.UserError [] "error" Nothing Nothing) Left user error (error) diff --git a/testsuite/tests/ghci/should_run/T19628.hs b/testsuite/tests/ghci/should_run/T19628.hs index 74891c690f..db04211903 100644 --- a/testsuite/tests/ghci/should_run/T19628.hs +++ b/testsuite/tests/ghci/should_run/T19628.hs @@ -63,7 +63,7 @@ main = do print x2 print x3 print x4 - print x5 `catch` \(e::SomeException) -> putStrLn "x5: exception" - print x6 `catch` \(e::SomeException) -> putStrLn "x6: exception" + print x5 `catch` \(e::SomeExceptionWithLocation) -> putStrLn "x5: exception" + print x6 `catch` \(e::SomeExceptionWithLocation) -> putStrLn "x6: exception" print x7 print x8 diff --git a/testsuite/tests/indexed-types/should_fail/T5439.hs b/testsuite/tests/indexed-types/should_fail/T5439.hs index d5be550de5..5011e7d388 100644 --- a/testsuite/tests/indexed-types/should_fail/T5439.hs +++ b/testsuite/tests/indexed-types/should_fail/T5439.hs @@ -18,7 +18,7 @@ import Data.Typeable import Control.Exception data Attempt α = Success α - | ∀ e . Exception e ⇒ Failure e + | ∀ e . Exception e ⇒ Failure e data Inject f α = ∀ β . Inject (f β) (α → β) @@ -59,7 +59,7 @@ instance (Typeable n, Exception e) ⇒ Exception (NthException n e) instance WaitOp (WaitOps rs) where type WaitOpResult (WaitOps rs) = HElemOf rs - registerWaitOp ops ev = + registerWaitOp ops ev = let register ∷ ∀ n . HDropClass n rs ⇒ Bool → Peano n → WaitOps (HDrop n rs) → IO Bool register first n (WaitOp op) = do @@ -68,7 +68,7 @@ instance WaitOp (WaitOps rs) where t ← try $ registerWaitOp op (Inject ev $ inj n) r ← case t of Right r → return r - Left e → complete ev $ inj n $ Failure (e ∷ SomeException) + Left e → complete ev $ inj n $ Failure (e ∷ SomeExceptionWithLocation) return $ r || not first register first n (op :? ops') = do let inj n (Success r) = Success (HNth n r) @@ -80,7 +80,7 @@ instance WaitOp (WaitOps rs) where HTailDropComm → register False (PSucc n) ops' Right False → return $ not first Left e → do - c ← complete ev $ inj $ Failure (e ∷ SomeException) + c ← complete ev $ inj $ Failure (e ∷ SomeExceptionWithLocation) return $ c || not first in case waitOpsNonEmpty ops of HNonEmptyInst → register True PZero ops @@ -108,7 +108,7 @@ instance IsPeano PZero where peano = PZero instance IsPeano p ⇒ IsPeano (PSucc p) where - peano = PSucc peano + peano = PSucc peano class (n ~ PSucc (PPred n)) ⇒ PHasPred n where type PPred n @@ -252,4 +252,3 @@ type HNth n l = HHead (HDrop n l) data HElemOf l where HNth ∷ (HDropClass n l, HNonEmpty (HDrop n l)) ⇒ Peano n → HNth n l → HElemOf l - diff --git a/testsuite/tests/indexed-types/should_fail/T5439.stderr b/testsuite/tests/indexed-types/should_fail/T5439.stderr index fb38d71112..55785fbaf5 100644 --- a/testsuite/tests/indexed-types/should_fail/T5439.stderr +++ b/testsuite/tests/indexed-types/should_fail/T5439.stderr @@ -5,11 +5,11 @@ T5439.hs:83:33: error: -> Attempt (HElemOf l0) • Probable cause: ‘($)’ is applied to too few arguments In the second argument of ‘($)’, namely - ‘inj $ Failure (e :: SomeException)’ + ‘inj $ Failure (e :: SomeExceptionWithLocation)’ In a stmt of a 'do' block: - c <- complete ev $ inj $ Failure (e :: SomeException) + c <- complete ev $ inj $ Failure (e :: SomeExceptionWithLocation) In the expression: - do c <- complete ev $ inj $ Failure (e :: SomeException) + do c <- complete ev $ inj $ Failure (e :: SomeExceptionWithLocation) return $ c || not first • Relevant bindings include register :: Bool -> Peano n -> WaitOps (HDrop n rs) -> IO Bool @@ -25,8 +25,8 @@ T5439.hs:83:39: error: • Couldn't match expected type: Peano n0 with actual type: Attempt α0 • In the second argument of ‘($)’, namely - ‘Failure (e :: SomeException)’ + ‘Failure (e :: SomeExceptionWithLocation)’ In the second argument of ‘($)’, namely - ‘inj $ Failure (e :: SomeException)’ + ‘inj $ Failure (e :: SomeExceptionWithLocation)’ In a stmt of a 'do' block: - c <- complete ev $ inj $ Failure (e :: SomeException) + c <- complete ev $ inj $ Failure (e :: SomeExceptionWithLocation) diff --git a/testsuite/tests/numeric/should_run/arith011.hs b/testsuite/tests/numeric/should_run/arith011.hs index e00caad19a..95a2f5f6da 100644 --- a/testsuite/tests/numeric/should_run/arith011.hs +++ b/testsuite/tests/numeric/should_run/arith011.hs @@ -122,7 +122,7 @@ table2 nm op xs ys = do where op' x y = do s <- Control.Exception.catch (evaluate (show (op x y))) - (\e -> return (show (e :: SomeException))) + (\e -> return (show (e :: SomeExceptionWithLocation))) putStrLn (show x ++ " " ++ nm ++ " " ++ show y ++ " = " ++ s) testReadShow zero = do diff --git a/testsuite/tests/printer/PprDynamic.hs b/testsuite/tests/printer/PprDynamic.hs index 5134d8b067..e54fcc1bc4 100644 --- a/testsuite/tests/printer/PprDynamic.hs +++ b/testsuite/tests/printer/PprDynamic.hs @@ -252,10 +252,10 @@ delta ra x = case (eqT ra rt) of Nothing -> x loop = delta rt (MkT delta) -throw# :: SomeException -> a +throw# :: SomeExceptionWithLocation -> a -data SomeException where - SomeException :: Exception e => e -> SomeException +data SomeExceptionWithLocation where + SomeExceptionWithLocation :: Exception e => e -> SomeExceptionWithLocation class (Typeable e, Show e) => Exception e where { } diff --git a/testsuite/tests/rename/should_compile/T11167.hs b/testsuite/tests/rename/should_compile/T11167.hs index 644cc90bed..b7d7940d03 100644 --- a/testsuite/tests/rename/should_compile/T11167.hs +++ b/testsuite/tests/rename/should_compile/T11167.hs @@ -1,21 +1,21 @@ module T11167 where -data SomeException +data SomeExceptionWithLocation newtype ContT r m a = ContT {runContT :: (a -> m r) -> m r} runContT' :: ContT r m a -> (a -> m r) -> m r runContT' = runContT -catch_ :: IO a -> (SomeException -> IO a) -> IO a +catch_ :: IO a -> (SomeExceptionWithLocation -> IO a) -> IO a catch_ = undefined foo :: IO () foo = (undefined :: ContT () IO a) `runContT` (undefined :: a -> IO ()) - `catch_` (undefined :: SomeException -> IO ()) + `catch_` (undefined :: SomeExceptionWithLocation -> IO ()) foo' :: IO () foo' = (undefined :: ContT () IO a) `runContT'` (undefined :: a -> IO ()) - `catch_` (undefined :: SomeException -> IO ()) + `catch_` (undefined :: SomeExceptionWithLocation -> IO ()) diff --git a/testsuite/tests/rename/should_fail/T11167_ambig.hs b/testsuite/tests/rename/should_fail/T11167_ambig.hs index 74df05e5ee..fa7d51aa87 100644 --- a/testsuite/tests/rename/should_fail/T11167_ambig.hs +++ b/testsuite/tests/rename/should_fail/T11167_ambig.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DuplicateRecordFields #-} module T11167_ambig where -data SomeException +data SomeExceptionWithLocation newtype ContT r m a = ContT {runContT :: (a -> m r) -> m r} newtype ContT' r m a = ContT' {runContT :: (a -> m r) -> m r} @@ -9,15 +9,15 @@ newtype ContT' r m a = ContT' {runContT :: (a -> m r) -> m r} runContT' :: ContT r m a -> (a -> m r) -> m r runContT' = runContT -catch_ :: IO a -> (SomeException -> IO a) -> IO a +catch_ :: IO a -> (SomeExceptionWithLocation -> IO a) -> IO a catch_ = undefined foo :: IO () foo = (undefined :: ContT () IO a) `runContT` (undefined :: a -> IO ()) - `catch_` (undefined :: SomeException -> IO ()) + `catch_` (undefined :: SomeExceptionWithLocation -> IO ()) foo' :: IO () foo' = (undefined :: ContT () IO a) `runContT'` (undefined :: a -> IO ()) - `catch_` (undefined :: SomeException -> IO ()) + `catch_` (undefined :: SomeExceptionWithLocation -> IO ()) diff --git a/testsuite/tests/rts/T8035.hs b/testsuite/tests/rts/T8035.hs index 73afc7f205..7065f43ca0 100644 --- a/testsuite/tests/rts/T8035.hs +++ b/testsuite/tests/rts/T8035.hs @@ -7,4 +7,4 @@ import GHC.Conc main = join $ atomically $ do catchSTM (throwSTM ThreadKilled `orElse` return (putStrLn "wtf")) - (\(e::SomeException) -> return (putStrLn "ok")) + (\(e::SomeExceptionWithLocation) -> return (putStrLn "ok")) diff --git a/testsuite/tests/stranal/should_run/T11555a.hs b/testsuite/tests/stranal/should_run/T11555a.hs index fc2e8b83ba..3eee88801b 100644 --- a/testsuite/tests/stranal/should_run/T11555a.hs +++ b/testsuite/tests/stranal/should_run/T11555a.hs @@ -9,12 +9,12 @@ import GHC.Exts type RAW a = ContT () IO a -- See https://gitlab.haskell.org/ghc/ghc/issues/11555 -catchSafe1, catchSafe2 :: IO a -> (SomeException -> IO a) -> IO a +catchSafe1, catchSafe2 :: IO a -> (SomeExceptionWithLocation -> IO a) -> IO a catchSafe1 a b = lazy a `catch` b catchSafe2 a b = join (evaluate a) `catch` b -- | Run and then call a continuation. -runRAW1, runRAW2 :: RAW a -> (Either SomeException a -> IO ()) -> IO () +runRAW1, runRAW2 :: RAW a -> (Either SomeExceptionWithLocation a -> IO ()) -> IO () runRAW1 m k = m `runContT` (k . Right) `catchSafe1` \e -> k $ Left e runRAW2 m k = m `runContT` (k . Right) `catchSafe2` \e -> k $ Left e diff --git a/testsuite/tests/typecheck/should_compile/T5490.hs b/testsuite/tests/typecheck/should_compile/T5490.hs index 487fe0d841..a3539b57e7 100644 --- a/testsuite/tests/typecheck/should_compile/T5490.hs +++ b/testsuite/tests/typecheck/should_compile/T5490.hs @@ -94,7 +94,7 @@ instance WaitOp (WaitOps rs) where t ← try $ registerWaitOp op (Inject ev $ inj n) r ← case t of Right r → return r - Left e → complete ev $ inj n $ Failure (e ∷ SomeException) + Left e → complete ev $ inj n $ Failure (e ∷ SomeExceptionWithLocation) return $ r || not first register first n (op :? ops') = do t ← try $ registerWaitOp op (Inject ev $ inj n) @@ -104,7 +104,7 @@ instance WaitOp (WaitOps rs) where HTailDropComm → register False (PSucc n) ops' Right False → return $ not first Left e → do - c ← complete ev $ inj n $ Failure (e ∷ SomeException) + c ← complete ev $ inj n $ Failure (e ∷ SomeExceptionWithLocation) return $ c || not first case waitOpsNonEmpty ops of HNonEmptyInst → register True PZero ops diff --git a/testsuite/tests/typecheck/should_run/StrictPats.hs b/testsuite/tests/typecheck/should_run/StrictPats.hs index 7eed9dc767..53ed842c06 100644 --- a/testsuite/tests/typecheck/should_run/StrictPats.hs +++ b/testsuite/tests/typecheck/should_run/StrictPats.hs @@ -16,7 +16,7 @@ ok x = do bad :: a -> IO () bad x = do - r <- try @SomeException $ evaluate x + r <- try @SomeExceptionWithLocation $ evaluate x case r of Left _ -> putStrLn "Exception thrown as expected." Right _ -> putStrLn "Exception not thrown when expected." |