Skip to content

Commit

Permalink
Test improvements
Browse files Browse the repository at this point in the history
Revert test_fun_call and test_poly_compare and don't run them in Wasm.
Add additional tests test_fun_call2 and test_poly_equal that make sense
in Wasm.
  • Loading branch information
vouillon committed Jul 3, 2024
1 parent 614cc25 commit a759bbb
Show file tree
Hide file tree
Showing 6 changed files with 559 additions and 39 deletions.
24 changes: 22 additions & 2 deletions lib/tests/dune.inc
Original file line number Diff line number Diff line change
Expand Up @@ -32,13 +32,23 @@
(library
;; lib/tests/test_fun_call.ml
(name test_fun_call_75)
(enabled_if (<> %{profile} using-effects))
(enabled_if (and (<> %{profile} using-effects) (<> %{profile} wasm) (<> %{profile} wasm-effects)))
(modules test_fun_call)
(libraries js_of_ocaml unix)
(inline_tests (modes js))
(preprocess
(pps ppx_js_internal ppx_expect)))

(library
;; lib/tests/test_fun_call_2.ml
(name test_fun_call_2_75)
(enabled_if true)
(modules test_fun_call_2)
(libraries js_of_ocaml unix)
(inline_tests (modes js))
(preprocess
(pps ppx_js_internal ppx_expect)))

(library
;; lib/tests/test_json.ml
(name test_json_75)
Expand All @@ -62,13 +72,23 @@
(library
;; lib/tests/test_poly_compare.ml
(name test_poly_compare_75)
(enabled_if true)
(enabled_if (and (<> %{profile} wasm) (<> %{profile} wasm-effects)))
(modules test_poly_compare)
(libraries js_of_ocaml unix)
(inline_tests (modes js))
(preprocess
(pps ppx_js_internal ppx_expect)))

(library
;; lib/tests/test_poly_equal.ml
(name test_poly_equal_75)
(enabled_if true)
(modules test_poly_equal)
(libraries js_of_ocaml unix)
(inline_tests (modes js))
(preprocess
(pps ppx_js_internal ppx_expect)))

(library
;; lib/tests/test_regexp.ml
(name test_regexp_75)
Expand Down
12 changes: 7 additions & 5 deletions lib/tests/gen-rules/gen.ml
Original file line number Diff line number Diff line change
Expand Up @@ -47,14 +47,14 @@ let prefix : string =

type enabled_if =
| GE5
| No_effects
| Not_wasm
| No_effects_not_wasm
| Any

let enabled_if = function
| "test_sys" -> GE5
| "test_fun_call" -> No_effects
| "test_json" -> Not_wasm
| "test_fun_call" -> No_effects_not_wasm
| "test_json" | "test_poly_compare" -> Not_wasm
| _ -> Any

let () =
Expand Down Expand Up @@ -85,6 +85,8 @@ let () =
(* ZZZ /static not yet implemented *)
"(and (>= %{ocaml_version} 5) (<> %{profile} wasm) (<> %{profile} \
wasm-effects))"
| No_effects -> "(<> %{profile} using-effects)"
| Not_wasm -> "(and (<> %{profile} wasm) (<> %{profile} wasm-effects))")
| Not_wasm -> "(and (<> %{profile} wasm) (<> %{profile} wasm-effects))"
| No_effects_not_wasm ->
"(and (<> %{profile} using-effects) (<> %{profile} wasm) (<> %{profile} \
wasm-effects))")
basename)
37 changes: 16 additions & 21 deletions lib/tests/test_fun_call.ml
Original file line number Diff line number Diff line change
Expand Up @@ -29,8 +29,9 @@ let s x =
return "undefined"
if(typeof x === "function")
return "function#" + x.length + "#" + x.l
if (x.toString) return x.toString();
return "other"
if(x.toString() == "[object Arguments]")
return "(Arguments: " + Array.prototype.slice.call(x).toString() + ")";
return x.toString()
})
|}
in
Expand Down Expand Up @@ -146,7 +147,7 @@ let%expect_test "wrap_callback_strict" =
(Js.Unsafe.callback_with_arity 2 cb3)
{| (function(f){ return f(1,2,3) }) |};
[%expect {|
Result: other |}];
Result: function#1#1 |}];
call_and_log
(Js.Unsafe.callback_with_arity 2 cb3)
~cont:(fun g -> g 4)
Expand All @@ -163,7 +164,7 @@ let%expect_test "wrap_callback_strict" =
Result: 0 |}];
call_and_log (Js.Unsafe.callback_with_arity 2 cb3) {| (function(f){ return f(1,2) }) |};
[%expect {|
Result: other |}]
Result: function#1#1 |}]

