How to assert that a function throws an exception? - exception

I can catch exceptions:
try some_fn () with | e -> print_endline "exception caught!"
but what about the other way around, detecting that a function does not throw an exception (when it should)?

I managed to write some very hacky way to achieve that: I create a wrapper around the function I want to test, which throws some specific exception at the end. I catch anything but that exception.
exception Finished
let check (fn : unit -> unit) =
let wrapper _ = (
fn ();
raise Finished)
in
try wrapper () with e when e <> Finished -> ()
in utop this works:
utop # check (fun _ -> ());;
Exception: Finished.
utop # check (fun _ -> failwith "hey");;
- : unit = ()
EDIT: my coworker suggested:
let should_fail fn =
if Result.try_with fn |> Result.is_ok then failwith "this test should fail"

Exceptions can be handled within pattern matching cases, allowing very clean expression for this check:
match some_fn () with
| exception _ -> print_endline "exception caught!"
| _ -> print_endline "error: no exception raised!"
We can abstract this check into a function:
let throws_exception f =
match f () with
| exception _ -> true
| _ -> false
Which we can use in an assertion like so:
assert (throws_exception (fun () -> raise (Failure "msg")))

Related

OCaml 5.0.0~beta1: How to use an argument of Effect when their effect handler is not specified (Using Unhandled Exception)

