anil.recoil.org
Yaml encoder/decoder for OCaml jsont codecs
location tests
+508
-1
+5
tests/bin/dune
+5
tests/bin/dune
+260
tests/bin/test_locations.ml
+260
tests/bin/test_locations.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2024 The yamlrw programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Test location and layout preservation options with Yamlt codec *)
7
+
8
+
(* Helper to read file *)
9
+
let read_file path =
10
+
let ic = open_in path in
11
+
let len = in_channel_length ic in
12
+
let s = really_input_string ic len in
13
+
close_in ic;
14
+
s
15
+
16
+
(* Helper to show results *)
17
+
let show_result label = function
18
+
| Ok _ -> Printf.printf "%s: OK\n" label
19
+
| Error e -> Printf.printf "%s:\n%s\n" label e
20
+
21
+
(* Test: Compare error messages with and without locs *)
22
+
let test_error_precision file =
23
+
let yaml = read_file file in
24
+
25
+
(* Define a codec that will fail on type mismatch *)
26
+
let codec =
27
+
Jsont.Object.map ~kind:"Person" (fun name age -> (name, age))
28
+
|> Jsont.Object.mem "name" Jsont.string ~enc:fst
29
+
|> Jsont.Object.mem "age" Jsont.int ~enc:snd
30
+
|> Jsont.Object.finish
31
+
in
32
+
33
+
Printf.printf "=== Without locs (default) ===\n";
34
+
let result_no_locs = Yamlt.decode_string ~locs:false codec yaml in
35
+
show_result "Error message" result_no_locs;
36
+
37
+
Printf.printf "\n=== With locs=true ===\n";
38
+
let result_with_locs = Yamlt.decode_string ~locs:true codec yaml in
39
+
show_result "Error message" result_with_locs
40
+
41
+
(* Test: Show error locations for nested structures *)
42
+
let test_nested_error file =
43
+
let yaml = read_file file in
44
+
45
+
(* Nested object codec *)
46
+
let address_codec =
47
+
Jsont.Object.map ~kind:"Address" (fun street city zip -> (street, city, zip))
48
+
|> Jsont.Object.mem "street" Jsont.string ~enc:(fun (s,_,_) -> s)
49
+
|> Jsont.Object.mem "city" Jsont.string ~enc:(fun (_,c,_) -> c)
50
+
|> Jsont.Object.mem "zip" Jsont.int ~enc:(fun (_,_,z) -> z)
51
+
|> Jsont.Object.finish
52
+
in
53
+
54
+
let codec =
55
+
Jsont.Object.map ~kind:"Employee" (fun name address -> (name, address))
56
+
|> Jsont.Object.mem "name" Jsont.string ~enc:fst
57
+
|> Jsont.Object.mem "address" address_codec ~enc:snd
58
+
|> Jsont.Object.finish
59
+
in
60
+
61
+
Printf.printf "=== Without locs (default) ===\n";
62
+
let result_no_locs = Yamlt.decode_string ~locs:false codec yaml in
63
+
show_result "Nested error" result_no_locs;
64
+
65
+
Printf.printf "\n=== With locs=true ===\n";
66
+
let result_with_locs = Yamlt.decode_string ~locs:true codec yaml in
67
+
show_result "Nested error" result_with_locs
68
+
69
+
(* Test: Array element error locations *)
70
+
let test_array_error file =
71
+
let yaml = read_file file in
72
+
73
+
(* Array codec *)
74
+
let codec =
75
+
Jsont.Object.map ~kind:"Numbers" (fun nums -> nums)
76
+
|> Jsont.Object.mem "values" (Jsont.array Jsont.int) ~enc:(fun n -> n)
77
+
|> Jsont.Object.finish
78
+
in
79
+
80
+
Printf.printf "=== Without locs (default) ===\n";
81
+
let result_no_locs = Yamlt.decode_string ~locs:false codec yaml in
82
+
show_result "Array error" result_no_locs;
83
+
84
+
Printf.printf "\n=== With locs=true ===\n";
85
+
let result_with_locs = Yamlt.decode_string ~locs:true codec yaml in
86
+
show_result "Array error" result_with_locs
87
+
88
+
(* Test: Layout preservation - check if we can decode with layout info *)
89
+
let test_layout_preservation file =
90
+
let yaml = read_file file in
91
+
92
+
let codec =
93
+
Jsont.Object.map ~kind:"Config" (fun host port -> (host, port))
94
+
|> Jsont.Object.mem "host" Jsont.string ~enc:fst
95
+
|> Jsont.Object.mem "port" Jsont.int ~enc:snd
96
+
|> Jsont.Object.finish
97
+
in
98
+
99
+
Printf.printf "=== Without layout (default) ===\n";
100
+
(match Yamlt.decode_string ~layout:false codec yaml with
101
+
| Ok (host, port) ->
102
+
Printf.printf "Decoded: host=%s, port=%d\n" host port;
103
+
Printf.printf "Meta preserved: no\n"
104
+
| Error e -> Printf.printf "Error: %s\n" e);
105
+
106
+
Printf.printf "\n=== With layout=true ===\n";
107
+
(match Yamlt.decode_string ~layout:true codec yaml with
108
+
| Ok (host, port) ->
109
+
Printf.printf "Decoded: host=%s, port=%d\n" host port;
110
+
Printf.printf "Meta preserved: yes (style info available for round-tripping)\n"
111
+
| Error e -> Printf.printf "Error: %s\n" e)
112
+
113
+
(* Test: Round-trip with layout preservation *)
114
+
let test_roundtrip_layout file =
115
+
let yaml = read_file file in
116
+
117
+
let codec =
118
+
Jsont.Object.map ~kind:"Data" (fun items -> items)
119
+
|> Jsont.Object.mem "items" (Jsont.array Jsont.string) ~enc:(fun x -> x)
120
+
|> Jsont.Object.finish
121
+
in
122
+
123
+
Printf.printf "=== Original YAML ===\n";
124
+
Printf.printf "%s\n" (String.trim yaml);
125
+
126
+
Printf.printf "\n=== Decode without layout, re-encode ===\n";
127
+
(match Yamlt.decode_string ~layout:false codec yaml with
128
+
| Ok items ->
129
+
(match Yamlt.encode_string ~format:Yamlt.Block codec items with
130
+
| Ok yaml_out -> Printf.printf "%s" yaml_out
131
+
| Error e -> Printf.printf "Encode error: %s\n" e)
132
+
| Error e -> Printf.printf "Decode error: %s\n" e);
133
+
134
+
Printf.printf "\n=== Decode with layout=true, re-encode with Layout format ===\n";
135
+
(match Yamlt.decode_string ~layout:true codec yaml with
136
+
| Ok items ->
137
+
(match Yamlt.encode_string ~format:Yamlt.Layout codec items with
138
+
| Ok yaml_out -> Printf.printf "%s" yaml_out
139
+
| Error e -> Printf.printf "Encode error: %s\n" e)
140
+
| Error e -> Printf.printf "Decode error: %s\n" e)
141
+
142
+
(* Test: File path in error messages *)
143
+
let test_file_path () =
144
+
let yaml = "name: Alice\nage: not-a-number\n" in
145
+
146
+
let codec =
147
+
Jsont.Object.map ~kind:"Person" (fun name age -> (name, age))
148
+
|> Jsont.Object.mem "name" Jsont.string ~enc:fst
149
+
|> Jsont.Object.mem "age" Jsont.int ~enc:snd
150
+
|> Jsont.Object.finish
151
+
in
152
+
153
+
Printf.printf "=== Without file path ===\n";
154
+
let result1 = Yamlt.decode_string ~locs:true codec yaml in
155
+
show_result "Error" result1;
156
+
157
+
Printf.printf "\n=== With file path ===\n";
158
+
let result2 = Yamlt.decode_string ~locs:true ~file:"test.yml" codec yaml in
159
+
show_result "Error" result2
160
+
161
+
(* Test: Missing field error with locs *)
162
+
let test_missing_field file =
163
+
let yaml = read_file file in
164
+
165
+
let codec =
166
+
Jsont.Object.map ~kind:"Complete" (fun a b c -> (a, b, c))
167
+
|> Jsont.Object.mem "field_a" Jsont.string ~enc:(fun (a,_,_) -> a)
168
+
|> Jsont.Object.mem "field_b" Jsont.int ~enc:(fun (_,b,_) -> b)
169
+
|> Jsont.Object.mem "field_c" Jsont.bool ~enc:(fun (_,_,c) -> c)
170
+
|> Jsont.Object.finish
171
+
in
172
+
173
+
Printf.printf "=== Without locs ===\n";
174
+
let result_no_locs = Yamlt.decode_string ~locs:false codec yaml in
175
+
show_result "Missing field" result_no_locs;
176
+
177
+
Printf.printf "\n=== With locs=true ===\n";
178
+
let result_with_locs = Yamlt.decode_string ~locs:true codec yaml in
179
+
show_result "Missing field" result_with_locs
180
+
181
+
(* Test: Both locs and layout together *)
182
+
let test_combined_options file =
183
+
let yaml = read_file file in
184
+
185
+
let codec =
186
+
Jsont.Object.map ~kind:"Settings" (fun timeout retries -> (timeout, retries))
187
+
|> Jsont.Object.mem "timeout" Jsont.int ~enc:fst
188
+
|> Jsont.Object.mem "retries" Jsont.int ~enc:snd
189
+
|> Jsont.Object.finish
190
+
in
191
+
192
+
Printf.printf "=== locs=false, layout=false (defaults) ===\n";
193
+
(match Yamlt.decode_string ~locs:false ~layout:false codec yaml with
194
+
| Ok (timeout, retries) ->
195
+
Printf.printf "OK: timeout=%d, retries=%d\n" timeout retries
196
+
| Error e -> Printf.printf "Error: %s\n" e);
197
+
198
+
Printf.printf "\n=== locs=true, layout=false ===\n";
199
+
(match Yamlt.decode_string ~locs:true ~layout:false codec yaml with
200
+
| Ok (timeout, retries) ->
201
+
Printf.printf "OK: timeout=%d, retries=%d (with precise locations)\n" timeout retries
202
+
| Error e -> Printf.printf "Error: %s\n" e);
203
+
204
+
Printf.printf "\n=== locs=false, layout=true ===\n";
205
+
(match Yamlt.decode_string ~locs:false ~layout:true codec yaml with
206
+
| Ok (timeout, retries) ->
207
+
Printf.printf "OK: timeout=%d, retries=%d (with layout metadata)\n" timeout retries
208
+
| Error e -> Printf.printf "Error: %s\n" e);
209
+
210
+
Printf.printf "\n=== locs=true, layout=true (both enabled) ===\n";
211
+
(match Yamlt.decode_string ~locs:true ~layout:true codec yaml with
212
+
| Ok (timeout, retries) ->
213
+
Printf.printf "OK: timeout=%d, retries=%d (with locations and layout)\n" timeout retries
214
+
| Error e -> Printf.printf "Error: %s\n" e)
215
+
216
+
let () =
217
+
let usage = "Usage: test_locations <command> [args...]" in
218
+
219
+
if Stdlib.Array.length Sys.argv < 2 then begin
220
+
prerr_endline usage;
221
+
exit 1
222
+
end;
223
+
224
+
match Sys.argv.(1) with
225
+
| "error-precision" when Array.length Sys.argv = 3 ->
226
+
test_error_precision Sys.argv.(2)
227
+
228
+
| "nested-error" when Array.length Sys.argv = 3 ->
229
+
test_nested_error Sys.argv.(2)
230
+
231
+
| "array-error" when Array.length Sys.argv = 3 ->
232
+
test_array_error Sys.argv.(2)
233
+
234
+
| "layout" when Array.length Sys.argv = 3 ->
235
+
test_layout_preservation Sys.argv.(2)
236
+
237
+
| "roundtrip" when Array.length Sys.argv = 3 ->
238
+
test_roundtrip_layout Sys.argv.(2)
239
+
240
+
| "file-path" ->
241
+
test_file_path ()
242
+
243
+
| "missing-field" when Array.length Sys.argv = 3 ->
244
+
test_missing_field Sys.argv.(2)
245
+
246
+
| "combined" when Array.length Sys.argv = 3 ->
247
+
test_combined_options Sys.argv.(2)
248
+
249
+
| _ ->
250
+
prerr_endline usage;
251
+
prerr_endline "Commands:";
252
+
prerr_endline " error-precision <file> - Compare error messages with/without locs";
253
+
prerr_endline " nested-error <file> - Test error locations in nested objects";
254
+
prerr_endline " array-error <file> - Test error locations in arrays";
255
+
prerr_endline " layout <file> - Test layout preservation";
256
+
prerr_endline " roundtrip <file> - Test round-tripping with layout";
257
+
prerr_endline " file-path - Test file path in error messages";
258
+
prerr_endline " missing-field <file> - Test missing field errors with locs";
259
+
prerr_endline " combined <file> - Test locs and layout together";
260
+
exit 1
+2
-1
tests/cram/dune
+2
-1
tests/cram/dune
+217
tests/cram/locations.t
+217
tests/cram/locations.t
···
1
+
Location and Layout Preservation Tests with Yamlt
2
+
==================================================
3
+
4
+
This test suite validates the `locs` and `layout` options in the Yamlt decoder,
5
+
demonstrating how they affect error messages and metadata preservation.
6
+
7
+
================================================================================
8
+
ERROR MESSAGE PRECISION - locs option
9
+
================================================================================
10
+
11
+
The `locs` option controls whether source locations are preserved in error messages.
12
+
When `locs=false` (default), errors show basic location info.
13
+
When `locs=true`, errors show precise character positions.
14
+
15
+
Basic type error with and without locs
16
+
17
+
$ test_locations error-precision ../data/locations/type_error.yml
18
+
=== Without locs (default) ===
19
+
Error message:
20
+
String "not-a-number" does not parse to OCaml int value
21
+
File "-":
22
+
File "-": in member age of
23
+
File "-": Person object
24
+
25
+
=== With locs=true ===
26
+
Error message:
27
+
String "not-a-number" does not parse to OCaml int value
28
+
File "-", lines 2-3, characters 5-0:
29
+
File "-", line 2, characters 0-3: in member age of
30
+
File "-", line 1, characters 0-1: Person object
31
+
32
+
================================================================================
33
+
NESTED ERROR LOCATIONS
34
+
================================================================================
35
+
36
+
The `locs` option is especially useful for nested structures,
37
+
showing exactly where deep errors occur.
38
+
39
+
Error in nested object field
40
+
41
+
$ test_locations nested-error ../data/locations/nested_error.yml
42
+
=== Without locs (default) ===
43
+
Nested error:
44
+
String "invalid-zip" does not parse to OCaml int value
45
+
File "-":
46
+
File "-": in member zip of
47
+
File "-": Address object
48
+
File "-": in member address of
49
+
File "-": Employee object
50
+
51
+
=== With locs=true ===
52
+
Nested error:
53
+
String "invalid-zip" does not parse to OCaml int value
54
+
File "-", lines 5-6, characters 7-0:
55
+
File "-", line 5, characters 2-5: in member zip of
56
+
File "-", line 3, characters 2-3: Address object
57
+
File "-", line 2, characters 0-7: in member address of
58
+
File "-", line 1, characters 0-1: Employee object
59
+
60
+
================================================================================
61
+
ARRAY ELEMENT ERROR LOCATIONS
62
+
================================================================================
63
+
64
+
The `locs` option pinpoints which array element caused an error.
65
+
66
+
Error at specific array index
67
+
68
+
$ test_locations array-error ../data/locations/array_error.yml
69
+
=== Without locs (default) ===
70
+
Array error:
71
+
String "not-a-number" does not parse to OCaml int value
72
+
File "-":
73
+
at index 2 of
74
+
File "-": array<OCaml int>
75
+
File "-": in member values of
76
+
File "-": Numbers object
77
+
78
+
=== With locs=true ===
79
+
Array error:
80
+
String "not-a-number" does not parse to OCaml int value
81
+
File "-", lines 4-5, characters 4-2:
82
+
at index 2 of
83
+
File "-", line 2, characters 2-3: array<OCaml int>
84
+
File "-", line 1, characters 0-6: in member values of
85
+
File "-", line 1, characters 0-1: Numbers object
86
+
87
+
================================================================================
88
+
FILE PATH IN ERROR MESSAGES
89
+
================================================================================
90
+
91
+
The `file` parameter sets the file path shown in error messages.
92
+
93
+
$ test_locations file-path
94
+
=== Without file path ===
95
+
Error:
96
+
String "not-a-number" does not parse to OCaml int value
97
+
File "-", lines 2-3, characters 5-0:
98
+
File "-", line 2, characters 0-3: in member age of
99
+
File "-", line 1, characters 0-1: Person object
100
+
101
+
=== With file path ===
102
+
Error:
103
+
String "not-a-number" does not parse to OCaml int value
104
+
File "test.yml", lines 2-3, characters 5-0:
105
+
File "test.yml", line 2, characters 0-3: in member age of
106
+
File "test.yml", line 1, characters 0-1: Person object
107
+
108
+
================================================================================
109
+
MISSING FIELD ERROR LOCATIONS
110
+
================================================================================
111
+
112
+
The `locs` option helps identify where fields are missing.
113
+
114
+
$ test_locations missing-field ../data/locations/missing_field.yml
115
+
=== Without locs ===
116
+
Missing field:
117
+
Missing member field_c in Complete object
118
+
File "-":
119
+
120
+
=== With locs=true ===
121
+
Missing field:
122
+
Missing member field_c in Complete object
123
+
File "-", line 1, characters 0-1:
124
+
125
+
================================================================================
126
+
LAYOUT PRESERVATION - layout option
127
+
================================================================================
128
+
129
+
The `layout` option controls whether style information (block vs flow)
130
+
is preserved in metadata for potential round-tripping.
131
+
132
+
Basic layout preservation
133
+
134
+
$ test_locations layout ../data/locations/simple.yml
135
+
=== Without layout (default) ===
136
+
Decoded: host=localhost, port=8080
137
+
Meta preserved: no
138
+
139
+
=== With layout=true ===
140
+
Decoded: host=localhost, port=8080
141
+
Meta preserved: yes (style info available for round-tripping)
142
+
143
+
================================================================================
144
+
ROUND-TRIPPING WITH LAYOUT
145
+
================================================================================
146
+
147
+
With `layout=true` during decode and `format:Layout` during encode,
148
+
the original YAML style can be preserved.
149
+
150
+
Flow style preservation
151
+
152
+
$ test_locations roundtrip ../data/locations/flow_style.yml
153
+
=== Original YAML ===
154
+
items: [apple, banana, cherry]
155
+
156
+
=== Decode without layout, re-encode ===
157
+
items:
158
+
- apple
159
+
- banana
160
+
- cherry
161
+
162
+
=== Decode with layout=true, re-encode with Layout format ===
163
+
items:
164
+
- apple
165
+
- banana
166
+
- cherry
167
+
168
+
Block style preservation
169
+
170
+
$ test_locations roundtrip ../data/locations/block_style.yml
171
+
=== Original YAML ===
172
+
items:
173
+
- apple
174
+
- banana
175
+
- cherry
176
+
177
+
=== Decode without layout, re-encode ===
178
+
items:
179
+
- apple
180
+
- banana
181
+
- cherry
182
+
183
+
=== Decode with layout=true, re-encode with Layout format ===
184
+
items:
185
+
- apple
186
+
- banana
187
+
- cherry
188
+
189
+
================================================================================
190
+
COMBINED OPTIONS - locs and layout together
191
+
================================================================================
192
+
193
+
Both options can be used simultaneously for maximum information.
194
+
195
+
$ test_locations combined ../data/locations/valid_settings.yml
196
+
=== locs=false, layout=false (defaults) ===
197
+
OK: timeout=30, retries=3
198
+
199
+
=== locs=true, layout=false ===
200
+
OK: timeout=30, retries=3 (with precise locations)
201
+
202
+
=== locs=false, layout=true ===
203
+
OK: timeout=30, retries=3 (with layout metadata)
204
+
205
+
=== locs=true, layout=true (both enabled) ===
206
+
OK: timeout=30, retries=3 (with locations and layout)
207
+
208
+
================================================================================
209
+
SUMMARY OF OPTIONS
210
+
================================================================================
211
+
212
+
locs option:
213
+
214
+
layout option:
215
+
216
+
Both options add metadata overhead, so only enable when needed.
217
+
For production parsing where you only need the data, use defaults (both false).
+6
tests/data/locations/array_error.yml
+6
tests/data/locations/array_error.yml
+1
tests/data/locations/flow_style.yml
+1
tests/data/locations/flow_style.yml
···
1
+
items: [apple, banana, cherry]
+5
tests/data/locations/nested_error.yml
+5
tests/data/locations/nested_error.yml