Kakadu / zanuda / 66

Committed 18 Jun 2026 12:48PM UTC coverage: 83.301% (+0.3%) from 82.988%

Build # 66

Build Type

push

github

Committed by

Kakadu

Commit Message

ci: reenable coverage calculation for 4.14

Signed-off-by: Kakadu <Kakadu@pm.me>

Coverage Stats

2170 of 2605 relevant lines covered (83.3%)

553.79 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

87.32

/src/pattern/ast_pattern_tests.ml

open Compenv

[%%if ocaml_version < (5, 0, 0)]

let type_implementation source_file =
  let outputprefix = output_prefix source_file in
  let modulename = "Module1" in
  Env.set_unit_name modulename;
  Typemod.type_implementation source_file outputprefix modulename
;;

[%%else]

let type_implementation file =
  Typemod.type_implementation Unit_info.(make ~source_file:file Impl "")
;;

[%%endif]

let translate filename =
  Compmisc.init_path ();
  let env = Compmisc.initial_env () in
  try
    let parsetree = Pparse.parse_implementation ~tool_name:"xxx" filename in
    let { Typedtree.structure = typedtree; _ } =
      type_implementation filename env parsetree
    in
    parsetree, typedtree
  with
  | Typetexp.Error (_loc, env, e) as exc ->
    Typetexp.report_error env Format.std_formatter e;
    Format.printf "\n%!";
    raise exc
  | x -> raise x
;;

let extract_first =
  let open Parsetree in
  function
  | [ { pstr_desc = Pstr_value (_, [ vb ]) } ] -> vb.pvb_expr
  | _ -> assert false
;;

let extract_first_typed =
  let open Typedtree in
  fun str ->
    match str.str_items with
    | [ { str_desc = Tstr_value (_, [ vb ]) } ] -> vb.vb_expr
    | _ -> assert false
;;

let run_string code line pat sk =
  let filename = Printf.sprintf "tmp%d.ml" line in
  Out_channel.with_open_text filename (fun ch -> output_string ch code);
  let parsetree, _ = translate filename in
  let expr = extract_first parsetree in
  Tast_pattern.parse pat Location.none expr sk ~on_error:(Printf.printf "ERROR: %s\n")
;;

let run_si code line pat sk =
  let filename = Printf.sprintf "tmp%d.ml" line in
  Out_channel.with_open_text filename (fun ch -> output_string ch code);
  let parsetree, _ = translate filename in
  let expr = List.hd parsetree in
  Tast_pattern.parse pat Location.none expr sk ~on_error:(Printf.printf "ERROR: %s\n")
;;

let run_string_typed code line pat sk =
  let filename = Printf.sprintf "tmp%d.ml" line in
  Out_channel.with_open_text filename (fun ch -> output_string ch code);
  let _, ttree = translate filename in
  let expr = extract_first_typed ttree in
  Tast_pattern.parse pat Location.none expr sk ~on_error:(Printf.printf "ERROR: %s\n")
;;

let run_si_typed code line pat sk =
  let filename = Printf.sprintf "tmp%d.ml" line in
  Out_channel.with_open_text filename (fun ch -> output_string ch code);
  let _, ttree = translate filename in
  let expr = List.hd ttree.Typedtree.str_items in
  Tast_pattern.parse pat Location.none expr sk ~on_error:(Printf.printf "ERROR: %s\n")
;;

let default_sk pats _cases =
  Format.printf
    "patterns: @[%a@]\n%!"
    (Format.pp_print_list
       ~pp_sep:(fun ppf () -> Format.pp_print_char ppf ' ')
       Pprintast.pattern)
    pats;
  print_endline "success"
;;

let%expect_test _ =
  let code = {| let f x y = function true -> 1 | false -> 0 |} in
  run_string code __LINE__ Tast_pattern.(pexp_function_cases __ __) default_sk;
  [%expect
    {|
    patterns: x y
    success|}]
;;

let%expect_test _ =
  let code = {| let f x y = function true -> 1 | false -> 0 |} in
  run_string
    code
    __LINE__
    Tast_pattern.(pexp_function_cases (as__ (drop ^:: drop ^:: nil)) __)
    default_sk;
  [%expect
    {|
    patterns: x y
    success |}]
;;

