ghc/interpreter/test/std/catch2.hs

   1 --!!! Testing error catching
   2
   3 --module TestCatch where
   4
   5 test1, test2 :: String
   6
   7 test1 = show $ primCatchError (error "foo"::Int)
   8 test2 = show $ primCatchError 1
   9
  10
  11 test3, test4, test5 :: String
  12
  13 test3 = show $ catch (1+error "foo") 2
  14 test4 = show $ catch 1 (error "bar")
  15 test5 = show $ catch (error "foo") (error "bar" :: Int)
  16
  17
  18 test6, test7, test8, test9 :: IO ()
  19
  20 test6 = printString "abcdefg"
  21 test7 = printString (error "a" : "bcdefg")
  22 test8 = printString ("abc" ++ error "defg")
  23 test9 = printString (error "a" : "bc" ++ error "defg")
  24
  25 -- if an error occurs, replace it with a default (hopefully error-free) value
  26 catch :: a -> a -> a
  27 catch x deflt = case primCatchError x of
  28                 Just x' -> x'
  29                 Nothing -> deflt
  30
  31 -- lazily print a string - catching any errors as necessary
  32 printString :: String -> IO ()
  33 printString str =
  34   case primCatchError str of
  35   Nothing     -> putStr "<error>"
  36   Just []     -> return ()
  37   Just (c:cs) -> case primCatchError c of
  38                  Nothing -> putStr "<error>" >> printString cs
  39                  Just c' -> putChar c' >> printString cs
  40