I am using opam switch: 5.0.0~beta1
I was playing around with some simple functions (on utop):
type _ Effect.t += Foo : (unit -> unit) -> unit Effect.t
let a = try perform (Foo (fun () -> Printf.printf "Hello from Foo\n ")) with
| Unhandled (Foo f) -> f ();;
Output: Hello from Foo
val a: unit = ()
This works well.
But when we change the definition of Foo effect,
type _ Effect.t += Foo : ('a -> unit) -> unit Effect.t
let a = try perform (Foo (fun n -> Printf.printf "Hello from Foo\n ")) with
| Unhandled (Foo f) -> f 45;;
Error: This expression has type int but an expression was expected of type
$Foo_'a
Here I understand that it needs 'a as an input, but while calling the function, shouldnt it infer the type as int and replace 'a with int and execute the function accordingly? I want to call function f from Foo effect with different argument.
Here is the another example:
type _ Effect.t += Suspend : 'a -> unit Effect.t
let a = try perform (Suspend 32) with
| Unhandled (Suspend x) -> x;;
Error: This expression has type $Suspend_'a
but an expression was expected of type $Unhandled_'a
Here, I understand that return value of (try _ with) i.e. (unit) should be the type of $Unhandled_ 'a.
But I also want to know, what is $Unhandled_ 'a type? How is normal 'a is different from $Unhandled_ 'a? How to return $Unhandled_ 'a here? Why there is this special use of $Unhandled?
What will be its scope (In some examples where I was using following code,
type _ Effect.t += Foo : ('a -> unit) -> unit Effect.t
let p = try Lwt.return (some_function x) with
| Unhandled (Foo f) -> let (pr, res) = Lwt.task () in
let wkup v = (Lwt.wakeup res v; ()) in
f wkup;
pr
I also got error as :
This expression has type $Unhandled_'a Lwt.t
but an expression was expected of type 'a Lwt.t
The type constructor $Unhandled_'a would escape its scope
)?
Why there is
The type constructor $Unhandled_'a would escape its scope
error?
The effect part is a red-herring here, the root issue stems from the notion of existentially-quantified types in GADTs.
When you have a GADT which is defined as
type t = Foo : ('a -> unit) -> t
the type of Foo means that you can construct a t for any type 'a and any function of type 'a -> unit. For instance:
let l = [Foo ignore; Foo print_int]
However, once you have constructed such value, you can no longer knows which type was used to construct the value. If you have a value
let test (Foo f) = ...
you only know that there exists some type 'a such that f has type 'a -> unit. This why the type 'a is called an existentially type (aka a type such that we only know that it exists). The important things to remember is that you don't know which 'a. Consequently you cannot apply the function because applying to the wrong 'a would be a type error.
In other words, the function boxed in Foo f can never be called on any value.
This is slightly more subtle variant than the any type
type any = Any: 'a -> any
where the constructor Any takes a value of any type and put it in a black box from which it can never be extracted.
In a way existentially-quantified type variables in a GADT lives in their own world and they cannot escape it. But they can be still be useful if this inner world is large enough. For instance, I can bundle a value with a function that prints that value and then forget the type of this value with:
type showable = Showable: {x:'a; print:'a -> unit} -> showable
Here, I can call the function print on the value x because I know that whatever is 'a it is the same 'a for both x and print:
let show (Showable {x;print}) = print x
Thus I can store few showable values in a list
let l = [ Showable(0, print_int), Showable("zero", print_string)]
and print them later
let () = List.iter show l

Handling and printing exceptions with SML

I have a code that looks quite like:
ignore
(f ())
handle
AssertionError msg => (print ("assertion error: " ^ msg ^ "\n"); ())
| _ (* other exceptions *) => (print ("exception raised\n"); ())
But I need to print the generic exception message (with exnMessage?).
How do I catch the _ exception in order to get and print its message?
Match the exception with a name instead of _ and use exnMessage:
- (hd ([]: string list)) handle e => exnMessage e;
val it = "Empty" : string

F# exception handling multiple "Tries"

I'm trying to read a bunch of csv files in SQL Server using SQL Bulk Insert and DataContext.ExecuteCommand. (Maybe this isn't the best way to do it, but it does allow me stay in the Type Provider context--as opposed to with SqlBulkCopy I think.) Now the upload is glitchy with intermittent success. Some files read in, some fail with "Data conversion error (truncation)". I think this has to do with the row terminators not always working.
When the upload works, it seems to be with the '0x0A' terminator. But when that fails, I want to try repeatedly again with other row terminators. So I want to go into a Try statement, and on failure go into another Try statement, and another if that one fails, ... . This may not be the best way to upload, but I am still curious about the Try logic for it's own state.
Here's what I've come up with so far and it's not too pretty (but it works). Cutting out a few nested layers:
let FileRead path =
try
db.DataContext.ExecuteCommand(#"BULK INSERT...ROWTERMINATOR='0x0A')") |> ignore
true
with
| exn ->
try
db.DataContext.ExecuteCommand(#"BULK INSERT...ROWTERMINATOR='\r')") |> ignore
true
with
| exn ->
try
db.DataContext.ExecuteCommand(#"BULK INSERT...ROWTERMINATOR='\n')") |> ignore
true
with
| exn ->
false
This doens't feel right but I haven't figured out any other syntax.
EDIT: What I ended up doing, just for the record. Appreciate being put on a productive path. There's plenty to improve in this. With one of the more significant things being to use Async's and run it Parallel (which I have gotten experience with in other sections).
type dbSchema = SqlDataConnection<dbConnection>
let db = dbSchema.GetDataContext()
let TryUpLd table pathFile rowTerm =
try
db.DataContext.ExecuteCommand( #"BULK INSERT " + table + " FROM '" + pathFile +
#"' WITH (FIELDTERMINATOR=',', FIRSTROW = 2, ROWTERMINATOR='"
+ rowTerm + "')" ) |> ignore
File.Delete (pathFile) |> Some
with
| exn -> None
let NxtUpLd UL intOpt =
match intOpt with
| None -> UL
| _ -> intOpt
let MoveTable ID table1 table2 =
//...
()
let NxtMoveTable MT intOpt =
match intOpt with
| Some i -> MT
| _ -> ()
let UpLdFile path (file:string) =
let (table1, table2) =
match path with
| p when p = dlXPath -> ("Data.dbo.ImportXs", "Data.dbo.Xs")
| p when p = dlYPath -> ("Data.dbo.ImportYs", "Data.dbo.Ys")
| _ -> ("ERROR path to tables", "")
let ID = file.Replace(fileExt, "")
let TryRowTerm = TryUpLd table1 (path + file)
TryRowTerm "0x0A"
|> NxtUpLd (TryRowTerm "\r")
|> NxtUpLd (TryRowTerm "\n")
|> NxtUpLd (TryRowTerm "\r\n")
|> NxtUpLd (TryRowTerm "\n\r")
|> NxtUpLd (TryRowTerm "\0")
|> NxtMoveTable (MoveTable ID table1 table2)
let UpLdData path =
let dir = new DirectoryInfo(path)
let fileList = dir.GetFiles()
fileList |> Array.iter (fun file -> UpLdFile path file.Name ) |> ignore
Here's one way to do it, using monadic composition.
First, define a function that takes another function as input, but converts any exception to a None value:
let attempt f =
try f () |> Some
with | _ -> None
This function has the type (unit -> 'a) -> 'a option; that is: f is inferred to be any function that takes unit as input, and returns a value. As you can see, if no exception happens, the return value from invoking f is wrapped in a Some case. The attempt function suppresses all exceptions, which you shouldn't normally do.
Next, define this attemptNext function:
let attemptNext f = function
| Some x -> Some x
| None -> attempt f
This function has the type (unit -> 'a) -> 'a option -> 'a option. If the input 'a option is Some then it's simply returned. In other words, the value is interpreted as already successful, so there's no reason to try the next function.
Otherwise, if the input 'a option is None, this is interpreted as though the previous step resulted in a failure. In that case, the input function f is attempted, using the attempt function.
This means that you can now compose functions together, and get the first successful result.
Here are some functions to test with:
let throwyFunction () = raise (new System.InvalidOperationException("Boo"))
let throwyFunction' x y = raise (new System.InvalidOperationException("Hiss"))
let goodFunction () = "Hooray"
let goodFunction' x y = "Yeah"
Try them out in F# Interactive:
> let res1 =
attempt throwyFunction
|> attemptNext (fun () -> throwyFunction' 42 "foo")
|> attemptNext goodFunction
|> attemptNext (fun () -> goodFunction' true 13.37);;
val res1 : string option = Some "Hooray"
> let res2 =
attempt goodFunction
|> attemptNext throwyFunction
|> attemptNext (fun () -> throwyFunction' 42 "foo")
|> attemptNext (fun () -> goodFunction' true 13.37);;
val res2 : string option = Some "Hooray"
> let res3 =
attempt (fun () -> throwyFunction' 42 "foo")
|> attemptNext throwyFunction
|> attemptNext (fun () -> goodFunction' true 13.37)
|> attemptNext goodFunction;;
val res3 : string option = Some "Yeah"
> let res4 =
attempt (fun () -> throwyFunction' 42 "foo")
|> attemptNext (fun () -> goodFunction' true 13.37)
|> attemptNext throwyFunction
|> attemptNext goodFunction;;
val res4 : string option = Some "Yeah"

Async.Await not catching Task exception

I have a Task that does not return anything. You can't do an Async.AwaitTask on such a Task, so you need to do an Async.AwaitIAsyncTask instead. Unfortunately this seems to just swallow any exceptions that the underlying Task throws out: -
TaskFactory().StartNew(Action(fun _ -> failwith "oops"))
|> Async.AwaitIAsyncResult
|> Async.Ignore
|> Async.RunSynchronously
// val it : unit = ()
On the other hand, AwaitTask correctly cascades the exception: -
TaskFactory().StartNew(fun _ -> failwith "oops"
5)
|> Async.AwaitTask
|> Async.Ignore
|> Async.RunSynchronously
// POP!
What's the best way of treating regular (non-generic) Tasks as Async yet still get propagation of exceptions?
As an option that will properly handle cancellation:
open System.Threading.Tasks
module Async =
let AwaitTask (t: Task) =
Async.FromContinuations(fun (s, e, c) ->
t.ContinueWith(fun t ->
if t.IsCompleted then s()
elif t.IsFaulted then e(t.Exception)
else c(System.OperationCanceledException())
)
|> ignore
)
From the Xamarin F# Shirt App (which I originally borrowed from Dave Thomas):
[<AutoOpen>]
module Async =
let inline awaitPlainTask (task: Task) =
// rethrow exception from preceding task if it faulted
let continuation (t : Task) = if t.IsFaulted then raise t.Exception
task.ContinueWith continuation |> Async.AwaitTask

How to throw an exception and exit the program in Haskell?

I have a question: how do I throw an exception and exit the program? I have writen down a simple example:
-- main.hs
import Test
main = do
Test.foo ""
putStrLn "make some other things"
Here is the module:
moldule Test where
foo :: String -> IO ()
foo x = do
if null x
then THROW EXCEPTION AND EXIT MAIN else putStrLn "okay"
I want to start this and throw a exception and exit the program, but how?
Well, you could try
foo :: String -> IO ()
foo x = do
if null x
then error "Oops!" else putStrLn "okay"
Or, if you intend to catch the error eventually, then
import Control.Exception
data MyException = ThisException | ThatException
deriving (Show, Typeable)
instance Exception MyException
...
foo :: String -> IO ()
foo x = do
if null x
then throw ThisException else putStrLn "okay"
There are often more haskelly mechanisms that you could use, such as returning values packed in Maybe type or some other structure that describes the failure. Exceptions seem to fit better in cases where returning complicated types would complicate otherwise re-usable interfaces too much.