Batch of additional tests

ml-proto/host/parser.mly

@@ -309,22 +309,32 @@ type_use :
   | LPAR TYPE var RPAR { $3 }
 ;
 func :
-  | LPAR FUNC type_use func_fields RPAR
+  | LPAR FUNC export_opt type_use func_fields RPAR
     { let at = at () in
-      fun c -> anon_func c; let t = explicit_decl c $3 (fst $4) at in
-        fun () -> {((snd $4) (enter_func c)) with ftype = t} @@ at }
-  | LPAR FUNC bind_var type_use func_fields RPAR  /* Sugar */
+      fun c -> anon_func c; let t = explicit_decl c $4 (fst $5) at in
+        let exs = $3 c in
+        fun () -> {(snd $5 (enter_func c)) with ftype = t} @@ at, exs }
+  | LPAR FUNC export_opt bind_var type_use func_fields RPAR  /* Sugar */
     { let at = at () in
-      fun c -> bind_func c $3; let t = explicit_decl c $4 (fst $5) at in
-        fun () -> {((snd $5) (enter_func c)) with ftype = t} @@ at }
-  | LPAR FUNC func_fields RPAR  /* Sugar */
+      fun c -> bind_func c $4; let t = explicit_decl c $5 (fst $6) at in
+        let exs = $3 c in
+        fun () -> {(snd $6 (enter_func c)) with ftype = t} @@ at, exs }
+  | LPAR FUNC export_opt func_fields RPAR  /* Sugar */
     { let at = at () in
-      fun c -> anon_func c; let t = implicit_decl c (fst $3) at in
-        fun () -> {((snd $3) (enter_func c)) with ftype = t} @@ at }
-  | LPAR FUNC bind_var func_fields RPAR  /* Sugar */
+      fun c -> anon_func c; let t = implicit_decl c (fst $4) at in
+        let exs = $3 c in
+        fun () -> {(snd $4 (enter_func c)) with ftype = t} @@ at, exs }
+  | LPAR FUNC export_opt bind_var func_fields RPAR  /* Sugar */
     { let at = at () in
-      fun c -> bind_func c $3; let t = implicit_decl c (fst $4) at in
-        fun () -> {((snd $4) (enter_func c)) with ftype = t} @@ at }
+      fun c -> bind_func c $4; let t = implicit_decl c (fst $5) at in
+        let exs = $3 c in
+        fun () -> {(snd $5 (enter_func c)) with ftype = t} @@ at, exs }
+;
+export_opt :
+  | /* empty */ { fun c -> [] }
+  | TEXT
+    { let at = at () in
+      fun c -> [{name = $1; kind = `Func (c.funcs.count - 1 @@ at)} @@ at] }
 ;
 
 
@@ -396,8 +406,8 @@ module_fields :
       {memory = None; types = c.types.tlist; funcs = []; start = None; imports = [];
        exports = []; table = []} }
   | func module_fields
-    { fun c -> let f = $1 c in let m = $2 c in
-      {m with funcs = f () :: m.funcs} }
+    { fun c -> let f = $1 c in let m = $2 c in let func, exs = f () in
+      {m with funcs = func :: m.funcs; exports = exs @ m.exports} }
   | import module_fields
     { fun c -> let i = $1 c in let m = $2 c in
       {m with imports = i :: m.imports} }

ml-proto/test/block.wast

@@ -1,35 +1,165 @@
+;; Test `block` opcode
+
 (module
-  (func $empty
+  (func "empty"
     (block)
     (block $l)
   )
 
-  (func $singular (result i32)
+  (func "singular" (result i32)
+    (block (nop))
     (block (i32.const 7))
   )
 
-  (func $multi (result i32)
-    (block (i32.const 5) (i32.const 6) (i32.const 7) (i32.const 8))
+  (func $nop)
+  (func "multi" (result i32)
+    (block (call $nop) (call $nop) (call $nop) (call $nop))
+    (block (call $nop) (call $nop) (call $nop) (i32.const 8))
+  )
+
+  (func "nested" (result i32)
+    (block (block (call $nop) (block) (nop)) (block (call $nop) (i32.const 9)))
+  )
+
+  (func "deep" (result i32)
+    (block (block (block (block (block (block (block (block (block (block
+      (block (block (block (block (block (block (block (block (block (block
+        (block (block (block (block (block (block (block (block (block (block
+          (block (block (block (block (block (block (block (block (block (block
+            (block (block (block (block (block (call $nop) (i32.const 150))))))
+          ))))))))))
+        ))))))))))
+      ))))))))))
+    ))))))))))
+  )
+
+  (func "unary-operand" (result i32)
+    (i32.ctz (block (call $nop) (i32.const 13)))
+  )
+  (func "binary-operand" (result i32)
+    (i32.mul (block (call $nop) (i32.const 3)) (block (call $nop) (i32.const 4)))
+  )
+  (func "test-operand" (result i32)
+    (i32.eqz (block (call $nop) (i32.const 13)))
+  )
+  (func "compare-operand" (result i32)
+    (f32.gt (block (call $nop) (f32.const 3)) (block (call $nop) (f32.const 3)))
+  )
+
+  (func "br-bare" (result i32)
+    (block (br 0) (unreachable))
+    (i32.const 19)
+  )
+  (func "br-value" (result i32)
+    (block (br 0 (i32.const 18)) (i32.const 19))
+  )
+  (func "br-repeated" (result i32)
+    (block
+      (br 0 (i32.const 18))
+      (br 0 (i32.const 19))
+      (br 0 (i32.const 20))
+      (i32.const 21)
+    )
+  )
+  (func "br-inner" (result i32)
+    (block
+      (block (br 1 (i32.const 22)))
+      (block (br 0))
+      (i32.const 21)
+    )
+  )
+
+  (func "drop-inner" (result i32)
+    (block (call $fx) (i32.const 7) (call $nop) (i32.const 8))
+  )
+  (func "drop-last"
+    (block (call $nop) (call $fx) (nop) (i32.const 8))
+  )
+  (func "drop-br-void"
+    (block (br 0 (nop)))
+    (block (br 0 (call $nop)))
+  )
+  (func "drop-br-value"
+    (block (br 0 (i32.const 8)))
+  )
+  (func "drop-br-value-heterogeneous"
+    (block (br 0 (i32.const 8)) (br 0 (f64.const 8)) (br 0 (f32.const 8)))
+    (block (br 0 (i32.const 8)) (br 0) (br 0 (f64.const 8)))
+    (block (br 0 (i32.const 8)) (br 0 (call $nop)) (br 0 (f64.const 8)))
+    (block (br 0 (i32.const 8)) (br 0) (br 0 (f32.const 8)) (i64.const 3))
+    (block (br 0) (br 0 (i32.const 8)) (br 0 (f64.const 8)) (br 0 (nop)))
+    (block (br 0) (br 0 (i32.const 8)) (br 0 (f32.const 8)) (i64.const 3))
+    (block (block (br 0) (br 1 (i32.const 8))) (br 0 (f32.const 8)) (i64.const 3))
   )
 
-  (func $effects (result i32)
+  (func "effects" $fx (result i32)
     (local i32)
     (block
       (set_local 0 (i32.const 1))
       (set_local 0 (i32.mul (get_local 0) (i32.const 3)))
       (set_local 0 (i32.sub (get_local 0) (i32.const 5)))
       (set_local 0 (i32.mul (get_local 0) (i32.const 7)))
+      (br 0)
+      (set_local 0 (i32.mul (get_local 0) (i32.const 100)))
     )
-    (get_local 0)
+    (i32.eq (get_local 0) (i32.const -14))
   )
-
-  (export "empty" $empty)
-  (export "singular" $singular)
-  (export "multi" $multi)
-  (export "effects" $effects)
 )
 
-(invoke "empty")
+(assert_return (invoke "empty"))
 (assert_return (invoke "singular") (i32.const 7))
 (assert_return (invoke "multi") (i32.const 8))
-(assert_return (invoke "effects") (i32.const -14))
+(assert_return (invoke "nested") (i32.const 9))
+(assert_return (invoke "deep") (i32.const 150))
+
+(assert_return (invoke "unary-operand") (i32.const 0))
+(assert_return (invoke "binary-operand") (i32.const 12))
+(assert_return (invoke "test-operand") (i32.const 0))
+(assert_return (invoke "compare-operand") (i32.const 0))
+
+(assert_return (invoke "br-bare") (i32.const 19))
+(assert_return (invoke "br-value") (i32.const 18))
+(assert_return (invoke "br-repeated") (i32.const 18))
+(assert_return (invoke "br-inner") (i32.const 22))
+
+(assert_return (invoke "drop-inner") (i32.const 8))
+(assert_return (invoke "drop-last"))
+(assert_return (invoke "drop-br-void"))
+(assert_return (invoke "drop-br-value"))
+(assert_return (invoke "drop-br-value-heterogeneous"))
+
+(assert_return (invoke "effects") (i32.const 1))
+
+(assert_invalid
+  (module (func (result i32) (block)))
+  "type mismatch"
+)
+(assert_invalid
+  (module (func (result i32) (block (nop))))
+  "type mismatch"
+)
+(assert_invalid
+  (module (func (result i32) (block (f32.const 0))))
+  "type mismatch"
+)
+(assert_invalid
+  (module (func (result i32) (block (br 0) (i32.const 1))))
+  "type mismatch"
+)
+(assert_invalid
+  (module (func (result i32) (block (br 0 (i32.const 1)) (nop))))
+  "type mismatch"
+)
+(assert_invalid
+  (module (func (result i32) (block (br 0 (i64.const 1)) (i32.const 1))))
+  "type mismatch"
+)
+(assert_invalid
+  (module (func (result i32) (block (br 0 (i64.const 1)) (br 0 (i32.const 1)))))
+  "type mismatch"
+)
+(assert_invalid
+  (module (func (result i32) (block (block (br 1 (i64.const 1))) (br 0 (i32.const 1)))))
+  "type mismatch"
+)
+

ml-proto/test/comments.wast

@@ -0,0 +1,69 @@
+;; Test comment syntax
+
+;;comment
+
+;;;;;;;;;;;
+
+    ;;comment
+
+( ;;comment
+module;;comment
+);;comment
+
+;;)
+;;;)
+;; ;)
+;; (;
+
+(;;)
+
+(;comment;)
+
+(;;comment;)
+
+(;;;comment;)
+
+(;;;;;;;;;;;;;;)
+
+(;(((((((((( ;)
+
+(;)))))))))));)
+
+(;comment";)
+
+(;comment"";)
+
+(;comment""";)
+
+(;Heiße Würstchen;)
+
+(;���������������;)
+
+(;comment
+comment;)
+
+         	(;comment;)
+
+(;comment;)((;comment;)
+(;comment;)module(;comment;)
+(;comment;))(;comment;)
+
+(;comment(;nested;)comment;)
+
+(;comment
+(;nested
+;)comment
+;)
+
+(module
+  (;comment(;nested(;further;)nested;)comment;)
+)
+
+(;comment;;comment;)
+
+(;comment;;comment
+;)
+
+(module
+  (;comment;;comment(;nested;)comment;)
+)

ml-proto/test/nop.wast

@@ -0,0 +1,20 @@
+;; Test `nop` operator.
+
+(module
+  (func "eval"
+    (nop)
+  )
+
+  (func "drop" (result i32)
+    (nop)
+    (i32.const 1)
+  )
+)
+
+(assert_return (invoke "eval"))
+(assert_return (invoke "drop") (i32.const 1))
+
+(assert_invalid
+  (module (func (result i32) (nop)))
+  "type mismatch"
+)