let%expect_test _ =
  let code =
    {|
let backslash = fun ch ->
  match ch with
  | ch when List.mem ch [ "$"; "'"; "\""; "\\"; "\n" ] -> ch
  | "\n" -> ""
  | ch -> "" ^ ch
|}
  in
  run_string_typed
    code
    __LINE__
    Tast_pattern.(
      texp_function_body
        ((nolabel ** __) ^:: nil)
        (as__ (texp_match (texp_ident_loc __) drop __)))
    (fun (id, _) _ _ path cases ->
      Format.printf "Ident = %s\n%!" (Ident.name id);
      (match path with
       | Path.Pident id -> Format.printf "Ident = %s\n%!" (Ident.name id)
       | _ -> assert false);
      Format.printf "cases count = %d\n%!" (List.length cases);
      print_endline "OK");
  [%expect
    {|
    Ident = ch
    Ident = ch
    cases count = 3
    OK |}]
;;

let () = ()

let%expect_test _ =
  let code = {| let f x y = function true -> 1 | false -> 0 |} in
  run_string code __LINE__ Tast_pattern.(pexp_function_cases (list __) __) default_sk;
  [%expect
    {|

    patterns: x y
    success|}];
  let code = {| let f x y = x+y |} in
  run_string
    code
    __LINE__
    Tast_pattern.(pexp_function_body drop (pexp_apply drop (list (drop ** __))))
    (fun args ->
      Format.printf
        "%a%!"
        Format.(
          pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf " ") Pprintast.expression)
        args
      (* List.iter (Format.printf "%a\n%!" Pprintast.expression) args *));
  [%expect
    {|

    x y|}]
;;

let%expect_test "Parse typed zanuda attribute" =
  let code = {| [@@@zanuda "asdf"] |} in
  run_si_typed code __LINE__ Tast_pattern.(tstr_zanuda_attr __) (fun s -> print_endline s);
  [%expect {| asdf |}]
;;

