Pure OCaml Yaml 1.2 reader and writer using Bytesrw
anil.recoil.org
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** Tests for the Yamlrw library *)
7
8open Yamlrw
9
10(** Test helpers *)
11
12let check_value msg expected actual =
13 Alcotest.(check bool) msg true (Value.equal expected actual)
14
15let _check_string msg expected actual =
16 Alcotest.(check string) msg expected actual
17
18(** Scanner tests *)
19
20let test_scanner_simple () =
21 let scanner = Scanner.of_string "hello: world" in
22 let tokens = Scanner.to_list scanner in
23 let token_types = List.map (fun (t : Token.spanned) -> t.token) tokens in
24 Alcotest.(check int) "token count" 8 (List.length token_types);
25 (* Stream_start, Block_mapping_start, Key, Scalar, Value, Scalar, Block_end, Stream_end *)
26 match token_types with
27 | [
28 Token.Stream_start _;
29 Token.Block_mapping_start;
30 Token.Key;
31 Token.Scalar { value = "hello"; _ };
32 Token.Value;
33 Token.Scalar { value = "world"; _ };
34 Token.Block_end;
35 Token.Stream_end;
36 ] ->
37 ()
38 | _ -> Alcotest.fail "unexpected token sequence"
39
40let test_scanner_sequence () =
41 let scanner = Scanner.of_string "- one\n- two\n- three" in
42 let tokens = Scanner.to_list scanner in
43 Alcotest.(check bool) "has tokens" true (List.length tokens > 0)
44
45let test_scanner_flow () =
46 let scanner = Scanner.of_string "[1, 2, 3]" in
47 let tokens = Scanner.to_list scanner in
48 let has_flow_start =
49 List.exists
50 (fun (t : Token.spanned) ->
51 match t.token with Token.Flow_sequence_start -> true | _ -> false)
52 tokens
53 in
54 Alcotest.(check bool) "has flow sequence start" true has_flow_start
55
56let scanner_tests =
57 [
58 ("simple mapping", `Quick, test_scanner_simple);
59 ("sequence", `Quick, test_scanner_sequence);
60 ("flow sequence", `Quick, test_scanner_flow);
61 ]
62
63(** Parser tests *)
64
65let test_parser_events () =
66 let parser = Parser.of_string "key: value" in
67 let events = Parser.to_list parser in
68 Alcotest.(check bool) "has events" true (List.length events > 0);
69 let has_stream_start =
70 List.exists
71 (fun (e : Event.spanned) ->
72 match e.event with Event.Stream_start _ -> true | _ -> false)
73 events
74 in
75 Alcotest.(check bool) "has stream start" true has_stream_start
76
77let test_parser_sequence_events () =
78 let parser = Parser.of_string "- a\n- b" in
79 let events = Parser.to_list parser in
80 let has_seq_start =
81 List.exists
82 (fun (e : Event.spanned) ->
83 match e.event with Event.Sequence_start _ -> true | _ -> false)
84 events
85 in
86 Alcotest.(check bool) "has sequence start" true has_seq_start
87
88let parser_tests =
89 [
90 ("parse events", `Quick, test_parser_events);
91 ("sequence events", `Quick, test_parser_sequence_events);
92 ]
93
94(** Value parsing tests *)
95
96let test_parse_null () =
97 check_value "null" `Null (of_string "null");
98 check_value "~" `Null (of_string "~");
99 check_value "empty" `Null (of_string "")
100
101let test_parse_bool () =
102 check_value "true" (`Bool true) (of_string "true");
103 check_value "false" (`Bool false) (of_string "false");
104 check_value "yes" (`Bool true) (of_string "yes");
105 check_value "no" (`Bool false) (of_string "no")
106
107let test_parse_number () =
108 check_value "integer" (`Float 42.0) (of_string "42");
109 check_value "negative" (`Float (-17.0)) (of_string "-17");
110 check_value "float" (`Float 3.14) (of_string "3.14")
111
112let test_parse_string () =
113 check_value "plain" (`String "hello")
114 ( of_string "hello world" |> function
115 | `String s -> `String (String.sub s 0 5)
116 | v -> v );
117 check_value "quoted" (`String "hello") (of_string {|"hello"|})
118
119let test_parse_sequence () =
120 let result = of_string "- one\n- two\n- three" in
121 match result with
122 | `A [ _; _; _ ] -> ()
123 | _ -> Alcotest.fail "expected sequence with 3 elements"
124
125let test_parse_mapping () =
126 let result = of_string "name: Alice\nage: 30" in
127 match result with
128 | `O pairs when List.length pairs = 2 -> ()
129 | _ -> Alcotest.fail "expected mapping with 2 pairs"
130
131let test_parse_nested () =
132 let yaml = {|
133person:
134 name: Bob
135 hobbies:
136 - reading
137 - coding
138|} in
139 let result = of_string yaml in
140 match result with
141 | `O [ ("person", `O _) ] -> ()
142 | _ -> Alcotest.fail "expected nested structure"
143
144let test_parse_flow_sequence () =
145 let result = of_string "[1, 2, 3]" in
146 match result with
147 | `A [ `Float 1.0; `Float 2.0; `Float 3.0 ] -> ()
148 | _ -> Alcotest.fail "expected flow sequence [1, 2, 3]"
149
150let test_parse_flow_mapping () =
151 let result = of_string "{a: 1, b: 2}" in
152 match result with
153 | `O [ ("a", `Float 1.0); ("b", `Float 2.0) ] -> ()
154 | _ -> Alcotest.fail "expected flow mapping {a: 1, b: 2}"
155
156let test_parse_flow_mapping_trailing_comma () =
157 let result = of_string "{ a: 1, }" in
158 match result with
159 | `O [ ("a", `Float 1.0) ] -> ()
160 | `O pairs ->
161 Alcotest.failf
162 "expected 1 pair but got %d pairs (trailing comma should not create \
163 empty entry)"
164 (List.length pairs)
165 | _ -> Alcotest.fail "expected flow mapping with 1 pair"
166
167let value_tests =
168 [
169 ("parse null", `Quick, test_parse_null);
170 ("parse bool", `Quick, test_parse_bool);
171 ("parse number", `Quick, test_parse_number);
172 ("parse string", `Quick, test_parse_string);
173 ("parse sequence", `Quick, test_parse_sequence);
174 ("parse mapping", `Quick, test_parse_mapping);
175 ("parse nested", `Quick, test_parse_nested);
176 ("parse flow sequence", `Quick, test_parse_flow_sequence);
177 ("parse flow mapping", `Quick, test_parse_flow_mapping);
178 ( "flow mapping trailing comma",
179 `Quick,
180 test_parse_flow_mapping_trailing_comma );
181 ]
182
183(** Emitter tests *)
184
185let test_emit_null () =
186 let result = to_string `Null in
187 Alcotest.(check bool) "contains null" true (String.length result > 0)
188
189let starts_with prefix s =
190 String.length s >= String.length prefix
191 && String.sub s 0 (String.length prefix) = prefix
192
193let test_emit_mapping () =
194 let value = `O [ ("name", `String "Alice"); ("age", `Float 30.0) ] in
195 let result = to_string value in
196 let trimmed = String.trim result in
197 Alcotest.(check bool)
198 "contains name" true
199 (starts_with "name" trimmed || starts_with "\"name\"" trimmed)
200
201let test_roundtrip_simple () =
202 let yaml = "name: Alice" in
203 let value = of_string yaml in
204 let _ = to_string value in
205 (* Just check it doesn't crash *)
206 ()
207
208let test_roundtrip_sequence () =
209 let yaml = "- one\n- two\n- three" in
210 let value = of_string yaml in
211 match value with
212 | `A items when List.length items = 3 ->
213 let _ = to_string value in
214 ()
215 | _ -> Alcotest.fail "roundtrip failed"
216
217let emitter_tests =
218 [
219 ("emit null", `Quick, test_emit_null);
220 ("emit mapping", `Quick, test_emit_mapping);
221 ("roundtrip simple", `Quick, test_roundtrip_simple);
222 ("roundtrip sequence", `Quick, test_roundtrip_sequence);
223 ]
224
225(** YAML-specific tests *)
226
227let test_yaml_anchor () =
228 let yaml = "&anchor hello" in
229 let result = yaml_of_string yaml in
230 match result with
231 | `Scalar s when Scalar.anchor s = Some "anchor" -> ()
232 | _ -> Alcotest.fail "expected scalar with anchor"
233
234let test_yaml_alias () =
235 let yaml =
236 {|
237defaults: &defaults
238 timeout: 30
239production:
240 <<: *defaults
241 port: 8080
242|}
243 in
244 (* Just check it parses without error *)
245 let _ = yaml_of_string yaml in
246 ()
247
248let yaml_tests =
249 [
250 ("yaml anchor", `Quick, test_yaml_anchor);
251 ("yaml alias", `Quick, test_yaml_alias);
252 ]
253
254(** Multiline scalar tests *)
255
256let test_literal_block () =
257 let yaml = {|description: |
258 This is a
259 multi-line
260 description
261|} in
262 let result = of_string yaml in
263 match result with
264 | `O [ ("description", `String _) ] -> ()
265 | _ -> Alcotest.fail "expected mapping with literal block"
266
267let test_folded_block () =
268 let yaml = {|description: >
269 This is a
270 folded
271 description
272|} in
273 let result = of_string yaml in
274 match result with
275 | `O [ ("description", `String _) ] -> ()
276 | _ -> Alcotest.fail "expected mapping with folded block"
277
278let multiline_tests =
279 [
280 ("literal block", `Quick, test_literal_block);
281 ("folded block", `Quick, test_folded_block);
282 ]
283
284(** Error handling tests *)
285
286let test_error_position () =
287 try
288 let _ = of_string "key: [unclosed" in
289 Alcotest.fail "expected error"
290 with Yamlrw_error e -> Alcotest.(check bool) "has span" true (e.span <> None)
291
292let error_tests = [ ("error position", `Quick, test_error_position) ]
293
294(** Alias expansion limit tests (billion laughs protection) *)
295
296let test_node_limit () =
297 (* Small bomb that would expand to 9^4 = 6561 nodes *)
298 let yaml =
299 {|
300a: &a [1,2,3,4,5,6,7,8,9]
301b: &b [*a,*a,*a,*a,*a,*a,*a,*a,*a]
302c: &c [*b,*b,*b,*b,*b,*b,*b,*b,*b]
303d: &d [*c,*c,*c,*c,*c,*c,*c,*c,*c]
304|}
305 in
306 (* Should fail with a small node limit *)
307 try
308 let _ = of_string ~max_nodes:100 yaml in
309 Alcotest.fail "expected node limit error"
310 with Yamlrw_error e -> (
311 match e.Error.kind with
312 | Error.Alias_expansion_node_limit _ -> ()
313 | _ -> Alcotest.fail "expected Alias_expansion_node_limit error")
314
315let test_depth_limit () =
316 (* Create deeply nested alias chain:
317 *e -> [*d,*d] -> [*c,*c] -> [*b,*b] -> [*a,*a] -> [x,y,z]
318 Each alias resolution increases depth by 1 *)
319 let yaml =
320 {|
321a: &a [x, y, z]
322b: &b [*a, *a]
323c: &c [*b, *b]
324d: &d [*c, *c]
325e: &e [*d, *d]
326result: *e
327|}
328 in
329 (* Should fail with a small depth limit (depth 3 means max 3 alias hops) *)
330 try
331 let _ = of_string ~max_depth:3 yaml in
332 Alcotest.fail "expected depth limit error"
333 with Yamlrw_error e -> (
334 match e.Error.kind with
335 | Error.Alias_expansion_depth_limit _ -> ()
336 | _ ->
337 Alcotest.fail
338 ("expected Alias_expansion_depth_limit error, got: "
339 ^ Error.kind_to_string e.Error.kind))
340
341let test_normal_aliases_work () =
342 (* Normal alias usage should work fine *)
343 let yaml =
344 {|
345defaults: &defaults
346 timeout: 30
347 retries: 3
348production:
349 <<: *defaults
350 port: 8080
351|}
352 in
353 let result = of_string yaml in
354 match result with `O _ -> () | _ -> Alcotest.fail "expected mapping"
355
356let test_resolve_aliases_false () =
357 (* With resolve_aliases=false, aliases should remain unresolved *)
358 let yaml = {|
359a: &anchor value
360b: *anchor
361|} in
362 let result = yaml_of_string ~resolve_aliases:false yaml in
363 (* Check that alias is preserved *)
364 match result with
365 | `O map -> (
366 let pairs = Mapping.members map in
367 match List.assoc_opt (`Scalar (Scalar.make "b")) pairs with
368 | Some (`Alias "anchor") -> ()
369 | _ -> Alcotest.fail "expected alias to be preserved")
370 | _ -> Alcotest.fail "expected mapping"
371
372let alias_limit_tests =
373 [
374 ("node limit", `Quick, test_node_limit);
375 ("depth limit", `Quick, test_depth_limit);
376 ("normal aliases work", `Quick, test_normal_aliases_work);
377 ("resolve_aliases false", `Quick, test_resolve_aliases_false);
378 ]
379
380(** Bug fix regression tests
381 These tests verify that issues fixed in ocaml-yaml don't occur in ocaml-yamlrw *)
382
383(* Test for roundtrip of special string values (ocaml-yaml fix 225387d)
384 Strings like "true", "1.0", "null" etc. must be quoted on output so that
385 they round-trip correctly as strings, not as booleans/numbers/null *)
386let test_roundtrip_string_true () =
387 let original = `String "true" in
388 let emitted = to_string original in
389 let parsed = of_string emitted in
390 check_value "String 'true' roundtrips" original parsed
391
392let test_roundtrip_string_false () =
393 let original = `String "false" in
394 let emitted = to_string original in
395 let parsed = of_string emitted in
396 check_value "String 'false' roundtrips" original parsed
397
398let test_roundtrip_string_null () =
399 let original = `String "null" in
400 let emitted = to_string original in
401 let parsed = of_string emitted in
402 check_value "String 'null' roundtrips" original parsed
403
404let test_roundtrip_string_number () =
405 let original = `String "1.0" in
406 let emitted = to_string original in
407 let parsed = of_string emitted in
408 check_value "String '1.0' roundtrips" original parsed
409
410let test_roundtrip_string_integer () =
411 let original = `String "42" in
412 let emitted = to_string original in
413 let parsed = of_string emitted in
414 check_value "String '42' roundtrips" original parsed
415
416let test_roundtrip_string_yes () =
417 let original = `String "yes" in
418 let emitted = to_string original in
419 let parsed = of_string emitted in
420 check_value "String 'yes' roundtrips" original parsed
421
422let test_roundtrip_string_no () =
423 let original = `String "no" in
424 let emitted = to_string original in
425 let parsed = of_string emitted in
426 check_value "String 'no' roundtrips" original parsed
427
428(* Test for integer display without decimal point (ocaml-yaml fix 999b1aa)
429 Float values that are integers should be emitted as "42" not "42." or "42.0" *)
430let test_emit_integer_float () =
431 let value = `Float 42.0 in
432 let result = to_string value in
433 (* Check the result doesn't contain "42." or "42.0" *)
434 Alcotest.(check bool) "no trailing dot"
435 true (not (String.length result >= 3 &&
436 result.[0] = '4' && result.[1] = '2' && result.[2] = '.'))
437
438let test_emit_negative_integer_float () =
439 let value = `Float (-17.0) in
440 let result = to_string value in
441 let parsed = of_string result in
442 check_value "negative integer float roundtrips" value parsed
443
444(* Test for special YAML floats: .nan, .inf, -.inf *)
445let test_parse_special_floats () =
446 let inf_result = of_string ".inf" in
447 (match inf_result with
448 | `Float f when Float.is_infinite f && f > 0.0 -> ()
449 | _ -> Alcotest.fail "expected positive infinity");
450 let neg_inf_result = of_string "-.inf" in
451 (match neg_inf_result with
452 | `Float f when Float.is_infinite f && f < 0.0 -> ()
453 | _ -> Alcotest.fail "expected negative infinity");
454 let nan_result = of_string ".nan" in
455 (match nan_result with
456 | `Float f when Float.is_nan f -> ()
457 | _ -> Alcotest.fail "expected NaN")
458
459(* Test that bare "inf", "nan", "infinity" are NOT parsed as floats
460 (ocaml-yaml issue - OCaml's Float.of_string accepts these but YAML doesn't) *)
461let test_bare_inf_nan_are_strings () =
462 let inf_result = of_string "inf" in
463 (match inf_result with
464 | `String "inf" -> ()
465 | `Float _ -> Alcotest.fail "'inf' should be string, not float"
466 | _ -> Alcotest.fail "expected string 'inf'");
467 let nan_result = of_string "nan" in
468 (match nan_result with
469 | `String "nan" -> ()
470 | `Float _ -> Alcotest.fail "'nan' should be string, not float"
471 | _ -> Alcotest.fail "expected string 'nan'");
472 let infinity_result = of_string "infinity" in
473 (match infinity_result with
474 | `String "infinity" -> ()
475 | `Float _ -> Alcotest.fail "'infinity' should be string, not float"
476 | _ -> Alcotest.fail "expected string 'infinity'")
477
478(* Test for quoted scalar preservation *)
479let test_quoted_scalar_preserved () =
480 (* When a scalar is quoted, it should be preserved as a string even if
481 it looks like a number/boolean *)
482 check_value "double-quoted true is string"
483 (`String "true") (of_string {|"true"|});
484 check_value "single-quoted 42 is string"
485 (`String "42") (of_string "'42'");
486 check_value "double-quoted null is string"
487 (`String "null") (of_string {|"null"|})
488
489(* Test complex roundtrip with mixed types *)
490let test_complex_roundtrip () =
491 let original = `O [
492 ("string_true", `String "true");
493 ("bool_true", `Bool true);
494 ("string_42", `String "42");
495 ("int_42", `Float 42.0);
496 ("string_null", `String "null");
497 ("actual_null", `Null);
498 ] in
499 let emitted = to_string original in
500 let parsed = of_string emitted in
501 check_value "complex roundtrip preserves types" original parsed
502
503let bugfix_regression_tests = [
504 "roundtrip string 'true'", `Quick, test_roundtrip_string_true;
505 "roundtrip string 'false'", `Quick, test_roundtrip_string_false;
506 "roundtrip string 'null'", `Quick, test_roundtrip_string_null;
507 "roundtrip string '1.0'", `Quick, test_roundtrip_string_number;
508 "roundtrip string '42'", `Quick, test_roundtrip_string_integer;
509 "roundtrip string 'yes'", `Quick, test_roundtrip_string_yes;
510 "roundtrip string 'no'", `Quick, test_roundtrip_string_no;
511 "emit integer float without decimal", `Quick, test_emit_integer_float;
512 "emit negative integer float", `Quick, test_emit_negative_integer_float;
513 "parse special floats (.inf, -.inf, .nan)", `Quick, test_parse_special_floats;
514 "bare inf/nan/infinity are strings", `Quick, test_bare_inf_nan_are_strings;
515 "quoted scalars preserved as strings", `Quick, test_quoted_scalar_preserved;
516 "complex roundtrip preserves types", `Quick, test_complex_roundtrip;
517]
518
519(** Run all tests *)
520
521let () =
522 Alcotest.run "yamlrw"
523 [
524 ("scanner", scanner_tests);
525 ("parser", parser_tests);
526 ("value", value_tests);
527 ("emitter", emitter_tests);
528 ("yaml", yaml_tests);
529 ("multiline", multiline_tests);
530 ("errors", error_tests);
531 ("alias_limits", alias_limit_tests);
532 ("bugfix_regression", bugfix_regression_tests);
533 ]