From bbaceea3f417a38d81e79fdcff2ff54534c84593 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Thu, 5 Jan 2023 15:44:55 +0100 Subject: [PATCH 1/2] refactor(jsoo): don't ignore linkall (prepare) Signed-off-by: Hugo Heuzard --- src/dune_rules/exe.ml | 21 ++--- src/dune_rules/jsoo/jsoo_rules.ml | 100 +++++++++++---------- src/dune_rules/jsoo/jsoo_rules.mli | 3 +- src/dune_rules/link_time_code_gen.ml | 2 +- src/dune_rules/link_time_code_gen.mli | 2 +- src/dune_rules/link_time_code_gen_type.ml | 6 ++ src/dune_rules/link_time_code_gen_type.mli | 6 ++ 7 files changed, 76 insertions(+), 64 deletions(-) create mode 100644 src/dune_rules/link_time_code_gen_type.ml create mode 100644 src/dune_rules/link_time_code_gen_type.mli diff --git a/src/dune_rules/exe.ml b/src/dune_rules/exe.ml index 7f284fb5388..1ebf2009f26 100644 --- a/src/dune_rules/exe.ml +++ b/src/dune_rules/exe.ml @@ -202,21 +202,18 @@ let link_exe ~loc ~name ~(linkage : Linkage.t) ~cm_files ~link_time_code_gen | Some p -> Promote p) action_with_targets -let link_js ~name ~loc ~obj_dir ~top_sorted_modules ~promote ~link_time_code_gen - cctx = +let link_js ~name ~loc ~obj_dir ~top_sorted_modules ~link_args ~promote + ~link_time_code_gen cctx = let in_context = CC.js_of_ocaml cctx |> Option.value ~default:Js_of_ocaml.In_context.default in - let link_time_code_gen = - let open Memo.O in - let+ { Link_time_code_gen.to_link; force_linkall = _ } = - Resolve.read_memo link_time_code_gen - in - to_link - in let src = exe_path_from_name cctx ~name ~linkage:Linkage.byte_for_jsoo in + let linkall = + ignore link_args; + Action_builder.return false + in Jsoo_rules.build_exe cctx ~loc ~obj_dir ~in_context ~src ~top_sorted_modules - ~promote ~link_time_code_gen + ~promote ~link_time_code_gen ~linkall type dep_graphs = { for_exes : Module.t list Action_builder.t list } @@ -258,8 +255,8 @@ let link_many ?(link_args = Action_builder.return Command.Args.empty) ?o_files Memo.parallel_iter linkages ~f:(fun linkage -> if Linkage.is_js linkage then let obj_dir = CC.obj_dir cctx in - link_js ~loc ~name ~obj_dir ~top_sorted_modules ~promote cctx - ~link_time_code_gen + link_js ~loc ~name ~obj_dir ~top_sorted_modules ~promote + ~link_args cctx ~link_time_code_gen else let* link_time_code_gen = match Linkage.is_plugin linkage with diff --git a/src/dune_rules/jsoo/jsoo_rules.ml b/src/dune_rules/jsoo/jsoo_rules.ml index 0d1cad25586..61d7c42217e 100644 --- a/src/dune_rules/jsoo/jsoo_rules.ml +++ b/src/dune_rules/jsoo/jsoo_rules.ml @@ -202,61 +202,63 @@ let jsoo_archives ~sctx config lib = ; with_js_ext (Path.basename archive) ])) -let link_rule cc ~runtime ~target ~obj_dir cm ~flags ~link_time_code_gen = +let link_rule cc ~runtime ~target ~obj_dir cm ~flags ~linkall + ~link_time_code_gen = let sctx = Compilation_context.super_context cc in let dir = Compilation_context.dir cc in - let requires = Compilation_context.requires_link cc in - let special_units = Action_builder.of_memo link_time_code_gen in - let config = - Action_builder.of_memo_join - (Memo.map - ~f:(fun x -> x.compile) - (Super_context.js_of_ocaml_flags sctx ~dir flags)) - |> Action_builder.map ~f:Config.of_flags - in let mod_name m = Module_name.Unique.artifact_filename (Module.obj_name m) ~ext:Js_of_ocaml.Ext.cmo in let get_all = - Action_builder.map - (Action_builder.both (Action_builder.both cm special_units) config) - ~f:(fun ((cm, special_units), config) -> - Resolve.Memo.args - (let open Resolve.Memo.O in - let+ libs = requires in - (* Special case for the stdlib because it is not referenced in the - META *) - let stdlib = - Path.build - (in_build_dir ~sctx ~config - [ "stdlib"; "stdlib" ^ Js_of_ocaml.Ext.cma ]) - in - let special_units = - List.concat_map special_units ~f:(function - | Lib_flags.Lib_and_module.Lib _lib -> [] - | Module (obj_dir, m) -> - [ in_obj_dir' ~obj_dir ~config:None [ mod_name m ] ]) - in - let all_libs = List.concat_map libs ~f:(jsoo_archives ~sctx config) in + let open Action_builder.O in + let+ config = + Action_builder.of_memo_join + (Memo.map + ~f:(fun x -> x.compile) + (Super_context.js_of_ocaml_flags sctx ~dir flags)) + |> Action_builder.map ~f:Config.of_flags + and+ cm = cm + and+ libs = Resolve.Memo.read (Compilation_context.requires_link cc) + and+ { Link_time_code_gen_type.to_link; force_linkall } = + Resolve.read link_time_code_gen + and+ force_linkall2 = linkall in + (* Special case for the stdlib because it is not referenced in the + META *) + let stdlib = + Path.build + (in_build_dir ~sctx ~config + [ "stdlib"; "stdlib" ^ Js_of_ocaml.Ext.cma ]) + in + let special_units = + List.concat_map to_link ~f:(function + | Lib_flags.Lib_and_module.Lib _lib -> [] + | Module (obj_dir, m) -> + [ in_obj_dir' ~obj_dir ~config:None [ mod_name m ] ]) + in + let all_libs = List.concat_map libs ~f:(jsoo_archives ~sctx config) in - let all_other_modules = - List.map cm ~f:(fun m -> - Path.build (in_obj_dir ~obj_dir ~config:None [ mod_name m ])) - in - let std_exit = - Path.build - (in_build_dir ~sctx ~config - [ "stdlib"; "std_exit" ^ Js_of_ocaml.Ext.cmo ]) - in - Command.Args.Deps - (List.concat - [ [ stdlib ] - ; special_units - ; all_libs - ; all_other_modules - ; [ std_exit ] - ]))) + let all_other_modules = + List.map cm ~f:(fun m -> + Path.build (in_obj_dir ~obj_dir ~config:None [ mod_name m ])) + in + let std_exit = + Path.build + (in_build_dir ~sctx ~config + [ "stdlib"; "std_exit" ^ Js_of_ocaml.Ext.cmo ]) + in + let linkall = force_linkall || force_linkall2 in + ignore linkall; + Command.Args.S + [ Deps + (List.concat + [ [ stdlib ] + ; special_units + ; all_libs + ; all_other_modules + ; [ std_exit ] + ]) + ] in let spec = Command.Args.S [ Dep (Path.build runtime); Dyn get_all ] in js_of_ocaml_rule sctx ~sub_command:Link ~dir ~spec ~target ~flags ~config:None @@ -319,7 +321,7 @@ let setup_separate_compilation_rules sctx components = >>= Super_context.add_rule sctx ~dir)) let build_exe cc ~loc ~in_context ~src ~(obj_dir : Path.Build.t Obj_dir.t) - ~(top_sorted_modules : Module.t list Action_builder.t) ~promote + ~(top_sorted_modules : Module.t list Action_builder.t) ~promote ~linkall ~link_time_code_gen = let sctx = Compilation_context.super_context cc in let dir = Compilation_context.dir cc in @@ -344,7 +346,7 @@ let build_exe cc ~loc ~in_context ~src ~(obj_dir : Path.Build.t Obj_dir.t) ~flags >>= Super_context.add_rule ~loc sctx ~dir >>> link_rule cc ~runtime:standalone_runtime ~target ~obj_dir - top_sorted_modules ~flags ~link_time_code_gen + top_sorted_modules ~flags ~linkall ~link_time_code_gen >>= Super_context.add_rule sctx ~loc ~dir ~mode | Whole_program -> exe_rule cc ~javascript_files ~src ~target ~flags diff --git a/src/dune_rules/jsoo/jsoo_rules.mli b/src/dune_rules/jsoo/jsoo_rules.mli index d83369cc04b..ab9042f242c 100644 --- a/src/dune_rules/jsoo/jsoo_rules.mli +++ b/src/dune_rules/jsoo/jsoo_rules.mli @@ -25,7 +25,8 @@ val build_exe : -> obj_dir:Path.Build.t Obj_dir.t -> top_sorted_modules:Module.t list Action_builder.t -> promote:Rule.Promote.t option - -> link_time_code_gen:Lib_flags.Lib_and_module.L.t Memo.t + -> linkall:bool Action_builder.t + -> link_time_code_gen:Link_time_code_gen_type.t Resolve.t -> unit Memo.t val setup_separate_compilation_rules : diff --git a/src/dune_rules/link_time_code_gen.ml b/src/dune_rules/link_time_code_gen.ml index d49b2b1b427..d0d454bb457 100644 --- a/src/dune_rules/link_time_code_gen.ml +++ b/src/dune_rules/link_time_code_gen.ml @@ -1,6 +1,6 @@ open Import -type t = +type t = Link_time_code_gen_type.t = { to_link : Lib_flags.Lib_and_module.L.t ; force_linkall : bool } diff --git a/src/dune_rules/link_time_code_gen.mli b/src/dune_rules/link_time_code_gen.mli index 7fc8ecafb32..fcd86ab0bf5 100644 --- a/src/dune_rules/link_time_code_gen.mli +++ b/src/dune_rules/link_time_code_gen.mli @@ -1,6 +1,6 @@ (** {1 Handle link time code generation} *) -type t = +type t = Link_time_code_gen_type.t = { to_link : Lib_flags.Lib_and_module.L.t ; force_linkall : bool } diff --git a/src/dune_rules/link_time_code_gen_type.ml b/src/dune_rules/link_time_code_gen_type.ml new file mode 100644 index 00000000000..ee9f73d794b --- /dev/null +++ b/src/dune_rules/link_time_code_gen_type.ml @@ -0,0 +1,6 @@ +open! Import + +type t = + { to_link : Lib_flags.Lib_and_module.L.t + ; force_linkall : bool + } diff --git a/src/dune_rules/link_time_code_gen_type.mli b/src/dune_rules/link_time_code_gen_type.mli new file mode 100644 index 00000000000..ee9f73d794b --- /dev/null +++ b/src/dune_rules/link_time_code_gen_type.mli @@ -0,0 +1,6 @@ +open! Import + +type t = + { to_link : Lib_flags.Lib_and_module.L.t + ; force_linkall : bool + } From 35b9f13237d10d1afdde587d6e18c31cda0adb51 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Thu, 5 Jan 2023 16:32:43 +0100 Subject: [PATCH 2/2] fix(jsoo): don't ignore linkall Signed-off-by: Hugo Heuzard --- CHANGES.md | 2 + src/dune_rules/command.mli | 6 ++ src/dune_rules/dune_rules.ml | 1 + src/dune_rules/exe.ml | 8 ++- src/dune_rules/jsoo/jsoo_rules.ml | 58 ++++++++++++++++++- src/dune_rules/jsoo/jsoo_rules.mli | 8 +++ .../test-cases/jsoo/inline-tests.t/run.t | 4 +- .../test-cases/jsoo/jsoo-config.t/run.t | 4 +- .../test-cases/jsoo/no-check-prim.t/run.t | 6 +- .../test-cases/jsoo/public-libs.t/run.t | 4 +- test/expect-tests/jsoo_tests.ml | 48 +++++++++++++++ 11 files changed, 135 insertions(+), 14 deletions(-) create mode 100644 test/expect-tests/jsoo_tests.ml diff --git a/CHANGES.md b/CHANGES.md index 5e6dd86c7e2..fa016faf7fb 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -81,6 +81,8 @@ Unreleased - Fix *js_of_ocaml* separate compilation rules when `--enable=effects` or `--enable=use-js-string` is used. (#6714, #6828, @hhugo) +- Fix *js_of_ocaml* separate compilation in presence of linkall (#6832, @hhugo) + - Remove spurious build dir created when running `dune init proj ...` (#6707, fixes #5429, @gridbugs) diff --git a/src/dune_rules/command.mli b/src/dune_rules/command.mli index 1141d97f9ab..52e484f201e 100644 --- a/src/dune_rules/command.mli +++ b/src/dune_rules/command.mli @@ -108,3 +108,9 @@ end command in directory [dir]. *) val expand : dir:Path.t -> 'a Args.t -> string list Action_builder.With_targets.t + +(** [expand_no_targets ~dir args] interprets the command line arguments [args] + to produce corresponding strings, assuming they will be used as arguments to + run a command in directory [dir]. *) +val expand_no_targets : + dir:Path.t -> Args.without_targets Args.t -> string list Action_builder.t diff --git a/src/dune_rules/dune_rules.ml b/src/dune_rules/dune_rules.ml index a3a8ff2a4a0..1f980da9e4b 100644 --- a/src/dune_rules/dune_rules.ml +++ b/src/dune_rules/dune_rules.ml @@ -17,6 +17,7 @@ module Modules = Modules module Module_compilation = Module_compilation module Exe_rules = Exe_rules module Lib_rules = Lib_rules +module Jsoo_rules = Jsoo_rules module Obj_dir = Obj_dir module Merlin_ident = Merlin_ident module Merlin = Merlin diff --git a/src/dune_rules/exe.ml b/src/dune_rules/exe.ml index 1ebf2009f26..101fe4e6f53 100644 --- a/src/dune_rules/exe.ml +++ b/src/dune_rules/exe.ml @@ -209,8 +209,12 @@ let link_js ~name ~loc ~obj_dir ~top_sorted_modules ~link_args ~promote in let src = exe_path_from_name cctx ~name ~linkage:Linkage.byte_for_jsoo in let linkall = - ignore link_args; - Action_builder.return false + Action_builder.bind link_args ~f:(fun cmd -> + let open Action_builder.O in + let+ l = + Command.expand_no_targets ~dir:(Path.build (CC.dir cctx)) cmd + in + List.exists l ~f:(String.equal "--linkall")) in Jsoo_rules.build_exe cctx ~loc ~obj_dir ~in_context ~src ~top_sorted_modules ~promote ~link_time_code_gen ~linkall diff --git a/src/dune_rules/jsoo/jsoo_rules.ml b/src/dune_rules/jsoo/jsoo_rules.ml index 61d7c42217e..28cf2c46d0d 100644 --- a/src/dune_rules/jsoo/jsoo_rules.ml +++ b/src/dune_rules/jsoo/jsoo_rules.ml @@ -72,6 +72,49 @@ end = struct | name, false -> [ "--disable"; name ]) end +module Version = struct + type t = int * int + + let of_string s : t option = + let s = + match + String.findi s ~f:(function + | '+' | '-' | '~' -> true + | _ -> false) + with + | None -> s + | Some i -> String.take s i + in + try + match String.split s ~on:'.' with + | [] -> None + | [ major ] -> Some (int_of_string major, 0) + | major :: minor :: _ -> Some (int_of_string major, int_of_string minor) + with _ -> None + + let compare (ma1, mi1) (ma2, mi2) = + match Int.compare ma1 ma2 with + | Eq -> Int.compare mi1 mi2 + | n -> n + + let impl_version bin = + let open Memo.O in + let* _ = Build_system.build_file bin in + Memo.of_reproducible_fiber + @@ Process.run_capture_line Process.Strict bin [ "--version" ] + |> Memo.map ~f:of_string + + let version_memo = + Memo.create "jsoo-version" ~input:(module Path) impl_version + + let jsoo_version path = + let open Memo.O in + let* jsoo = path in + match jsoo with + | Ok jsoo_path -> Memo.exec version_memo jsoo_path + | Error e -> Action.Prog.Not_found.raise e +end + let install_jsoo_hint = "opam install js_of_ocaml-compiler" let in_build_dir ~sctx ~config args = @@ -219,10 +262,13 @@ let link_rule cc ~runtime ~target ~obj_dir cm ~flags ~linkall (Super_context.js_of_ocaml_flags sctx ~dir flags)) |> Action_builder.map ~f:Config.of_flags and+ cm = cm + and+ linkall = linkall and+ libs = Resolve.Memo.read (Compilation_context.requires_link cc) and+ { Link_time_code_gen_type.to_link; force_linkall } = Resolve.read link_time_code_gen - and+ force_linkall2 = linkall in + and+ jsoo_version = + Action_builder.of_memo (Version.jsoo_version (jsoo ~dir sctx)) + in (* Special case for the stdlib because it is not referenced in the META *) let stdlib = @@ -247,8 +293,7 @@ let link_rule cc ~runtime ~target ~obj_dir cm ~flags ~linkall (in_build_dir ~sctx ~config [ "stdlib"; "std_exit" ^ Js_of_ocaml.Ext.cmo ]) in - let linkall = force_linkall || force_linkall2 in - ignore linkall; + let linkall = force_linkall || linkall in Command.Args.S [ Deps (List.concat @@ -258,6 +303,13 @@ let link_rule cc ~runtime ~target ~obj_dir cm ~flags ~linkall ; all_other_modules ; [ std_exit ] ]) + ; As + (match (jsoo_version, linkall) with + | Some version, true -> ( + match Version.compare version (5, 1) with + | Lt -> [] + | Gt | Eq -> [ "--linkall" ]) + | None, _ | _, false -> []) ] in let spec = Command.Args.S [ Dep (Path.build runtime); Dyn get_all ] in diff --git a/src/dune_rules/jsoo/jsoo_rules.mli b/src/dune_rules/jsoo/jsoo_rules.mli index ab9042f242c..b374fdf588e 100644 --- a/src/dune_rules/jsoo/jsoo_rules.mli +++ b/src/dune_rules/jsoo/jsoo_rules.mli @@ -8,6 +8,14 @@ module Config : sig val all : t list end +module Version : sig + type t = int * int + + val of_string : string -> t option + + val compare : t -> t -> Ordering.t +end + val build_cm : Super_context.t -> dir:Path.Build.t diff --git a/test/blackbox-tests/test-cases/jsoo/inline-tests.t/run.t b/test/blackbox-tests/test-cases/jsoo/inline-tests.t/run.t index fff4e506fa5..6fd29a5a001 100644 --- a/test/blackbox-tests/test-cases/jsoo/inline-tests.t/run.t +++ b/test/blackbox-tests/test-cases/jsoo/inline-tests.t/run.t @@ -7,10 +7,10 @@ Run inline tests using node js $ dune runtest inline tests (Byte) inline tests (Byte) - inline tests (JS) - inline tests (JS) inline tests (Native) inline tests (Native) + inline tests (JS) + inline tests (JS) $ dune runtest --profile release inline tests (JS) diff --git a/test/blackbox-tests/test-cases/jsoo/jsoo-config.t/run.t b/test/blackbox-tests/test-cases/jsoo/jsoo-config.t/run.t index 1608afac145..ba4ddc341d5 100644 --- a/test/blackbox-tests/test-cases/jsoo/jsoo-config.t/run.t +++ b/test/blackbox-tests/test-cases/jsoo/jsoo-config.t/run.t @@ -2,13 +2,13 @@ tests js_of_ocaml conigs $ dune build bin/bin1.bc.js bin/bin2.bc.js bin/bin3.bc.js --display short js_of_ocaml bin/.bin1.eobjs/jsoo/bin1.bc.runtime.js + js_of_ocaml bin/.bin2.eobjs/jsoo/bin2.bc.runtime.js + js_of_ocaml bin/.bin3.eobjs/jsoo/bin3.bc.runtime.js js_of_ocaml .js/use-js-string/stdlib/std_exit.cmo.js js_of_ocaml .js/use-js-string/stdlib/stdlib.cma.js ocamlc lib/.library1.objs/byte/library1.{cmi,cmo,cmt} - js_of_ocaml bin/.bin2.eobjs/jsoo/bin2.bc.runtime.js js_of_ocaml .js/!use-js-string/stdlib/std_exit.cmo.js js_of_ocaml .js/!use-js-string/stdlib/stdlib.cma.js - js_of_ocaml bin/.bin3.eobjs/jsoo/bin3.bc.runtime.js js_of_ocaml .js/default/stdlib/std_exit.cmo.js js_of_ocaml .js/default/stdlib/stdlib.cma.js ocamlc bin/.bin1.eobjs/byte/dune__exe__Bin1.{cmi,cmti} diff --git a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/run.t b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/run.t index e308f59342a..80efcc06f6c 100644 --- a/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/run.t +++ b/test/blackbox-tests/test-cases/jsoo/no-check-prim.t/run.t @@ -61,13 +61,13 @@ Compilation using jsoo ocamlopt lib/.x.objs/native/x__.{cmx,o} ocamlc lib/.x.objs/byte/x.{cmi,cmo,cmt} ocamlopt lib/.x.objs/native/x__Y.{cmx,o} - ocamlc bin/.technologic.eobjs/byte/z.{cmi,cmo,cmt} ocamlopt lib/.x.objs/native/x.{cmx,o} + ocamlc bin/.technologic.eobjs/byte/z.{cmi,cmo,cmt} ocamlc lib/x.cma - ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt} ocamlopt lib/x.{a,cmxa} - js_of_ocaml bin/technologic.bc.js + ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt} ocamlopt lib/x.cmxs + js_of_ocaml bin/technologic.bc.js $ dune build --display short bin/technologic.bc.js @install --profile release ocamlc lib/.x.objs/byte/x__.{cmi,cmo,cmt} ocamlc lib/.x.objs/byte/x__Y.{cmi,cmo,cmt} diff --git a/test/blackbox-tests/test-cases/jsoo/public-libs.t/run.t b/test/blackbox-tests/test-cases/jsoo/public-libs.t/run.t index c1c4965d67c..bb44601c9c9 100644 --- a/test/blackbox-tests/test-cases/jsoo/public-libs.t/run.t +++ b/test/blackbox-tests/test-cases/jsoo/public-libs.t/run.t @@ -3,11 +3,11 @@ Compilation of libraries with pulic-names $ dune build --display short ocamlc a/.a.objs/byte/a.{cmi,cmo,cmt} js_of_ocaml b/.main.eobjs/jsoo/main.bc.runtime.js - js_of_ocaml .js/default/stdlib/std_exit.cmo.js - js_of_ocaml .js/default/stdlib/stdlib.cma.js ocamlopt a/.a.objs/native/a.{cmx,o} ocamlc b/.main.eobjs/byte/dune__exe__Main.{cmi,cmti} ocamlc a/a.cma + js_of_ocaml .js/default/stdlib/std_exit.cmo.js + js_of_ocaml .js/default/stdlib/stdlib.cma.js ocamlopt a/a.{a,cmxa} ocamlc b/.main.eobjs/byte/dune__exe__Main.{cmo,cmt} js_of_ocaml a/.a.objs/jsoo/default/a.cma.js diff --git a/test/expect-tests/jsoo_tests.ml b/test/expect-tests/jsoo_tests.ml new file mode 100644 index 00000000000..4b4f519cad9 --- /dev/null +++ b/test/expect-tests/jsoo_tests.ml @@ -0,0 +1,48 @@ +open Stdune +module Jsoo_rules = Dune_rules.Jsoo_rules + +let%expect_test _ = + let test s l = + match Jsoo_rules.Version.of_string s with + | None -> print_endline "Could not parse version" + | Some version -> + let c = Jsoo_rules.Version.compare version l in + let r = + match c with + | Eq -> "=" + | Lt -> "<" + | Gt -> ">" + in + print_endline r + in + (* equal *) + test "5.0.1" (5, 0); + [%expect {| = |}]; + test "5.0.0" (5, 0); + [%expect {| = |}]; + test "5.0" (5, 0); + [%expect {| = |}]; + test "5" (5, 0); + [%expect {| = |}]; + test "5.0+1" (5, 0); + [%expect {| = |}]; + test "5.0~1" (5, 0); + [%expect {| = |}]; + test "5.0+1" (5, 0); + [%expect {| = |}]; + test "5.0.1+git-5.0.1-14-g904cf100b0" (5, 0); + [%expect {| = |}]; + + test "5.0.1" (5, 1); + [%expect {| < |}]; + test "5.0" (5, 1); + [%expect {| < |}]; + test "5.1.1" (5, 0); + [%expect {| > |}]; + test "5.1" (5, 0); + [%expect {| > |}]; + test "4.0.1" (5, 0); + [%expect {| < |}]; + test "5.0.1" (4, 0); + [%expect {| > |}]; + ()