1	open Compenv
2
3	[%%if ocaml_version < (5, 0, 0)]
4
5	let type_implementation source_file =
6	let outputprefix = output_prefix source_file in	6✔
7	let modulename = "Module1" in	6✔
8	Env.set_unit_name modulename;
9	Typemod.type_implementation source_file outputprefix modulename	6✔
10	;;
11
12	[%%else]
13
14	let type_implementation file =
15	Typemod.type_implementation Unit_info.(make ~source_file:file Impl "")
16	;;
17
18	[%%endif]
19
20	let translate filename =
21	Compmisc.init_path ();	6✔
22	let env = Compmisc.initial_env () in	6✔
23	try	6✔
24	let parsetree = Pparse.parse_implementation ~tool_name:"xxx" filename in
25	let { Typedtree.structure = typedtree; _ } =	6✔
26	type_implementation filename env parsetree
27	in
28	parsetree, typedtree	6✔
29	with
30	\| Typetexp.Error (_loc, env, e) as exc ->	×
31	Typetexp.report_error env Format.std_formatter e;
32	Format.printf "\n%!";	×
33	raise exc	×
34	\| x -> raise x	×
35	;;
36
37	let extract_first =
38	let open Parsetree in
39	function
40	\| [ { pstr_desc = Pstr_value (_, [ vb ]) } ] -> vb.pvb_expr	4✔
41	\| _ -> assert false
42	;;
43
44	let extract_first_typed =
45	let open Typedtree in
46	fun str ->
47	match str.str_items with	1✔
48	\| [ { str_desc = Tstr_value (_, [ vb ]) } ] -> vb.vb_expr	1✔
49	\| _ -> assert false
50	;;
51
52	let run_string code line pat sk =
53	let filename = Printf.sprintf "tmp%d.ml" line in	4✔
54	Out_channel.with_open_text filename (fun ch -> output_string ch code);	4✔
55	let parsetree, _ = translate filename in	4✔
56	let expr = extract_first parsetree in	4✔
57	Tast_pattern.parse pat Location.none expr sk ~on_error:(Printf.printf "ERROR: %s\n")	4✔
58	;;
59
60	let run_si code line pat sk =
61	let filename = Printf.sprintf "tmp%d.ml" line in	×
62	Out_channel.with_open_text filename (fun ch -> output_string ch code);	×
63	let parsetree, _ = translate filename in	×
64	let expr = List.hd parsetree in	×
65	Tast_pattern.parse pat Location.none expr sk ~on_error:(Printf.printf "ERROR: %s\n")	×
66	;;
67
68	let run_string_typed code line pat sk =
69	let filename = Printf.sprintf "tmp%d.ml" line in	1✔
70	Out_channel.with_open_text filename (fun ch -> output_string ch code);	1✔
71	let _, ttree = translate filename in	1✔
72	let expr = extract_first_typed ttree in	1✔
73	Tast_pattern.parse pat Location.none expr sk ~on_error:(Printf.printf "ERROR: %s\n")	1✔
74	;;
75
76	let run_si_typed code line pat sk =
77	let filename = Printf.sprintf "tmp%d.ml" line in	1✔
78	Out_channel.with_open_text filename (fun ch -> output_string ch code);	1✔
79	let _, ttree = translate filename in	1✔
80	let expr = List.hd ttree.Typedtree.str_items in	1✔
81	Tast_pattern.parse pat Location.none expr sk ~on_error:(Printf.printf "ERROR: %s\n")	1✔
82	;;
83
84	let default_sk pats _cases =
85	Format.printf	3✔
86	"patterns: @[%a@]\n%!"
87	(Format.pp_print_list	3✔
88	~pp_sep:(fun ppf () -> Format.pp_print_char ppf ' ')	3✔
89	Pprintast.pattern)
90	pats;
91	print_endline "success"	3✔
92	;;
93
94	let%expect_test _ =
95	let code = {\| let f x y = function true -> 1 \| false -> 0 \|} in	1✔
96	run_string code __LINE__ Tast_pattern.(pexp_function_cases __ __) default_sk;	1✔
97	[%expect	1✔
98	{\|
99	patterns: x y
100	success\|}]	5✔
101	;;
102
103	let%expect_test _ =
104	let code = {\| let f x y = function true -> 1 \| false -> 0 \|} in	1✔
105	run_string
106	code
107	__LINE__
108	Tast_pattern.(pexp_function_cases (as__ (drop ^:: drop ^:: nil)) __)	1✔
109	default_sk;
110	[%expect	1✔
111	{\|
112	patterns: x y
113	success \|}]	5✔
114	;;
115
116	let%expect_test _ =
117	let code =	1✔
118	{\|
119	let backslash = fun ch ->
120	match ch with
121	\| ch when List.mem ch [ "$"; "'"; "\""; "\\"; "\n" ] -> ch
122	\| "\n" -> ""
123	\| ch -> "" ^ ch
124	\|}
125	in
126	run_string_typed
127	code
128	__LINE__
129	Tast_pattern.(
130	texp_function_body	1✔
131	((nolabel ** __) ^:: nil)	1✔
132	(as__ (texp_match (texp_ident_loc __) drop __)))	1✔
133	(fun (id, _) _ _ path cases ->
134	Format.printf "Ident = %s\n%!" (Ident.name id);	1✔
135	(match path with	1✔
136	\| Path.Pident id -> Format.printf "Ident = %s\n%!" (Ident.name id)	1✔
137	\| _ -> assert false);
138	Format.printf "cases count = %d\n%!" (List.length cases);	1✔
139	print_endline "OK");	1✔
140	[%expect	1✔
141	{\|
142	Ident = ch
143	Ident = ch
144	cases count = 3
145	OK \|}]	5✔
146	;;
147
148	let () = ()
149
150	let%expect_test _ =
151	let code = {\| let f x y = function true -> 1 \| false -> 0 \|} in	1✔
152	run_string code __LINE__ Tast_pattern.(pexp_function_cases (list __) __) default_sk;	1✔
153	[%expect	1✔
154	{\|
155
156	patterns: x y
157	success\|}];	5✔
158	let code = {\| let f x y = x+y \|} in	1✔
159	run_string
160	code
161	__LINE__
162	Tast_pattern.(pexp_function_body drop (pexp_apply drop (list (drop ** __))))	1✔
163	(fun args ->
164	Format.printf	1✔
165	"%a%!"
166	Format.(
167	pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf " ") Pprintast.expression)	1✔
168	args
169	(* List.iter (Format.printf "%a\n%!" Pprintast.expression) args *));
170	[%expect	1✔
171	{\|
172
173	x y\|}]	5✔
174	;;
175
176	let%expect_test "Parse typed zanuda attribute" =
177	let code = {\| [@@@zanuda "asdf"] \|} in	1✔
178	run_si_typed code __LINE__ Tast_pattern.(tstr_zanuda_attr __) (fun s -> print_endline s);	1✔
179	[%expect {\| asdf \|}]	1✔
180	;;

Kakadu / zanuda / 66

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous