Add invalid command

ml-proto/README.md

@@ -233,6 +233,7 @@ cmd:
   <module>                                       ;; define, validate, and initialize module
   ( invoke <name> <expr>* )                      ;; invoke export and print result
   ( asserteq (invoke <name> <expr>* ) <expr>* )  ;; assert expected results of invocation
+  ( assertinvalid <module> <failure> )           ;; assert invalid module with given failure string
 ```
 
 Invocation is only possible after a module has been defined.

ml-proto/runtests.py

@@ -51,7 +51,7 @@ def find_interpreter(path):
 def rebuild_interpreter(path):
   print("// building %s" % path)
   sys.stdout.flush()
-  exitCode = subprocess.call(["ocamlbuild", "-libs", "bigarray", "main.native"], cwd=os.path.abspath("src"))
+  exitCode = subprocess.call(["ocamlbuild", "-libs", "bigarray, str", "main.native"], cwd=os.path.abspath("src"))
   if (exitCode != 0):
     raise Exception("ocamlbuild failed with exit code %i" % exitCode)
   if not os.path.exists(path):

ml-proto/src/Makefile

@@ -12,7 +12,7 @@ MODULES = \
 NOMLI = flags types values ast sexpr main
 PARSERS = parser
 LEXERS = lexer
-LIBRARIES = bigarray
+LIBRARIES = bigarray str
 SAMPLES = 
 TEXTS = 
 

ml-proto/src/check.ml

@@ -271,9 +271,14 @@ let check_table c tab =
     List.iter (fun xI -> check_func_type (func c xI) s xI.at) xs;
     {c with tables = c.tables @ [s]}
 
-let check_export c ex =
-  let {name = _; func = x} = ex.it in
-  ignore (func c x)
+module NameSet = Set.Make(String)
+
+let check_export c set ex =
+  let {name; func = x} = ex.it in
+  ignore (func c x);
+  require (not (NameSet.mem name set)) ex.at
+    "duplicate export name";
+  NameSet.add name set
 
 let check_segment size prev_end seg =
   let seg_end = seg.it.Memory.addr + String.length seg.it.Memory.data in
@@ -295,4 +300,4 @@ let check_module m =
                  globals = List.map it globals} in
   let c' = List.fold_left check_table c tables in
   List.iter (check_func c') funcs;
-  List.iter (check_export c') exports
+  ignore (List.fold_left (check_export c') NameSet.empty exports)

ml-proto/src/lexer.mll

@@ -251,6 +251,7 @@ rule token = parse
   | "export" { EXPORT }
   | "table" { TABLE }
 
+  | "assertinvalid" { ASSERTINVALID }
   | "invoke" { INVOKE }
   | "asserteq" { ASSERTEQ }
 

ml-proto/src/parser.mly

@@ -98,7 +98,7 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels}
 %token GETLOCAL SETLOCAL GETGLOBAL SETGLOBAL GETMEMORY SETMEMORY
 %token CONST UNARY BINARY COMPARE CONVERT
 %token FUNC PARAM RESULT LOCAL MODULE MEMORY SEGMENT GLOBAL IMPORT EXPORT TABLE
-%token INVOKE ASSERTEQ
+%token ASSERTINVALID INVOKE ASSERTEQ
 %token EOF
 
 %token<string> INT
@@ -308,10 +308,11 @@ modul :
 
 cmd :
   | modul { Define $1 @@ at() }
+  | LPAR ASSERTINVALID modul TEXT RPAR { AssertInvalid ($3, $4) @@ at() }
   | LPAR INVOKE TEXT expr_list RPAR
     { Invoke ($3, $4 (c0 ())) @@ at() }
   | LPAR ASSERTEQ LPAR INVOKE TEXT expr_list RPAR expr_list RPAR
-    { AssertEqInvoke ($5, $6 (c0 ()), $8 (c0 ())) @@ at() }
+    { AssertEq ($5, $6 (c0 ()), $8 (c0 ())) @@ at() }
 ;
 cmd_list :
   | /* empty */ { [] }

ml-proto/src/script.ml

@@ -9,8 +9,9 @@ open Source
 type command = command' phrase
 and command' =
   | Define of Ast.modul
+  | AssertInvalid of Ast.modul * string
   | Invoke of string * Ast.expr list
-  | AssertEqInvoke of string * Ast.expr list * Ast.expr list
+  | AssertEq of string * Ast.expr list * Ast.expr list
 
 type script = command list
 
@@ -33,6 +34,16 @@ let run_command cmd =
     trace "Initializing...";
     current_module := Some (Eval.init m)
 
+  | 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 ^ "\""))
+
   | Invoke (name, es) ->
     trace "Invoking...";
     let m = match !current_module with
@@ -43,7 +54,7 @@ let run_command cmd =
     let vs' = Eval.invoke m name vs in
     if vs' <> [] then Print.print_values vs'
 
-  | AssertEqInvoke (name, arg_es, expect_es) ->
+  | AssertEq (name, arg_es, expect_es) ->
     trace "Assert invoking...";
     let m = match !current_module with
       | Some m -> m
@@ -65,8 +76,9 @@ let dry_command cmd =
   | Define m ->
     Check.check_module m;
     if !Flags.print_sig then Print.print_module_sig m
+  | AssertInvalid _ -> ()
   | Invoke _ -> ()
-  | AssertEqInvoke _ -> ()
+  | AssertEq _ -> ()
 
 let run script =
   List.iter (if !Flags.dry then dry_command else run_command) script

ml-proto/src/script.mli

@@ -5,8 +5,9 @@
 type command = command' Source.phrase
 and command' =
   | Define of Ast.modul
+  | AssertInvalid of Ast.modul * string
   | Invoke of string * Ast.expr list
-  | AssertEqInvoke of string * Ast.expr list * Ast.expr list
+  | AssertEq of string * Ast.expr list * Ast.expr list
 
 type script = command list
 

ml-proto/test/exports.wasm

@@ -0,0 +1,22 @@
+(module (func (const.i32 1)) (export "a" 0))
+(module (func (const.i32 1)) (export "a" 0) (export "b" 0))
+(module (func (const.i32 1)) (func (const.i32 2)) (export "a" 0) (export "b" 1))
+(assertinvalid
+  (module (func (const.i32 1)) (export "a" 1))
+  "unknown function 1")
+(assertinvalid
+  (module (func (const.i32 1)) (func (const.i32 2)) (export "a" 0) (export "a" 1))
+  "duplicate export name")
+(assertinvalid
+  (module (func (const.i32 1)) (export "a" 0) (export "a" 0))
+  "duplicate export name")
+
+(module
+  (func $f (param $n i32) (result i32)
+    (return (add.i32 (getlocal $n) (const.i32 1)))
+  )
+
+  (export "e" $f)
+)
+
+(asserteq (invoke "e" (const.i32 42)) (const.i32 43))

ml-proto/test/memory.wasm

@@ -1,5 +1,31 @@
 ;; (c) 2015 Andreas Rossberg
 
+(module (memory 0 0))
+(module (memory 0 1))
+(module (memory 4096 16777216))
+(module (memory 0 0 (segment 0 "")))
+(module (memory 1 1 (segment 0 "a")))
+(module (memory 100 1000 (segment 0 "a") (segment 99 "b")))
+(module (memory 100 1000 (segment 0 "a") (segment 1 "b") (segment 2 "c")))
+(assertinvalid
+  (module (memory 1 0))
+  "initial memory size must be less than maximum")
+(assertinvalid
+  (module (memory 0 0 (segment 0 "a")))
+  "data segment does not fit memory")
+(assertinvalid
+  (module (memory 100 1000 (segment 0 "a") (segment 500 "b")))
+  "data segment does not fit memory")
+(assertinvalid
+  (module (memory 100 1000 (segment 0 "abc") (segment 0 "def")))
+  "data segment not disjoint and ordered")
+(assertinvalid
+  (module (memory 100 1000 (segment 3 "ab") (segment 0 "de")))
+  "data segment not disjoint and ordered")
+(assertinvalid
+  (module (memory 100 1000 (segment 0 "a") (segment 2 "b") (segment 1 "c")))
+  "data segment not disjoint and ordered")
+
 (module
   (memory 1024 (segment 0 "ABC\a7D") (segment 20 "WASM"))
 

ml-proto/travis/build-test.sh

@@ -16,7 +16,7 @@ rm -f lexer.ml
 rm -f parser.ml
 rm -f parser.mli
 
-ocamlbuild -libs bigarray main.native
+ocamlbuild -libs "bigarray, str" main.native
 make
 
 cd ..