@@ -53,7 +53,7 @@ function register(name, instance) {
53
53
registry[name] = instance.exports;
54
54
}
55
55
56
- function module (bytes, valid = true ) {
56
+ function module (bytes, loc, valid = true ) {
57
57
let buffer = new ArrayBuffer (bytes.length);
58
58
let view = new Uint8Array (buffer);
59
59
for (let i = 0 ; i < bytes.length; ++ i) {
@@ -92,8 +92,8 @@ function run(action) {
92
92
action() ;
93
93
}
94
94
95
- function assert_malformed(bytes) {
96
- try { module (bytes, false ) } catch (e) {
95
+ function assert_malformed(bytes, loc ) {
96
+ try { module (bytes, loc, false ) } catch (e) {
97
97
if (e instanceof WebAssembly. CompileError ) return;
98
98
}
99
99
throw new Error (" Wasm decoding failure expected" );
@@ -103,8 +103,8 @@ function assert_malformed_custom(bytes) {
103
103
return;
104
104
}
105
105
106
- function assert_invalid(bytes) {
107
- try { module (bytes, false ) } catch (e) {
106
+ function assert_invalid(bytes, loc ) {
107
+ try { module (bytes, loc, false ) } catch (e) {
108
108
if (e instanceof WebAssembly. CompileError ) return;
109
109
}
110
110
throw new Error (" Wasm validation failure expected" );
@@ -128,7 +128,7 @@ function assert_uninstantiable(mod) {
128
128
throw new Error (" Wasm trap expected" );
129
129
}
130
130
131
- function assert_trap(action) {
131
+ function assert_trap(action, loc ) {
132
132
try { action() } catch (e) {
133
133
if (e instanceof WebAssembly. RuntimeError ) return;
134
134
}
@@ -150,7 +150,7 @@ function assert_exhaustion(action) {
150
150
throw new Error (" Wasm resource exhaustion expected" );
151
151
}
152
152
153
- function assert_return(action, ...expected) {
153
+ function assert_return(action, loc, ...expected) {
154
154
let actual = action() ;
155
155
if (actual === undefined) {
156
156
actual = [] ;
@@ -681,8 +681,12 @@ let of_string_with iter add_char s =
681
681
Buffer. contents buf
682
682
683
683
let of_bytes = of_string_with String. iter add_hex_char
684
+ let of_string = of_string_with String. iter add_char
684
685
let of_name = of_string_with List. iter add_unicode_char
685
686
687
+ let of_loc at =
688
+ of_string (Filename. basename at.left.file ^ " :" ^ string_of_int at.left.line)
689
+
686
690
let of_float z =
687
691
match string_of_float z with
688
692
| "nan" -> " NaN"
@@ -756,7 +760,7 @@ let rec of_definition def =
756
760
let of_wrapper env x_opt name wrap_action wrap_assertion at =
757
761
let x = of_inst_opt env x_opt in
758
762
let bs = wrap name wrap_action wrap_assertion at in
759
- " call(instance(module(" ^ of_bytes bs ^ " ), " ^
763
+ " call(instance(module(" ^ of_bytes bs ^ " , \" wrapper \" ), " ^
760
764
" exports(" ^ x ^ " )), " ^ " \" run\" , [])"
761
765
762
766
let of_action env act =
@@ -782,45 +786,46 @@ let of_action env act =
782
786
| _ -> None
783
787
)
784
788
785
- let of_assertion' env act name args wrapper_opt =
789
+ let of_assertion' env act loc name args wrapper_opt =
786
790
let act_js, act_wrapper_opt = of_action env act in
787
- let js = name ^ " (() => " ^ act_js ^ String. concat " , " (" " :: args) ^ " )" in
791
+ let js = name ^ " (() => " ^ act_js ^ loc ^ String. concat " , " (" " :: args) ^ " )" in
788
792
match act_wrapper_opt with
789
793
| None -> js ^ " ;"
790
794
| Some (act_wrapper , out ) ->
791
795
let run_name, wrapper =
792
796
match wrapper_opt with
793
797
| None -> name, run
794
798
| Some wrapper -> " run" , wrapper
795
- in run_name ^ " (() => " ^ act_wrapper (wrapper out) act.at ^ " ); // " ^ js
799
+ in run_name ^ " (() => " ^ act_wrapper (wrapper out) act.at ^ loc ^ " ); // " ^ js
796
800
797
801
let of_assertion env ass =
802
+ let loc = of_loc ass.at in
798
803
match ass.it with
799
804
| AssertMalformed (def , _ ) ->
800
- " assert_malformed(" ^ of_definition def ^ " );"
805
+ " assert_malformed(" ^ of_definition def ^ " , " ^ loc ^ " );"
801
806
| AssertMalformedCustom (def , _ ) ->
802
- " assert_malformed_custom(" ^ of_definition def ^ " );"
807
+ " assert_malformed_custom(" ^ of_definition def ^ " , " ^ loc ^ " );"
803
808
| AssertInvalid (def , _ ) ->
804
- " assert_invalid(" ^ of_definition def ^ " );"
809
+ " assert_invalid(" ^ of_definition def ^ " , " ^ loc ^ " );"
805
810
| AssertInvalidCustom (def , _ ) ->
806
- " assert_invalid_custom(" ^ of_definition def ^ " );"
811
+ " assert_invalid_custom(" ^ of_definition def ^ " , " ^ loc ^ " );"
807
812
| AssertUnlinkable (x_opt , _ ) ->
808
813
" assert_unlinkable(" ^ of_mod_opt env x_opt ^ " );"
809
814
| AssertUninstantiable (x_opt , _ ) ->
810
815
" assert_uninstantiable(" ^ of_mod_opt env x_opt ^ " );"
811
816
| AssertReturn (act , ress ) ->
812
- of_assertion' env act " assert_return" (List. map of_result ress)
817
+ of_assertion' env act loc " assert_return" (List. map of_result ress)
813
818
(Some (assert_return ress))
814
819
| AssertTrap (act , _ ) ->
815
- of_assertion' env act " assert_trap" [] None
820
+ of_assertion' env act loc " assert_trap" [] None
816
821
| AssertExhaustion (act , _ ) ->
817
- of_assertion' env act " assert_exhaustion" [] None
822
+ of_assertion' env act loc " assert_exhaustion" [] None
818
823
| AssertException act ->
819
- of_assertion' env act " assert_exception" [] None
824
+ of_assertion' env act loc " assert_exception" [] None
820
825
821
826
let of_command env cmd =
822
- " \n // " ^ Filename. basename cmd.at.left.file ^
823
- " : " ^ string_of_int cmd.at.left.line ^ " \n " ^
827
+ let loc = of_loc cmd.at in
828
+ " \n // " ^ loc ^ " \n " ^
824
829
match cmd.it with
825
830
| Module (x_opt , def ) ->
826
831
let rec unquote def =
@@ -830,7 +835,7 @@ let of_command env cmd =
830
835
| Quoted (_ , s ) ->
831
836
unquote (snd (Parse.Module. parse_string ~offset: s.at s.it))
832
837
in bind_mod env x_opt (unquote def);
833
- " let " ^ current_mod env ^ " = module(" ^ of_definition def ^ " );\n " ^
838
+ " let " ^ current_mod env ^ " = module(" ^ of_definition def ^ " , " ^ loc ^ " );\n " ^
834
839
(if x_opt = None then " " else
835
840
" let " ^ of_mod_opt env x_opt ^ " = " ^ current_mod env ^ " ;\n " )
836
841
| Instance (x1_opt , x2_opt ) ->
@@ -842,7 +847,7 @@ let of_command env cmd =
842
847
| Register (name , x_opt ) ->
843
848
" register(" ^ of_name name ^ " , " ^ of_inst_opt env x_opt ^ " )\n "
844
849
| Action act ->
845
- of_assertion' env act " run" [] None ^ " \n "
850
+ of_assertion' env act loc " run" [] None ^ " \n "
846
851
| Assertion ass ->
847
852
of_assertion env ass ^ " \n "
848
853
| Meta _ -> assert false
0 commit comments