mbarbin / mdexp / 18

Committed 02 Apr 2026 01:44PM UTC coverage: 95.876% (+3.1%) from 92.788%

Build # 18

Build Type

push

github

Committed by

web-flow

Commit Message

Merge pull request #5 from mbarbin/assorted-improvements

Assorted improvements

Coverage Stats

191 of 203 new or added lines in 22 files covered. (94.09%)

1 existing line in 1 file now uncovered.

1674 of 1746 relevant lines covered (95.88%)

166.39 hits per line

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

94.74

/test/mdexp/test__located_json.ml

(*********************************************************************************)
(*  mdexp - Literate Programming with Embedded Snapshots                         *)
(*  SPDX-FileCopyrightText: 2025-2026 Mathieu Barbin <mathieu.barbin@gmail.com>  *)
(*  SPDX-License-Identifier: LGPL-3.0-or-later WITH LGPL-3.0-linking-exception   *)
(*********************************************************************************)

module Located_json = Mdexp.Private.Located_json
module Json5_accumulator = Mdexp.Private.Json5_accumulator
module Snapshot_config = Mdexp.Private.Snapshot_config

(** Helper: parse a single-line JSON5 config and build a Located_json. *)
let parse_single_line ~file_contents ~json5_text ~file_offset =
  let file_cache = Loc.File_cache.create ~path:(Fpath.v "test.ml") ~file_contents in
  let acc = Json5_accumulator.create () in
  match Json5_accumulator.feed acc ~file_offset ~line:json5_text with
  | Done { json_text } ->
    (match Yojson_five.Basic.from_string json_text |> Result.to_option with
     | Some (`Assoc _ as json) ->
       Some (Located_json.create ~file_cache ~accumulator:acc ~json)
     | _ -> None)
  | Need_more | Error -> None
;;

let%expect_test "key_loc returns correct position for single-line config" =
  Loc.include_sexp_of_locs := true;
  let file_contents = "(* @mdexp.snapshot { block: true, lang: \"json\" } *)\n" in
  let json5_text = "{ block: true, lang: \"json\" }" in
  let file_offset = 20 in
  (match parse_single_line ~file_contents ~json5_text ~file_offset with
   | None -> assert false
   | Some lj ->
     Option.iter (Located_json.key_loc lj "block") ~f:(fun loc ->
       Printf.printf "block key: %s\n" (Loc.to_string loc));
     Option.iter (Located_json.key_loc lj "lang") ~f:(fun loc ->
       Printf.printf "lang key: %s\n" (Loc.to_string loc)));
  Loc.include_sexp_of_locs := false;
  [%expect
    {|
    block key: File "test.ml", line 1, characters 22-27:
    lang key: File "test.ml", line 1, characters 35-39:
    |}]
;;

let%expect_test "value_loc returns correct position via phys_equal" =
  Loc.include_sexp_of_locs := true;
  let file_contents = "(* @mdexp.snapshot { block: true } *)\n" in
  let json5_text = "{ block: true }" in
  let file_offset = 20 in
  (match parse_single_line ~file_contents ~json5_text ~file_offset with
   | None -> assert false
   | Some lj ->
     let fields = Json_object.fields (Located_json.json lj) in
     (match List.assoc_opt "block" fields with
      | Some value ->
        Option.iter (Located_json.value_loc lj value) ~f:(fun loc ->
          Printf.printf "block value: %s\n" (Loc.to_string loc))
      | None -> assert false));
  Loc.include_sexp_of_locs := false;
  [%expect
    {|
    block value: File "test.ml", line 1, characters 29-33:
    |}]
;;

let%expect_test "key_loc returns None for missing key" =
  let file_contents = "{ block: true }\n" in
  let json5_text = "{ block: true }" in
  (match parse_single_line ~file_contents ~json5_text ~file_offset:0 with
   | None -> assert false
   | Some lj ->
     (match Located_json.key_loc lj "nonexistent" with
      | None -> print_endline "None (correct)"
      | Some _ -> assert false));
  [%expect {| None (correct) |}]
;;

let%expect_test "of_located_json reports unknown field" =
  Err.For_test.protect (fun () ->
    let file_contents = "(* @mdexp.snapshot { blck: true } *)\n" in
    let json5_text = "{ blck: true }" in
    let file_offset = 20 in
    match parse_single_line ~file_contents ~json5_text ~file_offset with
    | None -> assert false
    | Some lj ->
      let config =
        Snapshot_config.of_located_json ~inherited:Snapshot_config.default lj
      in
      print_dyn (Snapshot_config.to_dyn config));
  [%expect
    {|
    File "test.ml", line 1, characters 22-26:
    Error: Unknown field [blck] in snapshot configuration.
    Hint: did you mean block?
    { block = false; lang = None }
    [123]
    |}]
;;

let%expect_test "of_located_json reports wrong type for block" =
  Err.For_test.protect (fun () ->
    let file_contents = "(* @mdexp.snapshot { block: \"yes\" } *)\n" in
    let json5_text = "{ block: \"yes\" }" in
    let file_offset = 20 in
    match parse_single_line ~file_contents ~json5_text ~file_offset with
    | None -> assert false
    | Some lj ->
      let config =
        Snapshot_config.of_located_json ~inherited:Snapshot_config.default lj
      in
      print_dyn (Snapshot_config.to_dyn config));
  [%expect
    {|
    File "test.ml", line 1, characters 29-34:
    Error: Field [block] expects a boolean value.
    { block = false; lang = None }
    [123]
    |}]
;;

1	(*********************************************************************************)
2	(* mdexp - Literate Programming with Embedded Snapshots *)
3	(* SPDX-FileCopyrightText: 2025-2026 Mathieu Barbin <mathieu.barbin@gmail.com> *)
4	(* SPDX-License-Identifier: LGPL-3.0-or-later WITH LGPL-3.0-linking-exception *)
5	(*********************************************************************************)
6
7	module Located_json = Mdexp.Private.Located_json
8	module Json5_accumulator = Mdexp.Private.Json5_accumulator
9	module Snapshot_config = Mdexp.Private.Snapshot_config
10
11	(** Helper: parse a single-line JSON5 config and build a Located_json. *)
12	let parse_single_line ~file_contents ~json5_text ~file_offset =
13	let file_cache = Loc.File_cache.create ~path:(Fpath.v "test.ml") ~file_contents in	5✔
14	let acc = Json5_accumulator.create () in
15	match Json5_accumulator.feed acc ~file_offset ~line:json5_text with	5✔
16	\| Done { json_text } ->	5✔
17	(match Yojson_five.Basic.from_string json_text \|> Result.to_option with	5✔
18	\| Some (`Assoc _ as json) ->	5✔
19	Some (Located_json.create ~file_cache ~accumulator:acc ~json)
NEW 20	\| _ -> None)	×
UNCOV 21	\| Need_more \| Error -> None	×
22	;;
23
24	let%expect_test "key_loc returns correct position for single-line config" =
25	Loc.include_sexp_of_locs := true;	1✔
26	let file_contents = "(* @mdexp.snapshot { block: true, lang: \"json\" } *)\n" in
27	let json5_text = "{ block: true, lang: \"json\" }" in
28	let file_offset = 20 in
29	(match parse_single_line ~file_contents ~json5_text ~file_offset with
30	\| None -> assert false
31	\| Some lj ->	1✔
32	Option.iter (Located_json.key_loc lj "block") ~f:(fun loc ->	1✔
33	Printf.printf "block key: %s\n" (Loc.to_string loc));	1✔
34	Option.iter (Located_json.key_loc lj "lang") ~f:(fun loc ->	1✔
35	Printf.printf "lang key: %s\n" (Loc.to_string loc)));	1✔
36	Loc.include_sexp_of_locs := false;
37	[%expect
38	{\|
39	block key: File "test.ml", line 1, characters 22-27:
40	lang key: File "test.ml", line 1, characters 35-39:
41	\|}]	1✔
42	;;
43
44	let%expect_test "value_loc returns correct position via phys_equal" =
45	Loc.include_sexp_of_locs := true;	1✔
46	let file_contents = "(* @mdexp.snapshot { block: true } *)\n" in
47	let json5_text = "{ block: true }" in
48	let file_offset = 20 in
49	(match parse_single_line ~file_contents ~json5_text ~file_offset with
50	\| None -> assert false
51	\| Some lj ->	1✔
52	let fields = Json_object.fields (Located_json.json lj) in	1✔
53	(match List.assoc_opt "block" fields with	1✔
54	\| Some value ->	1✔
55	Option.iter (Located_json.value_loc lj value) ~f:(fun loc ->	1✔
56	Printf.printf "block value: %s\n" (Loc.to_string loc))	1✔
57	\| None -> assert false));
58	Loc.include_sexp_of_locs := false;
59	[%expect
60	{\|
61	block value: File "test.ml", line 1, characters 29-33:
62	\|}]	1✔
63	;;
64
65	let%expect_test "key_loc returns None for missing key" =
66	let file_contents = "{ block: true }\n" in	1✔
67	let json5_text = "{ block: true }" in
68	(match parse_single_line ~file_contents ~json5_text ~file_offset:0 with
69	\| None -> assert false
70	\| Some lj ->	1✔
71	(match Located_json.key_loc lj "nonexistent" with
72	\| None -> print_endline "None (correct)"	1✔
73	\| Some _ -> assert false));
74	[%expect {\| None (correct) \|}]	1✔
75	;;
76
77	let%expect_test "of_located_json reports unknown field" =
78	Err.For_test.protect (fun () ->	1✔
79	let file_contents = "(* @mdexp.snapshot { blck: true } *)\n" in	1✔
80	let json5_text = "{ blck: true }" in
81	let file_offset = 20 in
82	match parse_single_line ~file_contents ~json5_text ~file_offset with
83	\| None -> assert false
84	\| Some lj ->	1✔
85	let config =
86	Snapshot_config.of_located_json ~inherited:Snapshot_config.default lj
87	in
88	print_dyn (Snapshot_config.to_dyn config));	1✔
89	[%expect	1✔
90	{\|
91	File "test.ml", line 1, characters 22-26:
92	Error: Unknown field [blck] in snapshot configuration.
93	Hint: did you mean block?
94	{ block = false; lang = None }
95	[123]
96	\|}]	1✔
97	;;
98
99	let%expect_test "of_located_json reports wrong type for block" =
100	Err.For_test.protect (fun () ->	1✔
101	let file_contents = "(* @mdexp.snapshot { block: \"yes\" } *)\n" in	1✔
102	let json5_text = "{ block: \"yes\" }" in
103	let file_offset = 20 in
104	match parse_single_line ~file_contents ~json5_text ~file_offset with
105	\| None -> assert false
106	\| Some lj ->	1✔
107	let config =
108	Snapshot_config.of_located_json ~inherited:Snapshot_config.default lj
109	in
110	print_dyn (Snapshot_config.to_dyn config));	1✔
111	[%expect	1✔
112	{\|
113	File "test.ml", line 1, characters 29-34:
114	Error: Field [block] expects a boolean value.
115	{ block = false; lang = None }
116	[123]
117	\|}]	1✔
118	;;

mbarbin / mdexp / 18

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