actually parse inline binary module in scripts

OCamlPro · Jul 23, 2024 · 7439f3a · 7439f3a
1 parent 4e2ebae
commit 7439f3a
Show file tree

Hide file tree

Showing 6 changed files with 27 additions and 16 deletions.
diff --git a/src/ast/text.ml b/src/ast/text.ml
@@ -178,13 +178,15 @@ type register = string * string option
 let pp_register fmt (s, _name) = pf fmt "(register %s)" s
 
 type cmd =
-  | Module of modul
+  | Binary_module of string option * string
+  | Text_module of modul
   | Assert of assertion
   | Register of string * string option
   | Action of action
 
 let pp_cmd fmt = function
-  | Module m -> pp_modul fmt m
+  | Binary_module (id, m) -> Fmt.pf fmt "(module %a %S)" Types.pp_id_opt id m
+  | Text_module m -> pp_modul fmt m
   | Assert a -> pp_assertion fmt a
   | Register (s, name) -> pp_register fmt (s, name)
   | Action _a -> pf fmt "<action>"

diff --git a/src/parser/text_parser.mly b/src/parser/text_parser.mly
@@ -1008,10 +1008,8 @@ let modul :=
   }
 
 let module_binary :=
-  | MODULE; id = ioption(id); BINARY; ~ = inline_module_inner; _ = list(NAME); {
-    (* TODO: handle fields_bin
-    let fields_bin = String.concat "" l in *)
-    { inline_module_inner with id }
+  | MODULE; id = ioption(id); BINARY; lines = list(NAME); {
+    id, String.concat "" lines
   }
 
 let literal_const ==
@@ -1079,14 +1077,17 @@ let action ==
   | GET; ~ = ioption(id); ~ = utf8_name; <Get>
 
 let cmd ==
-  | ~ = modul; <Module>
-  | ~ = par(module_binary); <Module>
+  | ~ = modul; <Text_module>
+  | bm = par(module_binary); {
+    let id, m = bm in
+    Binary_module (id, m)
+  }
   | ~ = par(assert_); <Assert>
   | ~ = par(register); <>
   | ~ = par(action); <Action>
 
 let script :=
   | ~ = nonempty_list(cmd); EOF; <>
   | ~ = inline_module_inner; EOF; {
-    [ Module inline_module_inner ]
+    [ Text_module inline_module_inner ]
   }
diff --git a/src/script/script.ml b/src/script/script.ml
@@ -152,7 +152,7 @@ let run ~no_exhaustion ~optimize script =
   let curr_module = ref 0 in
   list_fold_left
     (fun (link_state : Concrete_value.Func.extern_func Link.state) -> function
-      | Text.Module m ->
+      | Text.Text_module m ->
         if !curr_module = 0 then Log.debug_on := false;
         Log.debug0 "*** module@\n";
         incr curr_module;
@@ -161,6 +161,18 @@ let run ~no_exhaustion ~optimize script =
         in
         Log.debug_on := debug_on;
         link_state
+      | Text.Binary_module (id, m) ->
+        if !curr_module = 0 then Log.debug_on := false;
+        Log.debug0 "*** binary module@\n";
+        incr curr_module;
+        let* m = Parse.Binary.Module.from_string m in
+        let m = { m with id } in
+        let+ link_state =
+          Compile.Binary.until_interpret link_state ~unsafe ~optimize ~name:None
+            m
+        in
+        Log.debug_on := debug_on;
+        link_state
       | Assert (Assert_trap_module (m, expected)) ->
         Log.debug0 "*** assert_trap@\n";
         incr curr_module;
@@ -182,7 +194,7 @@ let run ~no_exhaustion ~optimize script =
         let+ () =
           match got with
           | Error got -> check_error ~expected ~got
-          | Ok [ Module m ] ->
+          | Ok [ Text_module m ] ->
             let got = Compile.Text.until_binary ~unsafe m in
             check_error_result expected got
           | _ -> assert false

diff --git a/src/script/spectest.ml b/src/script/spectest.ml
@@ -49,7 +49,7 @@ let extern_m =
 
 let m =
   let open Text in
-  Text.Module
+  Text.Text_module
     { id = Some "spectest"
     ; fields =
         [ MImport

diff --git a/test/script/reference.t b/test/script/reference.t
@@ -30,8 +30,6 @@
   $ owi script --no-exhaustion reference/fac.wast
   $ owi script --no-exhaustion reference/float_exprs.wast
   $ owi script --no-exhaustion reference/float_literals.wast
-  unbound name 4294967249
-  [38]
   $ owi script --no-exhaustion reference/float_memory.wast
   $ owi script --no-exhaustion reference/float_misc.wast
   $ owi script --no-exhaustion reference/forward.wast

diff --git a/test/script/reference_opt.t b/test/script/reference_opt.t
@@ -30,8 +30,6 @@
   $ owi script --no-exhaustion --optimize reference/fac.wast
   $ owi script --no-exhaustion --optimize reference/float_exprs.wast
   $ owi script --no-exhaustion --optimize reference/float_literals.wast
-  unbound name 4294967249
-  [38]
   $ owi script --no-exhaustion --optimize reference/float_memory.wast
   $ owi script --no-exhaustion --optimize reference/float_misc.wast
   $ owi script --no-exhaustion --optimize reference/forward.wast