diff --git a/ml-proto/spec/check.ml b/ml-proto/spec/check.ml index acd1b591ec..d42de9d2fc 100644 --- a/ml-proto/spec/check.ml +++ b/ml-proto/spec/check.ml @@ -171,8 +171,9 @@ let rec check_expr c et e = check_type (Some (local c x)) et e.at | SetLocal (x, e1) -> - check_expr c (Some (local c x)) e1; - check_type None et e.at + let t = local c x in + check_expr c (Some t) e1; + check_type (Some t) et e.at | Load (memop, e1) -> check_load c et memop e1 e.at @@ -250,7 +251,7 @@ and check_store c et memop e1 e2 at = check_align memop.align at; check_expr c (Some Int32Type) e1; check_expr c (Some memop.ty) e2; - check_type None et at + check_type (Some memop.ty) et at and check_align align at = Lib.Option.app (fun a -> diff --git a/ml-proto/spec/eval.ml b/ml-proto/spec/eval.ml index 95b00ac535..0a074e6c1b 100644 --- a/ml-proto/spec/eval.ml +++ b/ml-proto/spec/eval.ml @@ -166,7 +166,7 @@ let rec eval_expr (c : config) (e : expr) = | SetLocal (x, e1) -> let v1 = some (eval_expr c e1) e1.at in local c x := v1; - None + Some v1 | Load ({ty; align = _}, e1) -> let v1 = some (eval_expr c e1) e1.at in @@ -180,7 +180,7 @@ let rec eval_expr (c : config) (e : expr) = let a = Memory.address_of_value v1 in (try Memory.store c.module_.memory a v2 with exn -> memory_error e.at exn); - None + Some v2 | LoadExtend ({memop = {ty; align = _}; sz; ext}, e1) -> let v1 = some (eval_expr c e1) e1.at in @@ -194,7 +194,7 @@ let rec eval_expr (c : config) (e : expr) = let a = Memory.address_of_value v1 in (try Memory.store_wrap c.module_.memory a sz v2 with exn -> memory_error e.at exn); - None + Some v2 | Const v -> Some v.it diff --git a/ml-proto/test/expected-output/imports.wasm.log b/ml-proto/test/expected-output/imports.wast.log similarity index 100% rename from ml-proto/test/expected-output/imports.wasm.log rename to ml-proto/test/expected-output/imports.wast.log diff --git a/ml-proto/test/expected-output/store_retval.wast.log b/ml-proto/test/expected-output/store_retval.wast.log new file mode 100644 index 0000000000..d54036acc6 --- /dev/null +++ b/ml-proto/test/expected-output/store_retval.wast.log @@ -0,0 +1,13 @@ +1 : i32 +2 : i64 +3. : f32 +4. : f64 +11 : i32 +12 : i64 +13. : f32 +14. : f64 +512 : i32 +65536 : i32 +512 : i64 +65536 : i64 +4294967296 : i64 diff --git a/ml-proto/test/store_retval.wast b/ml-proto/test/store_retval.wast new file mode 100644 index 0000000000..d46ff27440 --- /dev/null +++ b/ml-proto/test/store_retval.wast @@ -0,0 +1,51 @@ +(module + (memory 100) + + (import $print_i32 "stdio" "print" (param i32)) + (import $print_i64 "stdio" "print" (param i64)) + (import $print_f32 "stdio" "print" (param f32)) + (import $print_f64 "stdio" "print" (param f64)) + + (func $run + (local $i32 i32) (local $i64 i64) (local $f32 f32) (local $f64 f64) + (call_import $print_i32 (set_local $i32 (i32.const 1))) + (call_import $print_i64 (set_local $i64 (i64.const 2))) + (call_import $print_f32 (set_local $f32 (f32.const 3))) + (call_import $print_f64 (set_local $f64 (f64.const 4))) + + (call_import $print_i32 (i32.store (i32.const 0) (i32.const 11))) + (call_import $print_i64 (i64.store (i32.const 0) (i64.const 12))) + (call_import $print_f32 (f32.store (i32.const 0) (f32.const 13))) + (call_import $print_f64 (f64.store (i32.const 0) (f64.const 14))) + + (call_import $print_i32 (i32.store8 (i32.const 0) (i32.const 512))) + (call_import $print_i32 (i32.store16 (i32.const 0) (i32.const 65536))) + (call_import $print_i64 (i64.store8 (i32.const 0) (i64.const 512))) + (call_import $print_i64 (i64.store16 (i32.const 0) (i64.const 65536))) + (call_import $print_i64 (i64.store32 (i32.const 0) (i64.const 4294967296))) + ) + (export "run" $run) +) + +(invoke "run") + +(assert_invalid + (module (func (local $i32 i32) (local $i64 i64) + (set_local $i64 (set_local $i32 (i32.const 1))))) + "type mismatch: expression has type i32 but the context requires i64" +) +(assert_invalid + (module (func (local $i32 i32) (local $i64 i64) + (set_local $i32 (set_local $i64 (i64.const 1))))) + "type mismatch: expression has type i64 but the context requires i32" +) +(assert_invalid + (module (func (local $f32 f32) (local $f64 f64) + (set_local $f64 (set_local $f32 (f32.const 1))))) + "type mismatch: expression has type f32 but the context requires f64" +) +(assert_invalid + (module (func (local $f32 f32) (local $f64 f64) + (set_local $f32 (set_local $f64 (f64.const 1))))) + "type mismatch: expression has type f64 but the context requires f32" +)