diff --git a/ml-proto/README.md b/ml-proto/README.md index 4aa5fd1514..53186d53ee 100644 --- a/ml-proto/README.md +++ b/ml-proto/README.md @@ -233,6 +233,7 @@ cmd: ;; define, validate, and initialize module ( invoke * ) ;; invoke export and print result ( asserteq (invoke * ) * ) ;; assert expected results of invocation + ( assertinvalid ) ;; assert invalid module with given failure string ``` Invocation is only possible after a module has been defined. diff --git a/ml-proto/runtests.py b/ml-proto/runtests.py index ba04b40114..e8e2198d74 100755 --- a/ml-proto/runtests.py +++ b/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): diff --git a/ml-proto/src/Makefile b/ml-proto/src/Makefile index 53dce08b21..c16f723efc 100644 --- a/ml-proto/src/Makefile +++ b/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 = diff --git a/ml-proto/src/check.ml b/ml-proto/src/check.ml index 616ff4987d..666137532e 100644 --- a/ml-proto/src/check.ml +++ b/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) diff --git a/ml-proto/src/lexer.mll b/ml-proto/src/lexer.mll index 914f78dffb..accdf425be 100644 --- a/ml-proto/src/lexer.mll +++ b/ml-proto/src/lexer.mll @@ -251,6 +251,7 @@ rule token = parse | "export" { EXPORT } | "table" { TABLE } + | "assertinvalid" { ASSERTINVALID } | "invoke" { INVOKE } | "asserteq" { ASSERTEQ } diff --git a/ml-proto/src/parser.mly b/ml-proto/src/parser.mly index 823231f92c..2b6e5f5db4 100644 --- a/ml-proto/src/parser.mly +++ b/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 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 */ { [] } diff --git a/ml-proto/src/script.ml b/ml-proto/src/script.ml index 65a02a3f38..92bcc602f7 100644 --- a/ml-proto/src/script.ml +++ b/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 diff --git a/ml-proto/src/script.mli b/ml-proto/src/script.mli index 339e07ac85..e4ada117f7 100644 --- a/ml-proto/src/script.mli +++ b/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 diff --git a/ml-proto/test/basic.wasm b/ml-proto/test/basic.wasm deleted file mode 100644 index 180b9ec22b..0000000000 --- a/ml-proto/test/basic.wasm +++ /dev/null @@ -1,9 +0,0 @@ -(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)) diff --git a/ml-proto/test/exports.wasm b/ml-proto/test/exports.wasm new file mode 100644 index 0000000000..c3eac40933 --- /dev/null +++ b/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)) diff --git a/ml-proto/test/memory.wasm b/ml-proto/test/memory.wasm index fb9a7f5262..4c07f79b3b 100644 --- a/ml-proto/test/memory.wasm +++ b/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")) diff --git a/ml-proto/travis/build-test.sh b/ml-proto/travis/build-test.sh index 4156f1c83b..fddb9d4077 100755 --- a/ml-proto/travis/build-test.sh +++ b/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 ..