ghc/interpreter/test/std/catch1.hs

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