let%expect_test "wrap_callback_strict" =
call_and_log
Expand Down Expand Up @@ -290,7 +291,7 @@ let%expect_test "wrap_meth_callback_strict" =
(Js.Unsafe.meth_callback_with_arity 2 cb4)
{| (function(f){ return f.apply("this",[1,2,3]) }) |};
[%expect {|
Result: other |}];
Result: function#1#1 |}];
call_and_log
(Js.Unsafe.meth_callback_with_arity 2 cb4)
~cont:(fun g -> g 4)
Expand All @@ -308,7 +309,7 @@ let%expect_test "wrap_meth_callback_strict" =
call_and_log
(Js.Unsafe.meth_callback_with_arity 2 cb4)
{| (function(f){ return f.apply("this",[1,2]) }) |};
[%expect {| Result: other |}]
[%expect {| Result: function#1#1 |}]

let%expect_test "wrap_meth_callback_strict" =
call_and_log
Expand Down Expand Up @@ -353,15 +354,13 @@ let%expect_test "partial application, extra arguments set to undefined" =
let%expect_test _ =
call_and_log cb3 ~cont:(fun g -> g 1) {| (function(f){ return f }) |};
[%expect {|
Result: other |}]
Result: function#2#2 |}]

(*
let%expect_test _ =
call_and_log cb3 ~cont:(fun g -> g 1 2 3 4) {| (function(f){ return f }) |};
[%expect {|
got 1, 2, 3, done
Result: 0 |}]
*)

let%expect_test _ =
let f cb =
Expand All @@ -370,25 +369,22 @@ let%expect_test _ =
| _ -> Printf.printf "Error: unknown"
in
f cb5;
[%expect {| Result: other |}];
[%expect {| Result: function#1#1 |}];
f cb4;
[%expect {|
got 1, 1, 2, 3, done
Result: 0 |}];
()
(* f cb3;
[%expect {|
got 1, 1, 2, done
Result: 0 |}]
*)
f cb3;
[%expect {|
got 1, 1, 2, done
Result: 0 |}]

let%expect_test _ =
let f cb =
try call_and_log (cb 1 2 3) {| (function(f){ return f }) |} with
| Invalid_argument s | Failure s -> Printf.printf "Error: %s" s
| _ -> Printf.printf "Error: unknown"
in
(*
f (Obj.magic cb1);
[%expect {|
got 1, done
Expand All @@ -397,21 +393,20 @@ let%expect_test _ =
[%expect {|
got 1, 2, done
Result: 0 |}];
*)
f (Obj.magic cb3);
[%expect {|
got 1, 2, 3, done
Result: 0 |}];
f (Obj.magic cb4);
[%expect {|
Result: other |}];
Result: function#1#1 |}];
f (Obj.magic cb5);
[%expect {|
Result: other |}]
Result: function#2#2 |}]

let%expect_test _ =
let open Js_of_ocaml in
let f = Js.wrap_callback (fun s -> print_endline (Js.to_string s)) in
let f = Js.wrap_callback (fun s -> print_endline s) in
Js.export "f" f;
let () =
Js.Unsafe.fun_call
Expand Down
Loading

0 comments on commit a759bbb

Please sign in to comment.