Add assert_fault script command

ml-proto/README.md

@@ -226,10 +226,11 @@ In order to be able to check and run modules for testing purposes, the S-express
 script: <cmd>*
 
 cmd:
-  <module>                                       ;; define, validate, and initialize module
-  ( invoke <name> <expr>* )                      ;; invoke export and print result
-  ( assert_eq (invoke <name> <expr>* ) <expr> )  ;; assert expected results of invocation
-  ( assert_invalid <module> <failure> )          ;; assert invalid module with given failure string
+  <module>                                             ;; define, validate, and initialize module
+  ( invoke <name> <expr>* )                            ;; invoke export and print result
+  ( assert_eq (invoke <name> <expr>* ) <expr> )        ;; assert expected results of invocation
+  ( assert_fault (invoke <name> <expr>* ) <failure> )  ;; assert invocation faults with given failure string
+  ( assert_invalid <module> <failure> )                ;; assert invalid module with given failure string
 ```
 
 Invocation is only possible after a module has been defined.

ml-proto/src/host/lexer.mll

@@ -249,6 +249,7 @@ rule token = parse
 
   | "assert_invalid" { ASSERTINVALID }
   | "assert_eq" { ASSERTEQ }
+  | "assert_fault" { ASSERTFAULT }
   | "invoke" { INVOKE }
 
   | name as s { VAR s }

ml-proto/src/host/parser.mly

@@ -103,7 +103,7 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels}
 %token GETLOCAL SETLOCAL LOADGLOBAL STOREGLOBAL LOAD STORE
 %token CONST UNARY BINARY COMPARE CONVERT
 %token FUNC PARAM RESULT LOCAL MODULE MEMORY SEGMENT GLOBAL IMPORT EXPORT TABLE
-%token ASSERTINVALID ASSERTEQ INVOKE
+%token ASSERTINVALID ASSERTEQ ASSERTFAULT INVOKE
 %token EOF
 
 %token<string> INT
@@ -348,6 +348,8 @@ cmd :
     { Invoke ($3, $4 (c0 ())) @@ at() }
   | LPAR ASSERTEQ LPAR INVOKE TEXT expr_list RPAR expr RPAR
     { AssertEq ($5, $6 (c0 ()), $8 (c0 ())) @@ at() }
+  | LPAR ASSERTFAULT LPAR INVOKE TEXT expr_list RPAR TEXT RPAR
+    { AssertFault ($5, $6 (c0 ()), $8) @@ at() }
 ;
 cmd_list :
   | /* empty */ { [] }

ml-proto/src/host/print.ml

@@ -73,6 +73,6 @@ let print_value vo =
         (Values.string_of_value v) (Types.string_of_value_type t);
       flush_all ()
   | None ->
-      printf "()";
+      printf "()\n";
       flush_all ()
 

ml-proto/src/host/script.ml

@@ -12,6 +12,7 @@ and command' =
   | AssertInvalid of Ast.modul * string
   | Invoke of string * Ast.expr list
   | AssertEq of string * Ast.expr list * Ast.expr
+  | AssertFault of string * Ast.expr list * string
 
 type script = command list
 
@@ -29,6 +30,14 @@ let eval_args es at =
     | None -> Error.error at "unexpected () value" in
   List.map reject_none evs
 
+let assert_error f err re at =
+  match f () with
+  | exception Error.Error (_, s) ->
+    if not (Str.string_match (Str.regexp re) s 0) then
+      Error.error at ("failure \"" ^ s ^ "\" does not match: \"" ^ re ^ "\"")
+  | _ ->
+    Error.error at ("expected " ^ err)
+
 let run_command cmd =
   match cmd.it with
   | Define m ->
@@ -44,13 +53,7 @@ let run_command cmd =
 
   | AssertInvalid (m, re) ->
     trace "Checking invalid...";
-    (match try Check.check_module m; None with Error.Error (_, s) -> Some s with
-    | None ->
-      Error.error cmd.at "expected invalid module"
-    | Some s ->
-      if not (Str.string_match (Str.regexp re) s 0) then
-        Error.error cmd.at 
-          ("validation failure \"" ^ s ^ "\" does not match: \"" ^ re ^ "\""))
+    assert_error (fun () -> Check.check_module m) "invalid module" re cmd.at
 
   | Invoke (name, es) ->
     trace "Invoking...";
@@ -79,6 +82,15 @@ let run_command cmd =
       Error.error cmd.at "assertion failed"
     end
 
+  | AssertFault (name, es, re) ->
+    trace "Assert fault invoking...";
+    let m = match !current_module with
+      | Some m -> m
+      | None -> Error.error cmd.at "no module defined to invoke"
+    in
+    let vs = eval_args es cmd.at in
+    assert_error (fun () -> Eval.invoke m name vs) "fault" re cmd.at
+
 let dry_command cmd =
   match cmd.it with
   | Define m ->
@@ -87,6 +99,7 @@ let dry_command cmd =
   | AssertInvalid _ -> ()
   | Invoke _ -> ()
   | AssertEq _ -> ()
+  | AssertFault _ -> ()
 
 let run script =
   List.iter (if !Flags.dry then dry_command else run_command) script

ml-proto/src/host/script.mli

@@ -8,6 +8,7 @@ and command' =
   | AssertInvalid of Ast.modul * string
   | Invoke of string * Ast.expr list
   | AssertEq of string * Ast.expr list * Ast.expr
+  | AssertFault of string * Ast.expr list * string
 
 type script = command list
 

ml-proto/test/memory_fault.wasm

@@ -0,0 +1,18 @@
+(module
+    (memory 100)
+
+    (export "store" $store)
+    (func $store (param $i i32) (param $v i32) (i32.store (get_local $i) (get_local $v)))
+
+    (export "load" $load)
+    (func $load (param $i i32) (result i32) (i32.load (get_local $i)))
+)
+
+(invoke "store" (i32.const 96) (i32.const 42))
+(assert_eq (invoke "load" (i32.const 96)) (i32.const 42))
+(assert_fault (invoke "store" (i32.const 97) (i32.const 13)) "runtime: out of bounds memory access")
+(assert_fault (invoke "load" (i32.const 97)) "runtime: out of bounds memory access")
+(assert_fault (invoke "store" (i32.const 98) (i32.const 13)) "runtime: out of bounds memory access")
+(assert_fault (invoke "load" (i32.const 98)) "runtime: out of bounds memory access")
+(assert_fault (invoke "store" (i32.const 99) (i32.const 13)) "runtime: out of bounds memory access")
+(assert_fault (invoke "load" (i32.const 99)) "runtime: out of bounds memory access")