this repo has no description
loads
+2311
+93
yaml/ocaml-yamle/tests/categorize_failures.ml
+93
yaml/ocaml-yamle/tests/categorize_failures.ml
···
1
+
(* Categorize test failures *)
2
+
open Yamle
3
+
module TL = Test_suite_lib.Test_suite_loader
4
+
module TF = Test_suite_lib.Tree_format
5
+
6
+
let test_suite_path = "../yaml-test-suite"
7
+
8
+
let normalize_tree s =
9
+
let lines = String.split_on_char '\n' s in
10
+
let lines = List.filter (fun l -> String.trim l <> "") lines in
11
+
String.concat "\n" lines
12
+
13
+
type failure =
14
+
| Error_not_detected of string
15
+
| Parse_error of string
16
+
| Tree_mismatch of string * string
17
+
18
+
let run_test (test : TL.test_case) =
19
+
if test.fail then begin
20
+
try
21
+
let parser = Parser.of_string test.yaml in
22
+
let _events = Parser.to_list parser in
23
+
Some (Error_not_detected test.name)
24
+
with _ -> None
25
+
end
26
+
else begin
27
+
match test.tree with
28
+
| None -> None
29
+
| Some expected ->
30
+
try
31
+
let parser = Parser.of_string test.yaml in
32
+
let events = Parser.to_list parser in
33
+
let actual = TF.of_spanned_events events in
34
+
let expected_norm = normalize_tree expected in
35
+
let actual_norm = normalize_tree actual in
36
+
if expected_norm = actual_norm then None
37
+
else Some (Tree_mismatch (expected_norm, actual_norm))
38
+
with e ->
39
+
let msg = Printexc.to_string e in
40
+
Some (Parse_error msg)
41
+
end
42
+
43
+
let diff_lines expected actual =
44
+
let exp_lines = String.split_on_char '\n' expected in
45
+
let act_lines = String.split_on_char '\n' actual in
46
+
let rec find_diff i es as_ =
47
+
match es, as_ with
48
+
| [], [] -> None
49
+
| [], _ -> Some (Printf.sprintf "Line count: expected %d, got %d" (List.length exp_lines) (List.length act_lines))
50
+
| _, [] -> Some (Printf.sprintf "Line count: expected %d, got %d" (List.length exp_lines) (List.length act_lines))
51
+
| e :: es', a :: as_' ->
52
+
if e = a then find_diff (i + 1) es' as_'
53
+
else Some (Printf.sprintf "Line %d differs:\n exp: %s\n got: %s" i e a)
54
+
in
55
+
find_diff 1 exp_lines act_lines
56
+
57
+
let () =
58
+
let src_path = Filename.concat test_suite_path "src" in
59
+
let all_tests = TL.load_directory src_path in
60
+
61
+
let error_not_detected = ref [] in
62
+
let parse_errors = ref [] in
63
+
let tree_mismatches = ref [] in
64
+
65
+
List.iter (fun test ->
66
+
match run_test test with
67
+
| None -> ()
68
+
| Some (Error_not_detected name) ->
69
+
error_not_detected := (test.TL.id, name) :: !error_not_detected
70
+
| Some (Parse_error msg) ->
71
+
parse_errors := (test.TL.id, test.TL.name, msg) :: !parse_errors
72
+
| Some (Tree_mismatch (exp, act)) ->
73
+
tree_mismatches := (test.TL.id, test.TL.name, exp, act) :: !tree_mismatches
74
+
) all_tests;
75
+
76
+
Printf.printf "=== ERROR TESTS NOT DETECTED (%d) ===\n" (List.length !error_not_detected);
77
+
List.iter (fun (id, name) ->
78
+
Printf.printf " %s: %s\n" id name
79
+
) (List.rev !error_not_detected);
80
+
81
+
Printf.printf "\n=== PARSE ERRORS (%d) ===\n" (List.length !parse_errors);
82
+
List.iter (fun (id, name, msg) ->
83
+
Printf.printf " %s: %s\n %s\n" id name msg
84
+
) (List.rev !parse_errors);
85
+
86
+
Printf.printf "\n=== TREE MISMATCHES (%d) ===\n" (List.length !tree_mismatches);
87
+
List.iter (fun (id, name, exp, act) ->
88
+
let diff = diff_lines exp act in
89
+
Printf.printf " %s: %s\n" id name;
90
+
match diff with
91
+
| Some d -> Printf.printf " %s\n" d
92
+
| None -> ()
93
+
) (List.rev !tree_mismatches)
+12
yaml/ocaml-yamle/tests/count_tests.ml
+12
yaml/ocaml-yamle/tests/count_tests.ml
···
1
+
module TL = Test_suite_lib.Test_suite_loader
2
+
3
+
let () =
4
+
let tests = TL.load_directory "../yaml-test-suite/src" in
5
+
let error_without_tree = List.filter (fun t -> t.TL.fail && t.TL.tree = None) tests in
6
+
let non_error_without_tree = List.filter (fun t -> (not t.TL.fail) && t.TL.tree = None) tests in
7
+
Printf.printf "Error tests without tree: %d\n" (List.length error_without_tree);
8
+
Printf.printf "Non-error tests without tree (will be skipped): %d\n" (List.length non_error_without_tree);
9
+
Printf.printf "\nError tests without tree:\n";
10
+
List.iter (fun t -> Printf.printf " %s\n" t.TL.id) error_without_tree;
11
+
Printf.printf "\nNon-error tests without tree:\n";
12
+
List.iter (fun t -> Printf.printf " %s\n" t.TL.id) non_error_without_tree
+71
yaml/ocaml-yamle/tests/debug_5we3_6m2f.ml
+71
yaml/ocaml-yamle/tests/debug_5we3_6m2f.ml
···
1
+
open Yamle
2
+
3
+
let show_token tok =
4
+
Format.asprintf "%a" Token.pp_spanned tok
5
+
6
+
let show_event evt =
7
+
Format.asprintf "%a" Event.pp_spanned evt
8
+
9
+
let test_5we3 () =
10
+
Printf.printf "\n=== Test 5WE3: Explicit Block Mapping Entries ===\n";
11
+
let yaml = "? explicit key # Empty value\n? |\n block key\n: - one # Explicit compact\n - two # block value" in
12
+
Printf.printf "Input:\n%s\n\n" yaml;
13
+
try
14
+
let scanner = Scanner.of_string yaml in
15
+
Printf.printf "Tokens:\n";
16
+
let rec print_tokens () =
17
+
match Scanner.peek scanner with
18
+
| None -> Printf.printf "No more tokens\n"
19
+
| Some tok ->
20
+
Printf.printf " %s\n" (show_token tok);
21
+
ignore (Scanner.next scanner);
22
+
print_tokens ()
23
+
in
24
+
print_tokens ();
25
+
Printf.printf "\nParsing:\n";
26
+
let scanner = Scanner.of_string yaml in
27
+
let parser = Parser.create scanner in
28
+
let rec print_events () =
29
+
match Parser.next parser with
30
+
| None -> Printf.printf "No more events\n"
31
+
| Some event ->
32
+
Printf.printf " %s\n" (show_event event);
33
+
print_events ()
34
+
in
35
+
print_events ()
36
+
with e ->
37
+
Printf.printf "ERROR: %s\n" (Printexc.to_string e)
38
+
39
+
let test_6m2f () =
40
+
Printf.printf "\n=== Test 6M2F: Aliases in Explicit Block Mapping ===\n";
41
+
let yaml = "? &a a\n: &b b\n: *a" in
42
+
Printf.printf "Input:\n%s\n\n" yaml;
43
+
try
44
+
let scanner = Scanner.of_string yaml in
45
+
Printf.printf "Tokens:\n";
46
+
let rec print_tokens () =
47
+
match Scanner.peek scanner with
48
+
| None -> Printf.printf "No more tokens\n"
49
+
| Some tok ->
50
+
Printf.printf " %s\n" (show_token tok);
51
+
ignore (Scanner.next scanner);
52
+
print_tokens ()
53
+
in
54
+
print_tokens ();
55
+
Printf.printf "\nParsing:\n";
56
+
let scanner = Scanner.of_string yaml in
57
+
let parser = Parser.create scanner in
58
+
let rec print_events () =
59
+
match Parser.next parser with
60
+
| None -> Printf.printf "No more events\n"
61
+
| Some event ->
62
+
Printf.printf " %s\n" (show_event event);
63
+
print_events ()
64
+
in
65
+
print_events ()
66
+
with e ->
67
+
Printf.printf "ERROR: %s\n" (Printexc.to_string e)
68
+
69
+
let () =
70
+
test_5we3 ();
71
+
test_6m2f ()
+62
yaml/ocaml-yamle/tests/debug_block_issues.ml
+62
yaml/ocaml-yamle/tests/debug_block_issues.ml
···
1
+
open Yamle
2
+
open Test_suite_lib
3
+
4
+
let test_case name yaml expected_tree =
5
+
Printf.printf "\n=== Testing %s ===\n" name;
6
+
Printf.printf "YAML:\n%s\n" yaml;
7
+
Printf.printf "\nExpected tree:\n%s\n" expected_tree;
8
+
9
+
try
10
+
let input = Input.of_string yaml in
11
+
let scanner = Scanner.create input in
12
+
let parser = Parser.create scanner in
13
+
14
+
(* Skip token output for now *)
15
+
();
16
+
17
+
Printf.printf "\nParsing...\n";
18
+
let rec collect_events acc =
19
+
match Parser.next parser with
20
+
| None -> List.rev acc
21
+
| Some evt -> collect_events (evt :: acc)
22
+
in
23
+
let events = collect_events [] in
24
+
25
+
let tree = Tree_format.of_spanned_events events in
26
+
Printf.printf "\nFormatted tree:\n%s\n" tree;
27
+
28
+
if tree = expected_tree then
29
+
Printf.printf "✓ PASS\n"
30
+
else
31
+
Printf.printf "✗ FAIL - Tree mismatch\n"
32
+
with
33
+
| Error.Yamle_error err ->
34
+
Printf.printf "ERROR: %s\n" (Error.to_string err)
35
+
| e ->
36
+
Printf.printf "ERROR: %s\n" (Printexc.to_string e)
37
+
38
+
let () =
39
+
(* JEF9 - Extra newlines at end *)
40
+
test_case "JEF9"
41
+
"- |+\n\n"
42
+
"+STR\n +DOC\n +SEQ\n =VAL |\\n\\n\n -SEQ\n -DOC\n-STR";
43
+
44
+
(* K858 - Empty scalar chomping - block scalar consuming too much *)
45
+
test_case "K858"
46
+
"strip: >-\n\nclip: >\n\nkeep: |+\n\n"
47
+
"+STR\n +DOC\n +MAP\n =VAL :strip\n =VAL >\n =VAL :clip\n =VAL >\n =VAL :keep\n =VAL |\\n\n -MAP\n -DOC\n-STR";
48
+
49
+
(* L24T - Trailing whitespace-only line *)
50
+
test_case "L24T"
51
+
"foo: |\n x\n \n"
52
+
"+STR\n +DOC\n +MAP\n =VAL :foo\n =VAL |x\\n \\n\n -MAP\n -DOC\n-STR";
53
+
54
+
(* MJS9 - Folded block newline handling *)
55
+
test_case "MJS9"
56
+
">\n foo \n \n \t bar\n\n baz\n"
57
+
"+STR\n +DOC\n =VAL >foo \\n\\n\\t bar\\n\\nbaz\\n\n -DOC\n-STR";
58
+
59
+
(* R4YG - Tab handling in folded block - just the problematic 4th test *)
60
+
test_case "R4YG-4"
61
+
"- >\n \t\n detected\n"
62
+
"+STR\n +DOC\n +SEQ\n =VAL >\\t\\ndetected\\n\n -SEQ\n -DOC\n-STR"
+47
yaml/ocaml-yamle/tests/debug_block_scalars.ml
+47
yaml/ocaml-yamle/tests/debug_block_scalars.ml
···
1
+
(* Debug block scalar behavior *)
2
+
open Yamle
3
+
4
+
let test_simple name yaml expected =
5
+
Printf.printf "\n=== %s ===\n" name;
6
+
Printf.printf "Input: %S\n" yaml;
7
+
Printf.printf "Expected: %S\n" expected;
8
+
try
9
+
let parser = Parser.of_string yaml in
10
+
let events = Parser.to_list parser in
11
+
List.iter (fun ev ->
12
+
match ev.Event.event with
13
+
| Event.Scalar { value; style; _ } ->
14
+
let style_str = match style with
15
+
| Scalar_style.Literal -> "Literal"
16
+
| Scalar_style.Folded -> "Folded"
17
+
| _ -> "Other"
18
+
in
19
+
Printf.printf "Scalar (%s): %S (len=%d)\n" style_str value (String.length value);
20
+
Printf.printf " Escaped: %s\n" (String.escaped value);
21
+
if value = expected then
22
+
Printf.printf " PASS\n"
23
+
else
24
+
Printf.printf " FAIL: Expected %S\n" expected
25
+
| _ -> ()
26
+
) events
27
+
with e ->
28
+
Printf.printf "ERROR: %s\n" (Printexc.to_string e);
29
+
Printexc.print_backtrace stdout
30
+
31
+
let () =
32
+
(* JEF9 - Keep chomping with empty content *)
33
+
test_simple "JEF9" "- |+\n\n\n" "\n\n";
34
+
35
+
(* K858 - Empty scalar chomping *)
36
+
test_simple "K858-strip" "strip: >-\n\n" "";
37
+
test_simple "K858-clip" "clip: >\n\n" "";
38
+
test_simple "K858-keep" "keep: |+\n\n" "\n";
39
+
40
+
(* L24T - Trailing spaces *)
41
+
test_simple "L24T" "foo: |\n x\n \n" "x\n \n";
42
+
43
+
(* MJS9 - Folded newlines *)
44
+
test_simple "MJS9" ">\n foo \n \n\t bar\n\n baz\n" "foo \n\n\t bar\n\nbaz\n";
45
+
46
+
(* R4YG - Tab preservation *)
47
+
test_simple "R4YG" "- >\n \t\n detected\n" "\t\ndetected\n"
+13
yaml/ocaml-yamle/tests/debug_dk95_01.ml
+13
yaml/ocaml-yamle/tests/debug_dk95_01.ml
···
1
+
open Yamle
2
+
let () =
3
+
(* DK95/01: foo: "bar<nl><4 tabs>baz" - 4 tabs at column 1 puts us at column 5, but quote started at 6 *)
4
+
let yaml = "foo: \"bar\n\t\t\t\tbaz\"" in
5
+
Format.printf "YAML: %S@.@." yaml;
6
+
try
7
+
let parser = Parser.of_string yaml in
8
+
let events = Parser.to_list parser in
9
+
Format.printf "Events: %d (ERROR: should have failed)@." (List.length events);
10
+
List.iter (fun e -> Format.printf " %a@." Event.pp_spanned e) events
11
+
with
12
+
| Yamle_error e ->
13
+
Format.printf "Error (expected): %a@." Error.pp e
+71
yaml/ocaml-yamle/tests/debug_empty_key.ml
+71
yaml/ocaml-yamle/tests/debug_empty_key.ml
···
1
+
open Yamle
2
+
3
+
let show_token tok =
4
+
Format.asprintf "%a" Token.pp_spanned tok
5
+
6
+
let show_event evt =
7
+
Format.asprintf "%a" Event.pp_spanned evt
8
+
9
+
let test_2jqs () =
10
+
Printf.printf "\n=== Test 2JQS: Block Mapping with Missing Keys ===\n";
11
+
let yaml = ": a\n: b" in
12
+
Printf.printf "Input:\n%s\n\n" yaml;
13
+
try
14
+
let scanner = Scanner.of_string yaml in
15
+
Printf.printf "Tokens:\n";
16
+
let rec print_tokens () =
17
+
match Scanner.peek scanner with
18
+
| None -> Printf.printf "No more tokens\n"
19
+
| Some tok ->
20
+
Printf.printf " %s\n" (show_token tok);
21
+
ignore (Scanner.next scanner);
22
+
print_tokens ()
23
+
in
24
+
print_tokens ();
25
+
Printf.printf "\nParsing:\n";
26
+
let scanner = Scanner.of_string yaml in
27
+
let parser = Parser.create scanner in
28
+
let rec print_events () =
29
+
match Parser.next parser with
30
+
| None -> Printf.printf "No more events\n"
31
+
| Some event ->
32
+
Printf.printf " %s\n" (show_event event);
33
+
print_events ()
34
+
in
35
+
print_events ()
36
+
with e ->
37
+
Printf.printf "ERROR: %s\n" (Printexc.to_string e)
38
+
39
+
let test_5nyz () =
40
+
Printf.printf "\n=== Test 5NYZ: Separated Comment ===\n";
41
+
let yaml = "key: # Comment\n value" in
42
+
Printf.printf "Input:\n%s\n\n" yaml;
43
+
try
44
+
let scanner = Scanner.of_string yaml in
45
+
Printf.printf "Tokens:\n";
46
+
let rec print_tokens () =
47
+
match Scanner.peek scanner with
48
+
| None -> Printf.printf "No more tokens\n"
49
+
| Some tok ->
50
+
Printf.printf " %s\n" (show_token tok);
51
+
ignore (Scanner.next scanner);
52
+
print_tokens ()
53
+
in
54
+
print_tokens ();
55
+
Printf.printf "\nParsing:\n";
56
+
let scanner = Scanner.of_string yaml in
57
+
let parser = Parser.create scanner in
58
+
let rec print_events () =
59
+
match Parser.next parser with
60
+
| None -> Printf.printf "No more events\n"
61
+
| Some event ->
62
+
Printf.printf " %s\n" (show_event event);
63
+
print_events ()
64
+
in
65
+
print_events ()
66
+
with e ->
67
+
Printf.printf "ERROR: %s\n" (Printexc.to_string e)
68
+
69
+
let () =
70
+
test_2jqs ();
71
+
test_5nyz ()
+73
yaml/ocaml-yamle/tests/debug_flow.ml
+73
yaml/ocaml-yamle/tests/debug_flow.ml
···
1
+
(* Debug flow context issues *)
2
+
open Yamle
3
+
4
+
let show_error_kind = function
5
+
| Error.Unexpected_character c -> Printf.sprintf "Unexpected_character(%c)" c
6
+
| Error.Unexpected_eof -> "Unexpected_eof"
7
+
| Error.Invalid_escape_sequence s -> Printf.sprintf "Invalid_escape_sequence(%s)" s
8
+
| Error.Invalid_unicode_escape s -> Printf.sprintf "Invalid_unicode_escape(%s)" s
9
+
| Error.Invalid_hex_escape s -> Printf.sprintf "Invalid_hex_escape(%s)" s
10
+
| Error.Invalid_tag s -> Printf.sprintf "Invalid_tag(%s)" s
11
+
| Error.Invalid_anchor s -> Printf.sprintf "Invalid_anchor(%s)" s
12
+
| Error.Invalid_alias s -> Printf.sprintf "Invalid_alias(%s)" s
13
+
| Error.Invalid_comment -> "Invalid_comment"
14
+
| Error.Unclosed_single_quote -> "Unclosed_single_quote"
15
+
| Error.Unclosed_double_quote -> "Unclosed_double_quote"
16
+
| Error.Unclosed_flow_sequence -> "Unclosed_flow_sequence"
17
+
| Error.Unclosed_flow_mapping -> "Unclosed_flow_mapping"
18
+
| Error.Invalid_indentation (exp, got) -> Printf.sprintf "Invalid_indentation(expected %d, got %d)" exp got
19
+
| Error.Invalid_flow_indentation -> "Invalid_flow_indentation"
20
+
| Error.Tab_in_indentation -> "Tab_in_indentation"
21
+
| Error.Invalid_block_scalar_header s -> Printf.sprintf "Invalid_block_scalar_header(%s)" s
22
+
| Error.Invalid_directive s -> Printf.sprintf "Invalid_directive(%s)" s
23
+
| Error.Invalid_yaml_version s -> Printf.sprintf "Invalid_yaml_version(%s)" s
24
+
| Error.Invalid_tag_directive s -> Printf.sprintf "Invalid_tag_directive(%s)" s
25
+
| Error.Reserved_directive s -> Printf.sprintf "Reserved_directive(%s)" s
26
+
| Error.Unexpected_token s -> Printf.sprintf "Unexpected_token(%s)" s
27
+
| Error.Expected_document_start -> "Expected_document_start"
28
+
| Error.Expected_document_end -> "Expected_document_end"
29
+
| Error.Expected_block_entry -> "Expected_block_entry"
30
+
| Error.Expected_key -> "Expected_key"
31
+
| Error.Expected_value -> "Expected_value"
32
+
| Error.Expected_node -> "Expected_node"
33
+
| Error.Expected_scalar -> "Expected_scalar"
34
+
| Error.Expected_sequence_end -> "Expected_sequence_end"
35
+
| Error.Expected_mapping_end -> "Expected_mapping_end"
36
+
| Error.Duplicate_anchor s -> Printf.sprintf "Duplicate_anchor(%s)" s
37
+
| Error.Undefined_alias s -> Printf.sprintf "Undefined_alias(%s)" s
38
+
| Error.Alias_cycle s -> Printf.sprintf "Alias_cycle(%s)" s
39
+
| Error.Multiple_documents -> "Multiple_documents"
40
+
| Error.Mapping_key_too_long -> "Mapping_key_too_long"
41
+
| Error.Custom s -> Printf.sprintf "Custom(%s)" s
42
+
| _ -> "Unknown error"
43
+
44
+
let test_case id yaml =
45
+
Printf.printf "\n=== Test %s ===\n%!" id;
46
+
Printf.printf "YAML: %S\n%!" yaml;
47
+
try
48
+
let parser = Parser.of_string yaml in
49
+
let events = Parser.to_list parser in
50
+
Printf.printf "SUCCESS - got %d events\n%!" (List.length events)
51
+
with Error.Yamle_error err ->
52
+
let pos_str = match err.Error.span with
53
+
| Some span -> Printf.sprintf " at line %d col %d" span.Span.start.Position.line span.Span.start.Position.column
54
+
| None -> ""
55
+
in
56
+
Printf.printf "ERROR%s: %s\n%!" pos_str (show_error_kind err.Error.kind)
57
+
58
+
let () =
59
+
(* Test 87E4: Single Quoted Implicit Keys *)
60
+
test_case "87E4" {|'implicit block key' : [
61
+
'implicit flow key' : value,
62
+
]|};
63
+
64
+
(* Test CFD4: Empty implicit key *)
65
+
test_case "CFD4" {|- [ : empty key ]|};
66
+
67
+
(* Test L9U5: Plain Implicit Keys *)
68
+
test_case "L9U5" {|implicit block key : [
69
+
implicit flow key : value,
70
+
]|};
71
+
72
+
(* Test 9MMW: Single Pair Implicit Entries *)
73
+
test_case "9MMW" {|- [ YAML : separate ]|};
+61
yaml/ocaml-yamle/tests/debug_flow2.ml
+61
yaml/ocaml-yamle/tests/debug_flow2.ml
···
1
+
(* Debug tokenization *)
2
+
open Yamle
3
+
4
+
let show_token = function
5
+
| Token.Stream_start enc -> Printf.sprintf "Stream_start(%s)" (match enc with Utf8 -> "UTF8" | _ -> "?")
6
+
| Token.Stream_end -> "Stream_end"
7
+
| Token.Document_start -> "Document_start"
8
+
| Token.Document_end -> "Document_end"
9
+
| Token.Block_mapping_start -> "Block_mapping_start"
10
+
| Token.Block_sequence_start -> "Block_sequence_start"
11
+
| Token.Block_end -> "Block_end"
12
+
| Token.Flow_sequence_start -> "Flow_sequence_start"
13
+
| Token.Flow_sequence_end -> "Flow_sequence_end"
14
+
| Token.Flow_mapping_start -> "Flow_mapping_start"
15
+
| Token.Flow_mapping_end -> "Flow_mapping_end"
16
+
| Token.Block_entry -> "Block_entry"
17
+
| Token.Flow_entry -> "Flow_entry"
18
+
| Token.Key -> "Key"
19
+
| Token.Value -> "Value"
20
+
| Token.Alias s -> Printf.sprintf "Alias(%s)" s
21
+
| Token.Anchor s -> Printf.sprintf "Anchor(%s)" s
22
+
| Token.Tag {handle; suffix} -> Printf.sprintf "Tag(%s, %s)" handle suffix
23
+
| Token.Scalar {value; style; _} ->
24
+
let style_str = match style with
25
+
| Plain -> "Plain" | Single_quoted -> "Single" | Double_quoted -> "Double"
26
+
| Literal -> "Literal" | Folded -> "Folded" | _ -> "Other"
27
+
in
28
+
Printf.sprintf "Scalar(%S, %s)" value style_str
29
+
| _ -> "Other"
30
+
31
+
let test_case id yaml =
32
+
Printf.printf "\n=== Test %s ===\n%!" id;
33
+
Printf.printf "YAML: %S\n%!" yaml;
34
+
Printf.printf "Tokens:\n%!";
35
+
try
36
+
let scanner = Scanner.of_string yaml in
37
+
let rec print_tokens () =
38
+
match Scanner.next scanner with
39
+
| Some tok ->
40
+
Printf.printf " %s at line %d col %d\n%!"
41
+
(show_token tok.token)
42
+
tok.span.start.line
43
+
tok.span.start.column;
44
+
print_tokens ()
45
+
| None -> ()
46
+
in
47
+
print_tokens ();
48
+
Printf.printf "SUCCESS\n%!"
49
+
with Error.Yamle_error err ->
50
+
let pos_str = match err.Error.span with
51
+
| Some span -> Printf.sprintf " at line %d col %d" span.Span.start.Position.line span.Span.start.Position.column
52
+
| None -> ""
53
+
in
54
+
Printf.printf "ERROR%s\n%!" pos_str
55
+
56
+
let () =
57
+
(* Test CFD4: Empty implicit key *)
58
+
test_case "CFD4" {|- [ : empty key ]|};
59
+
60
+
(* Test 9MMW: Single Pair Implicit Entries *)
61
+
test_case "9MMW" {|- [ YAML : separate ]|};
+27
yaml/ocaml-yamle/tests/debug_flow3.ml
+27
yaml/ocaml-yamle/tests/debug_flow3.ml
···
1
+
open Yamle
2
+
3
+
let show_error_kind = function
4
+
| Error.Expected_sequence_end -> "Expected_sequence_end"
5
+
| Error.Expected_mapping_end -> "Expected_mapping_end"
6
+
| Error.Unexpected_token s -> Printf.sprintf "Unexpected_token(%s)" s
7
+
| Error.Expected_key -> "Expected_key"
8
+
| Error.Expected_value -> "Expected_value"
9
+
| Error.Expected_node -> "Expected_node"
10
+
| _ -> "Other"
11
+
12
+
let test yaml =
13
+
Printf.printf "YAML: %S\n%!" yaml;
14
+
try
15
+
let parser = Parser.of_string yaml in
16
+
let events = Parser.to_list parser in
17
+
Printf.printf "SUCCESS - %d events\n%!" (List.length events)
18
+
with Error.Yamle_error err ->
19
+
let pos_str = match err.Error.span with
20
+
| Some span -> Printf.sprintf " at line %d col %d" span.Span.start.Position.line span.Span.start.Position.column
21
+
| None -> ""
22
+
in
23
+
Printf.printf "ERROR%s: %s\n%!" pos_str (show_error_kind err.Error.kind)
24
+
25
+
let () =
26
+
test {|- [ : empty key ]|};
27
+
test {|- [ YAML : separate ]|};
+36
yaml/ocaml-yamle/tests/debug_flow4.ml
+36
yaml/ocaml-yamle/tests/debug_flow4.ml
···
1
+
open Yamle
2
+
3
+
let test yaml =
4
+
Printf.printf "\n=== YAML: %S ===\n%!" yaml;
5
+
try
6
+
let parser = Parser.of_string yaml in
7
+
let rec print_events n =
8
+
match Parser.next parser with
9
+
| None -> Printf.printf "Total events: %d\n%!" n
10
+
| Some ev ->
11
+
Printf.printf "Event %d: " n;
12
+
(match ev.Event.event with
13
+
| Event.Stream_start _ -> Printf.printf "Stream_start\n"
14
+
| Event.Stream_end -> Printf.printf "Stream_end\n"
15
+
| Event.Document_start _ -> Printf.printf "Document_start\n"
16
+
| Event.Document_end _ -> Printf.printf "Document_end\n"
17
+
| Event.Sequence_start _ -> Printf.printf "Sequence_start\n"
18
+
| Event.Sequence_end -> Printf.printf "Sequence_end\n"
19
+
| Event.Mapping_start _ -> Printf.printf "Mapping_start\n"
20
+
| Event.Mapping_end -> Printf.printf "Mapping_end\n"
21
+
| Event.Scalar {value; _} -> Printf.printf "Scalar(%S)\n" value
22
+
| Event.Alias {anchor} -> Printf.printf "Alias(%s)\n" anchor);
23
+
print_events (n + 1)
24
+
in
25
+
print_events 0;
26
+
Printf.printf "SUCCESS\n%!"
27
+
with Error.Yamle_error err ->
28
+
let pos_str = match err.Error.span with
29
+
| Some span -> Printf.sprintf " at line %d col %d" span.Span.start.Position.line span.Span.start.Position.column
30
+
| None -> ""
31
+
in
32
+
Printf.printf "ERROR%s\n%!" pos_str
33
+
34
+
let () =
35
+
test {|- [ : empty key ]|};
36
+
test {|- [ YAML : separate ]|};
+29
yaml/ocaml-yamle/tests/debug_flow5.ml
+29
yaml/ocaml-yamle/tests/debug_flow5.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
Printf.printf "Test: - [ : empty key ]\n%!";
5
+
try
6
+
let scanner = Scanner.of_string {|- [ : empty key ]|} in
7
+
Printf.printf "Tokens:\n%!";
8
+
let rec print_all n =
9
+
match Scanner.next scanner with
10
+
| None -> ()
11
+
| Some tok ->
12
+
Printf.printf " %d. " n;
13
+
(match tok.Token.token with
14
+
| Token.Stream_start _ -> Printf.printf "Stream_start"
15
+
| Token.Stream_end -> Printf.printf "Stream_end"
16
+
| Token.Block_sequence_start -> Printf.printf "Block_sequence_start"
17
+
| Token.Block_entry -> Printf.printf "Block_entry"
18
+
| Token.Block_end -> Printf.printf "Block_end"
19
+
| Token.Flow_sequence_start -> Printf.printf "Flow_sequence_start"
20
+
| Token.Flow_sequence_end -> Printf.printf "Flow_sequence_end"
21
+
| Token.Value -> Printf.printf "Value"
22
+
| Token.Scalar {value; _} -> Printf.printf "Scalar(%S)" value
23
+
| _ -> Printf.printf "Other");
24
+
Printf.printf " at %d:%d\n%!" tok.span.start.line tok.span.start.column;
25
+
print_all (n + 1)
26
+
in
27
+
print_all 0
28
+
with Error.Yamle_error _ ->
29
+
Printf.printf "Scanner error\n%!"
+19
yaml/ocaml-yamle/tests/debug_flow6.ml
+19
yaml/ocaml-yamle/tests/debug_flow6.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
Printf.printf "Test: - [ a ]\n%!";
5
+
let parser = Parser.of_string {|- [ a ]|} in
6
+
let rec print_events n =
7
+
match Parser.next parser with
8
+
| None -> ()
9
+
| Some ev ->
10
+
Printf.printf "%d: " n;
11
+
(match ev.Event.event with
12
+
| Event.Sequence_start _ -> Printf.printf "Sequence_start"
13
+
| Event.Sequence_end -> Printf.printf "Sequence_end"
14
+
| Event.Scalar {value; _} -> Printf.printf "Scalar(%S)" value
15
+
| _ -> Printf.printf "Other");
16
+
Printf.printf "\n%!";
17
+
print_events (n + 1)
18
+
in
19
+
print_events 0
+30
yaml/ocaml-yamle/tests/debug_flow7.ml
+30
yaml/ocaml-yamle/tests/debug_flow7.ml
···
1
+
open Yamle
2
+
3
+
let test yaml =
4
+
Printf.printf "\nYAML: %S\n%!" yaml;
5
+
try
6
+
let parser = Parser.of_string yaml in
7
+
let rec print_events n =
8
+
match Parser.next parser with
9
+
| None -> Printf.printf "Total: %d events\n" n
10
+
| Some ev ->
11
+
Printf.printf "%d: " n;
12
+
(match ev.Event.event with
13
+
| Event.Sequence_start _ -> Printf.printf "Sequence_start"
14
+
| Event.Sequence_end -> Printf.printf "Sequence_end"
15
+
| Event.Mapping_start _ -> Printf.printf "Mapping_start"
16
+
| Event.Mapping_end -> Printf.printf "Mapping_end"
17
+
| Event.Scalar {value; _} -> Printf.printf "Scalar(%S)" value
18
+
| _ -> Printf.printf "Other");
19
+
Printf.printf "\n%!";
20
+
print_events (n + 1)
21
+
in
22
+
print_events 0;
23
+
Printf.printf "SUCCESS\n%!"
24
+
with Error.Yamle_error _ ->
25
+
Printf.printf "ERROR\n%!"
26
+
27
+
let () =
28
+
test {|[a, b]|}; (* Simple flow sequence *)
29
+
test {|[{a: b}]|}; (* Flow sequence with mapping *)
30
+
test {|[a: b]|}; (* Flow sequence with implicit mapping *)
+23
yaml/ocaml-yamle/tests/debug_from.ml
+23
yaml/ocaml-yamle/tests/debug_from.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
let yaml = "---\n- name: Spec Example 2.4. Sequence of Mappings\n from: http://example.com\n" in
5
+
Printf.printf "YAML: %S\n" yaml;
6
+
let scanner = Scanner.of_string yaml in
7
+
Printf.printf "\nTokens:\n";
8
+
try
9
+
let rec loop count =
10
+
if count > 30 then Printf.printf " ... (stopped at 30 tokens)\n"
11
+
else match Scanner.next scanner with
12
+
| None -> Printf.printf " (none)\n"
13
+
| Some tok ->
14
+
Printf.printf " %d:%d %s\n" tok.span.start.line tok.span.start.column
15
+
(Format.asprintf "%a" Token.pp tok.token);
16
+
match tok.token with
17
+
| Token.Stream_end -> ()
18
+
| _ -> loop (count + 1)
19
+
in
20
+
loop 0
21
+
with e ->
22
+
Printf.printf "Error: %s\n" (Printexc.to_string e);
23
+
Printexc.print_backtrace stdout
+22
yaml/ocaml-yamle/tests/debug_jef9.ml
+22
yaml/ocaml-yamle/tests/debug_jef9.ml
···
1
+
module TL = Test_suite_lib.Test_suite_loader
2
+
module TF = Test_suite_lib.Tree_format
3
+
open Yamle
4
+
5
+
let () =
6
+
let tests = TL.load_file "../yaml-test-suite/src/JEF9.yaml" in
7
+
List.iter (fun (test : TL.test_case) ->
8
+
Printf.printf "=== Test: %s ===\n" test.id;
9
+
Printf.printf "YAML bytes: ";
10
+
String.iter (fun c -> Printf.printf "%02x " (Char.code c)) test.yaml;
11
+
Printf.printf "\n";
12
+
Printf.printf "YAML len: %d\n" (String.length test.yaml);
13
+
try
14
+
let parser = Parser.of_string test.yaml in
15
+
let events = Parser.to_list parser in
16
+
Printf.printf "Events: %d\n" (List.length events);
17
+
let tree = TF.of_spanned_events events in
18
+
Printf.printf "Expected tree:\n%s\n" (Option.value ~default:"(none)" test.tree);
19
+
Printf.printf "Actual tree:\n%s\n" tree
20
+
with e ->
21
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
22
+
) tests
+23
yaml/ocaml-yamle/tests/debug_l24t.ml
+23
yaml/ocaml-yamle/tests/debug_l24t.ml
···
1
+
module TL = Test_suite_lib.Test_suite_loader
2
+
module TF = Test_suite_lib.Tree_format
3
+
open Yamle
4
+
5
+
let () =
6
+
let tests = TL.load_file "../yaml-test-suite/src/L24T.yaml" in
7
+
List.iter (fun (test : TL.test_case) ->
8
+
Printf.printf "=== Test: %s ===\n" test.id;
9
+
Printf.printf "YAML bytes: ";
10
+
String.iter (fun c -> Printf.printf "%02x " (Char.code c)) test.yaml;
11
+
Printf.printf "\n";
12
+
Printf.printf "YAML repr: %S\n" test.yaml;
13
+
Printf.printf "YAML len: %d\n" (String.length test.yaml);
14
+
try
15
+
let parser = Parser.of_string test.yaml in
16
+
let events = Parser.to_list parser in
17
+
Printf.printf "Events: %d\n" (List.length events);
18
+
let tree = TF.of_spanned_events events in
19
+
Printf.printf "Expected tree:\n%s\n" (Option.value ~default:"(none)" test.tree);
20
+
Printf.printf "Actual tree:\n%s\n" tree
21
+
with e ->
22
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
23
+
) tests
+28
yaml/ocaml-yamle/tests/debug_m2n8.ml
+28
yaml/ocaml-yamle/tests/debug_m2n8.ml
···
1
+
open Yamle
2
+
module TF = Test_suite_lib.Tree_format
3
+
4
+
let () =
5
+
let yaml = "- ? : x\n" in
6
+
Printf.printf "YAML: %S\n" yaml;
7
+
Printf.printf "\nExpected tree:\n";
8
+
Printf.printf "+STR
9
+
+DOC
10
+
+SEQ
11
+
+MAP
12
+
+MAP
13
+
=VAL :
14
+
=VAL :x
15
+
-MAP
16
+
=VAL :
17
+
-MAP
18
+
-SEQ
19
+
-DOC
20
+
-STR\n";
21
+
Printf.printf "\nParsing:\n";
22
+
try
23
+
let parser = Parser.of_string yaml in
24
+
let events = Parser.to_list parser in
25
+
let tree = TF.of_spanned_events events in
26
+
Printf.printf "Actual tree:\n%s\n" tree
27
+
with e ->
28
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
+83
yaml/ocaml-yamle/tests/debug_multiline.ml
+83
yaml/ocaml-yamle/tests/debug_multiline.ml
···
1
+
(* Debug specific multiline tests *)
2
+
open Yamle
3
+
4
+
let show_event evt =
5
+
Format.asprintf "%a" Event.pp_spanned evt
6
+
7
+
let test_a984 () =
8
+
let yaml = "a: b\n c\nd:\n e\n f" in
9
+
Printf.printf "Testing A984 (Multiline Scalar in Mapping):\n%s\n" yaml;
10
+
try
11
+
let scanner = Scanner.of_string yaml in
12
+
let parser = Parser.create scanner in
13
+
Printf.printf "Events:\n";
14
+
let rec print_events () =
15
+
match Parser.next parser with
16
+
| None -> ()
17
+
| Some event ->
18
+
Printf.printf " %s\n" (show_event event);
19
+
print_events ()
20
+
in
21
+
print_events ()
22
+
with e ->
23
+
Printf.printf "ERROR: %s\n" (Printexc.to_string e)
24
+
25
+
let test_v9d5 () =
26
+
let yaml = "- sun: yellow\n- ? earth: blue\n : moon: white" in
27
+
Printf.printf "\nTesting V9D5 (Compact Block Mappings):\n%s\n" yaml;
28
+
try
29
+
let scanner = Scanner.of_string yaml in
30
+
let parser = Parser.create scanner in
31
+
Printf.printf "Events:\n";
32
+
let rec print_events () =
33
+
match Parser.next parser with
34
+
| None -> ()
35
+
| Some event ->
36
+
Printf.printf " %s\n" (show_event event);
37
+
print_events ()
38
+
in
39
+
print_events ()
40
+
with e ->
41
+
Printf.printf "ERROR: %s\n" (Printexc.to_string e)
42
+
43
+
let test_q9wf () =
44
+
let yaml = "{ first: Sammy, last: Sosa }:\n# Statistics:\n hr: # Home runs\n 65\n avg: # Average\n 0.278" in
45
+
Printf.printf "\nTesting Q9WF (Separation Spaces):\n%s\n" yaml;
46
+
try
47
+
let scanner = Scanner.of_string yaml in
48
+
let parser = Parser.create scanner in
49
+
Printf.printf "Events:\n";
50
+
let rec print_events () =
51
+
match Parser.next parser with
52
+
| None -> ()
53
+
| Some event ->
54
+
Printf.printf " %s\n" (show_event event);
55
+
print_events ()
56
+
in
57
+
print_events ()
58
+
with e ->
59
+
Printf.printf "ERROR: %s\n" (Printexc.to_string e)
60
+
61
+
let test_m2n8 () =
62
+
let yaml = "- ? : x" in
63
+
Printf.printf "\nTesting M2N8 (Question mark edge cases):\n%s\n" yaml;
64
+
try
65
+
let scanner = Scanner.of_string yaml in
66
+
let parser = Parser.create scanner in
67
+
Printf.printf "Events:\n";
68
+
let rec print_events () =
69
+
match Parser.next parser with
70
+
| None -> ()
71
+
| Some event ->
72
+
Printf.printf " %s\n" (show_event event);
73
+
print_events ()
74
+
in
75
+
print_events ()
76
+
with e ->
77
+
Printf.printf "ERROR: %s\n" (Printexc.to_string e)
78
+
79
+
let () =
80
+
test_a984 ();
81
+
test_v9d5 ();
82
+
test_q9wf ();
83
+
test_m2n8 ()
+12
yaml/ocaml-yamle/tests/debug_mus6_01.ml
+12
yaml/ocaml-yamle/tests/debug_mus6_01.ml
···
1
+
open Yamle
2
+
let () =
3
+
let yaml = "%YAML 1.2\n---\n%YAML 1.2\n---\n" in
4
+
Format.printf "YAML: %S@.@." yaml;
5
+
try
6
+
let parser = Parser.of_string yaml in
7
+
let events = Parser.to_list parser in
8
+
Format.printf "Events: %d (ERROR: should have failed)@." (List.length events);
9
+
List.iter (fun e -> Format.printf " %a@." Event.pp_spanned e) events
10
+
with
11
+
| Yamle_error e ->
12
+
Format.printf "Error (expected): %a@." Error.pp e
+7
yaml/ocaml-yamle/tests/debug_mus6_load.ml
+7
yaml/ocaml-yamle/tests/debug_mus6_load.ml
+41
yaml/ocaml-yamle/tests/debug_prh3.ml
+41
yaml/ocaml-yamle/tests/debug_prh3.ml
···
1
+
(* Debug PRH3 specifically *)
2
+
open Yamle
3
+
4
+
let yaml = "' 1st non-empty\n\n 2nd non-empty \n\t3rd non-empty '"
5
+
6
+
let () =
7
+
Printf.printf "Input YAML:\n";
8
+
for i = 0 to String.length yaml - 1 do
9
+
let c = yaml.[i] in
10
+
match c with
11
+
| '\n' -> Printf.printf "\\n"
12
+
| '\t' -> Printf.printf "\\t"
13
+
| ' ' -> Printf.printf "·"
14
+
| _ -> Printf.printf "%c" c
15
+
done;
16
+
Printf.printf "\n\n";
17
+
18
+
Printf.printf "Expected: ' 1st non-empty\\n2nd non-empty 3rd non-empty '\n";
19
+
Printf.printf "Expected (visual): '·1st·non-empty\\n2nd·non-empty·3rd·non-empty·'\n\n";
20
+
21
+
try
22
+
let parser = Parser.of_string yaml in
23
+
let events = Parser.to_list parser in
24
+
List.iter (fun (e : Event.spanned) ->
25
+
match e.event with
26
+
| Event.Scalar { value; _ } ->
27
+
Printf.printf "Actual scalar value:\n";
28
+
for i = 0 to String.length value - 1 do
29
+
let c = value.[i] in
30
+
match c with
31
+
| '\n' -> Printf.printf "\\n"
32
+
| '\t' -> Printf.printf "\\t"
33
+
| ' ' -> Printf.printf "·"
34
+
| _ -> Printf.printf "%c" c
35
+
done;
36
+
Printf.printf "\n";
37
+
Printf.printf "Length: %d\n" (String.length value)
38
+
| _ -> ()
39
+
) events
40
+
with e ->
41
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
+42
yaml/ocaml-yamle/tests/debug_quoted.ml
+42
yaml/ocaml-yamle/tests/debug_quoted.ml
···
1
+
(* Debug quoted string issues *)
2
+
open Yamle
3
+
module TL = Test_suite_lib.Test_suite_loader
4
+
module TF = Test_suite_lib.Tree_format
5
+
6
+
let test_suite_path = "../yaml-test-suite"
7
+
8
+
let () =
9
+
let src_path = Filename.concat test_suite_path "src" in
10
+
let all_tests = TL.load_directory src_path in
11
+
12
+
(* Filter for specific tests *)
13
+
let tests = List.filter (fun t ->
14
+
t.TL.id = "PRH3" || t.TL.id = "T4YY" || t.TL.id = "NAT4"
15
+
) all_tests in
16
+
17
+
List.iter (fun test ->
18
+
Printf.printf "\n=== %s: %s ===\n" test.TL.id test.TL.name;
19
+
Printf.printf "YAML input:\n%s\n" (String.escaped test.TL.yaml);
20
+
Printf.printf "YAML (raw):\n%s\n---\n" test.TL.yaml;
21
+
22
+
match test.TL.tree with
23
+
| None -> Printf.printf "No expected tree\n"
24
+
| Some expected ->
25
+
Printf.printf "Expected tree:\n%s\n" expected;
26
+
27
+
(try
28
+
let parser = Parser.of_string test.TL.yaml in
29
+
let events = Parser.to_list parser in
30
+
let actual = TF.of_spanned_events events in
31
+
Printf.printf "Actual tree:\n%s\n" actual;
32
+
33
+
(* Show scalar values *)
34
+
List.iter (fun (e : Event.spanned) ->
35
+
match e.event with
36
+
| Event.Scalar { value; _ } ->
37
+
Printf.printf "Scalar value: %s (len=%d)\n" (String.escaped value) (String.length value)
38
+
| _ -> ()
39
+
) events;
40
+
with e ->
41
+
Printf.printf "Error: %s\n" (Printexc.to_string e))
42
+
) tests
+23
yaml/ocaml-yamle/tests/debug_r4yg.ml
+23
yaml/ocaml-yamle/tests/debug_r4yg.ml
···
1
+
module TL = Test_suite_lib.Test_suite_loader
2
+
module TF = Test_suite_lib.Tree_format
3
+
open Yamle
4
+
5
+
let () =
6
+
let tests = TL.load_file "../yaml-test-suite/src/R4YG.yaml" in
7
+
List.iter (fun (test : TL.test_case) ->
8
+
Printf.printf "=== Test: %s ===\n" test.id;
9
+
Printf.printf "YAML bytes: ";
10
+
String.iter (fun c -> Printf.printf "%02x " (Char.code c)) test.yaml;
11
+
Printf.printf "\n";
12
+
Printf.printf "YAML repr: %S\n" test.yaml;
13
+
Printf.printf "YAML len: %d\n" (String.length test.yaml);
14
+
try
15
+
let parser = Parser.of_string test.yaml in
16
+
let events = Parser.to_list parser in
17
+
Printf.printf "Events: %d\n" (List.length events);
18
+
let tree = TF.of_spanned_events events in
19
+
Printf.printf "Expected tree:\n%s\n" (Option.value ~default:"(none)" test.tree);
20
+
Printf.printf "Actual tree:\n%s\n" tree
21
+
with e ->
22
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
23
+
) tests
+39
yaml/ocaml-yamle/tests/debug_v9d5.ml
+39
yaml/ocaml-yamle/tests/debug_v9d5.ml
···
1
+
open Yamle
2
+
module TL = Test_suite_lib.Test_suite_loader
3
+
module TF = Test_suite_lib.Tree_format
4
+
5
+
let () =
6
+
let tests = TL.load_file "../yaml-test-suite/src/V9D5.yaml" in
7
+
List.iter (fun (test : TL.test_case) ->
8
+
Printf.printf "=== Test: %s ===\n" test.id;
9
+
Printf.printf "YAML: %S\n" test.yaml;
10
+
11
+
(* Print tokens *)
12
+
Printf.printf "\nTokens:\n";
13
+
let scanner = Scanner.of_string test.yaml in
14
+
begin try
15
+
let rec loop () =
16
+
match Scanner.next scanner with
17
+
| None -> Printf.printf " (none)\n"
18
+
| Some tok ->
19
+
Printf.printf " %d:%d %s\n" tok.span.start.line tok.span.start.column
20
+
(Format.asprintf "%a" Token.pp tok.token);
21
+
match tok.token with
22
+
| Token.Stream_end -> ()
23
+
| _ -> loop ()
24
+
in
25
+
loop ()
26
+
with e ->
27
+
Printf.printf "Scanner error: %s\n" (Printexc.to_string e)
28
+
end;
29
+
30
+
Printf.printf "\nExpected tree:\n%s\n" (Option.value ~default:"(none)" test.tree);
31
+
Printf.printf "\nParsing:\n";
32
+
try
33
+
let parser = Parser.of_string test.yaml in
34
+
let events = Parser.to_list parser in
35
+
let tree = TF.of_spanned_events events in
36
+
Printf.printf "Actual tree:\n%s\n" tree
37
+
with e ->
38
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
39
+
) tests
+13
yaml/ocaml-yamle/tests/debug_y79y_03.ml
+13
yaml/ocaml-yamle/tests/debug_y79y_03.ml
···
1
+
open Yamle
2
+
let () =
3
+
(* Y79Y/03: - [<nl><tab>foo,<nl> foo<nl> ] *)
4
+
let yaml = "- [\n\tfoo,\n foo\n ]" in
5
+
Format.printf "YAML: %S@.@." yaml;
6
+
try
7
+
let parser = Parser.of_string yaml in
8
+
let events = Parser.to_list parser in
9
+
Format.printf "Events: %d (ERROR: should have failed)@." (List.length events);
10
+
List.iter (fun e -> Format.printf " %a@." Event.pp_spanned e) events
11
+
with
12
+
| Yamle_error e ->
13
+
Format.printf "Error (expected): %a@." Error.pp e
+13
yaml/ocaml-yamle/tests/debug_y79y_09.ml
+13
yaml/ocaml-yamle/tests/debug_y79y_09.ml
···
1
+
open Yamle
2
+
let () =
3
+
(* Y79Y/09: ? key:<nl>:<tab>key: *)
4
+
let yaml = "? key:\n:\tkey:" in
5
+
Format.printf "YAML: %S@.@." yaml;
6
+
try
7
+
let parser = Parser.of_string yaml in
8
+
let events = Parser.to_list parser in
9
+
Format.printf "Events: %d (ERROR: should have failed)@." (List.length events);
10
+
List.iter (fun e -> Format.printf " %a@." Event.pp_spanned e) events
11
+
with
12
+
| Yamle_error e ->
13
+
Format.printf "Error (expected): %a@." Error.pp e
+13
yaml/ocaml-yamle/tests/debug_y79y_first.ml
+13
yaml/ocaml-yamle/tests/debug_y79y_first.ml
···
1
+
open Yamle
2
+
let () =
3
+
(* Y79Y first test: block scalar followed by tab-only line *)
4
+
let yaml = "foo: |\n\t\nbar: 1\n" in
5
+
Format.printf "YAML: %S@.@." yaml;
6
+
try
7
+
let parser = Parser.of_string yaml in
8
+
let events = Parser.to_list parser in
9
+
Format.printf "Events: %d (ERROR: should have failed)@." (List.length events);
10
+
List.iter (fun e -> Format.printf " %a@." Event.pp_spanned e) events
11
+
with
12
+
| Yamle_error e ->
13
+
Format.printf "Error (expected): %a@." Error.pp e
+70
yaml/ocaml-yamle/tests/run_all_tests.ml
+70
yaml/ocaml-yamle/tests/run_all_tests.ml
···
1
+
(* Run all yaml-test-suite tests *)
2
+
open Yamle
3
+
module TL = Test_suite_lib.Test_suite_loader
4
+
module TF = Test_suite_lib.Tree_format
5
+
6
+
let test_suite_path = "../yaml-test-suite"
7
+
8
+
let normalize_tree s =
9
+
let lines = String.split_on_char '\n' s in
10
+
let lines = List.filter (fun l -> String.trim l <> "") lines in
11
+
String.concat "\n" lines
12
+
13
+
let run_test (test : TL.test_case) =
14
+
if test.fail then begin
15
+
try
16
+
let parser = Parser.of_string test.yaml in
17
+
let _events = Parser.to_list parser in
18
+
`Fail "Expected parsing to fail"
19
+
with
20
+
| Yamle_error _ -> `Pass
21
+
| _ -> `Pass
22
+
end
23
+
else begin
24
+
match test.tree with
25
+
| None -> `Skip
26
+
| Some expected ->
27
+
try
28
+
let parser = Parser.of_string test.yaml in
29
+
let events = Parser.to_list parser in
30
+
let actual = TF.of_spanned_events events in
31
+
let expected_norm = normalize_tree expected in
32
+
let actual_norm = normalize_tree actual in
33
+
if expected_norm = actual_norm then `Pass
34
+
else begin
35
+
let msg = Printf.sprintf "Tree mismatch:\nExpected:\n%s\nActual:\n%s" expected_norm actual_norm in
36
+
`Fail msg
37
+
end
38
+
with e ->
39
+
let msg = Printexc.to_string e in
40
+
`Fail (Printf.sprintf "Exception: %s" msg)
41
+
end
42
+
43
+
let () =
44
+
let src_path = Filename.concat test_suite_path "src" in
45
+
let all_tests = TL.load_directory src_path in
46
+
Printf.printf "Total tests loaded: %d\n%!" (List.length all_tests);
47
+
48
+
let pass = ref 0 in
49
+
let fail = ref 0 in
50
+
let skip = ref 0 in
51
+
let failures = ref [] in
52
+
53
+
List.iter (fun test ->
54
+
match run_test test with
55
+
| `Pass -> incr pass
56
+
| `Skip -> incr skip
57
+
| `Fail msg ->
58
+
incr fail;
59
+
failures := (test.TL.id, test.TL.name, msg) :: !failures
60
+
) all_tests;
61
+
62
+
Printf.printf "\nResults: %d pass, %d fail, %d skip (total: %d)\n%!"
63
+
!pass !fail !skip (!pass + !fail + !skip);
64
+
65
+
if !fail > 0 then begin
66
+
Printf.printf "\nFailing tests:\n";
67
+
List.iter (fun (id, name, _msg) ->
68
+
Printf.printf " %s: %s\n" id name
69
+
) (List.rev !failures)
70
+
end
+23
yaml/ocaml-yamle/tests/test_229q_direct.ml
+23
yaml/ocaml-yamle/tests/test_229q_direct.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
let yaml = In_channel.with_open_text "../yaml-test-suite/src/229Q.yaml" In_channel.input_all in
5
+
Printf.printf "YAML length: %d\n" (String.length yaml);
6
+
Printf.printf "First 200 chars: %S\n" (String.sub yaml 0 (min 200 (String.length yaml)));
7
+
let scanner = Scanner.of_string yaml in
8
+
Printf.printf "\nTokens:\n";
9
+
try
10
+
let rec loop count =
11
+
if count > 30 then Printf.printf " ... (stopped at 30 tokens)\n"
12
+
else match Scanner.next scanner with
13
+
| None -> Printf.printf " (none)\n"
14
+
| Some tok ->
15
+
Printf.printf " %d:%d %s\n" tok.span.start.line tok.span.start.column
16
+
(Format.asprintf "%a" Token.pp tok.token);
17
+
match tok.token with
18
+
| Token.Stream_end -> ()
19
+
| _ -> loop (count + 1)
20
+
in
21
+
loop 0
22
+
with e ->
23
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
+12
yaml/ocaml-yamle/tests/test_2cms.ml
+12
yaml/ocaml-yamle/tests/test_2cms.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
let yaml = "this\n is\n invalid: x\n" in
5
+
Printf.printf "YAML: %S\n" yaml;
6
+
Printf.printf "\nParsing:\n";
7
+
try
8
+
let parser = Parser.of_string yaml in
9
+
let events = Parser.to_list parser in
10
+
Printf.printf "Events: %d (should have errored)\n" (List.length events)
11
+
with e ->
12
+
Printf.printf "Error (expected): %s\n" (Printexc.to_string e)
+18
yaml/ocaml-yamle/tests/test_2cms_quick.ml
+18
yaml/ocaml-yamle/tests/test_2cms_quick.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
let yaml = "this\n is\n invalid: x\n" in
5
+
Format.printf "YAML: %S@.@." yaml;
6
+
Format.printf "Parsing:@.";
7
+
try
8
+
let parser = Parser.of_string yaml in
9
+
let events = Parser.to_list parser in
10
+
Format.printf "Events: %d (ERROR: should have failed)@." (List.length events);
11
+
List.iter (fun e ->
12
+
Format.printf " %a@." Event.pp e.Event.event
13
+
) events
14
+
with
15
+
| Yamle_error e ->
16
+
Format.printf "Error (expected): %a@." Error.pp e
17
+
| e ->
18
+
Format.printf "Error: %s@." (Printexc.to_string e)
+25
yaml/ocaml-yamle/tests/test_3hfz.ml
+25
yaml/ocaml-yamle/tests/test_3hfz.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
let yaml = "---\nkey: value\n... invalid\n" in
5
+
Printf.printf "YAML: %S\n" yaml;
6
+
Printf.printf "Byte 18: %C (space=%b, break=%b)\n"
7
+
yaml.[18]
8
+
(yaml.[18] = ' ' || yaml.[18] = '\t')
9
+
(yaml.[18] = '\n' || yaml.[18] = '\r');
10
+
let scanner = Scanner.of_string yaml in
11
+
Printf.printf "\nTokens:\n";
12
+
try
13
+
let rec loop () =
14
+
match Scanner.next scanner with
15
+
| None -> Printf.printf " (none)\n"
16
+
| Some tok ->
17
+
Printf.printf " %d:%d %s\n" tok.span.start.line tok.span.start.column
18
+
(Format.asprintf "%a" Token.pp tok.token);
19
+
match tok.token with
20
+
| Token.Stream_end -> ()
21
+
| _ -> loop ()
22
+
in
23
+
loop ()
24
+
with e ->
25
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
+29
yaml/ocaml-yamle/tests/test_565n_debug.ml
+29
yaml/ocaml-yamle/tests/test_565n_debug.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
let yaml = "generic: !!binary |
5
+
R0lGODlhDAAMAIQAAP//9/X17unp5WZmZgAAAOfn515eXvPz7Y6OjuDg4J+fn5
6
+
OTk6enp56enmlpaWNjY6Ojo4SEhP/++f/++f/++f/++f/++f/++f/++f/++f/+
7
+
+f/++f/++f/++f/++f/++SH+Dk1hZGUgd2l0aCBHSU1QACwAAAAADAAMAAAFLC
8
+
AgjoEwnuNAFOhpEMTRiggcz4BNJHrv/zCFcLiwMWYNG84BwwEeECcgggoBADs=" in
9
+
10
+
let scanner = Scanner.of_string yaml in
11
+
let rec find_binary () =
12
+
match Scanner.next scanner with
13
+
| None -> None
14
+
| Some { token; _ } ->
15
+
match token with
16
+
| Token.Scalar { style = Scalar_style.Literal; value; _ } -> Some value
17
+
| _ -> find_binary ()
18
+
in
19
+
match find_binary () with
20
+
| None -> Printf.printf "No literal scalar found\n"
21
+
| Some value ->
22
+
Printf.printf "Got: %S\n" value;
23
+
Printf.printf "First char: %C (code %d)\n" value.[0] (Char.code value.[0]);
24
+
if value.[0] = ' ' then
25
+
Printf.printf "FAIL: starts with space\n"
26
+
else if value.[0] = 'R' then
27
+
Printf.printf "PASS: starts with R\n"
28
+
else
29
+
Printf.printf "FAIL: starts with unexpected char\n"
+17
yaml/ocaml-yamle/tests/test_5llu_quick.ml
+17
yaml/ocaml-yamle/tests/test_5llu_quick.ml
···
1
+
open Yamle
2
+
(* Test 5LLU: Block scalar with wrong indented line after spaces only *)
3
+
let () =
4
+
(* block scalar: >
5
+
␣ (1 space, empty line)
6
+
␣␣ (2 spaces, empty line)
7
+
␣␣␣ (3 spaces, empty line)
8
+
invalid (1 space + content - ERROR!) *)
9
+
let yaml = "block scalar: >\n \n \n \n invalid\n" in
10
+
Format.printf "YAML: %S@.@." yaml;
11
+
try
12
+
let parser = Parser.of_string yaml in
13
+
let events = Parser.to_list parser in
14
+
Format.printf "Events: %d (ERROR: should have failed)@." (List.length events)
15
+
with
16
+
| Yamle_error e ->
17
+
Format.printf "Error (expected): %a@." Error.pp e
+11
yaml/ocaml-yamle/tests/test_5u3a.ml
+11
yaml/ocaml-yamle/tests/test_5u3a.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
let yaml = "key: - a\n - b\n" in
5
+
Printf.printf "YAML: %S\n" yaml;
6
+
try
7
+
let parser = Parser.of_string yaml in
8
+
let events = Parser.to_list parser in
9
+
Printf.printf "Events: %d (should have errored)\n" (List.length events)
10
+
with e ->
11
+
Printf.printf "Error (expected): %s\n" (Printexc.to_string e)
+29
yaml/ocaml-yamle/tests/test_6vjk_debug.ml
+29
yaml/ocaml-yamle/tests/test_6vjk_debug.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
let yaml = ">
5
+
Sammy Sosa completed another
6
+
fine season with great stats.
7
+
8
+
63 Home Runs
9
+
0.288 Batting Average
10
+
11
+
What a year!" in
12
+
Printf.printf "Input YAML:\n%s\n\n" yaml;
13
+
14
+
(* Create scanner and get scalar token *)
15
+
let scanner = Scanner.of_string yaml in
16
+
let rec find_scalar () =
17
+
match Scanner.next scanner with
18
+
| None -> failwith "No scalar found"
19
+
| Some { token; _ } ->
20
+
match token with
21
+
| Token.Scalar (style, value) ->
22
+
Printf.printf "Scalar value: %S\n" value;
23
+
Printf.printf "Style: %s\n" (match style with
24
+
| Scalar_style.Literal -> "Literal"
25
+
| Scalar_style.Folded -> "Folded"
26
+
| _ -> "Other")
27
+
| _ -> find_scalar ()
28
+
in
29
+
find_scalar ()
+31
yaml/ocaml-yamle/tests/test_6vjk_only.ml
+31
yaml/ocaml-yamle/tests/test_6vjk_only.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
let yaml = ">
5
+
Sammy Sosa completed another
6
+
fine season with great stats.
7
+
8
+
63 Home Runs
9
+
0.288 Batting Average
10
+
11
+
What a year!" in
12
+
13
+
let scanner = Scanner.of_string yaml in
14
+
let rec find_scalar () =
15
+
match Scanner.next scanner with
16
+
| None -> None
17
+
| Some { token; _ } ->
18
+
match token with
19
+
| Token.Scalar { style = _; value } -> Some value
20
+
| _ -> find_scalar ()
21
+
in
22
+
match find_scalar () with
23
+
| None -> Printf.printf "No scalar found\n"
24
+
| Some value ->
25
+
Printf.printf "Got: %S\n" value;
26
+
let expected = "Sammy Sosa completed another fine season with great stats.\n\n 63 Home Runs\n 0.288 Batting Average\n\nWhat a year!\n" in
27
+
Printf.printf "Expected: %S\n" expected;
28
+
if value = expected then
29
+
Printf.printf "PASS\n"
30
+
else
31
+
Printf.printf "FAIL\n"
+25
yaml/ocaml-yamle/tests/test_87e4.ml
+25
yaml/ocaml-yamle/tests/test_87e4.ml
···
1
+
open Yamle
2
+
3
+
let yaml = {|'implicit block key' : [
4
+
'implicit flow key' : value,
5
+
]|}
6
+
7
+
let () =
8
+
Printf.printf "Testing 87E4\n";
9
+
try
10
+
let parser = Parser.of_string yaml in
11
+
let events = Parser.to_list parser in
12
+
Printf.printf "Parsed successfully with %d events\n" (List.length events);
13
+
List.iteri (fun i ev ->
14
+
Printf.printf "Event %d: " i;
15
+
(match ev.Event.event with
16
+
| Event.Sequence_start _ -> Printf.printf "Sequence_start"
17
+
| Event.Sequence_end -> Printf.printf "Sequence_end"
18
+
| Event.Mapping_start _ -> Printf.printf "Mapping_start"
19
+
| Event.Mapping_end -> Printf.printf "Mapping_end"
20
+
| Event.Scalar {value; _} -> Printf.printf "Scalar(%S)" value
21
+
| _ -> Printf.printf "Other");
22
+
Printf.printf "\n"
23
+
) events
24
+
with Error.Yamle_error _ ->
25
+
Printf.printf "ERROR\n"
+14
yaml/ocaml-yamle/tests/test_a984_minimal.ml
+14
yaml/ocaml-yamle/tests/test_a984_minimal.ml
···
1
+
open Yamle
2
+
3
+
let test yaml =
4
+
Printf.printf "YAML:\n%s\n\n" yaml;
5
+
let scanner = Scanner.of_string yaml in
6
+
try
7
+
while Scanner.next scanner <> None do () done;
8
+
Printf.printf "Success!\n"
9
+
with e ->
10
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
11
+
12
+
let () =
13
+
test "d:\n e";
14
+
test "a: b\n c\nd:\n e\n f"
+20
yaml/ocaml-yamle/tests/test_a984_trace.ml
+20
yaml/ocaml-yamle/tests/test_a984_trace.ml
···
1
+
(* Trace A984 issue *)
2
+
open Yamle
3
+
4
+
let show_token tok =
5
+
Format.asprintf "%a" Token.pp_spanned tok
6
+
7
+
let () =
8
+
let yaml = "a: b\n c\nd:\n e\n f" in
9
+
Printf.printf "Testing A984:\n%s\n\n" yaml;
10
+
let scanner = Scanner.of_string yaml in
11
+
Printf.printf "Tokens:\n";
12
+
let rec print_tokens () =
13
+
match Scanner.peek scanner with
14
+
| None -> Printf.printf "Done\n"
15
+
| Some tok ->
16
+
Printf.printf " %s\n" (show_token tok);
17
+
ignore (Scanner.next scanner);
18
+
print_tokens ()
19
+
in
20
+
print_tokens ()
+19
yaml/ocaml-yamle/tests/test_all_mentioned_cases.ml
+19
yaml/ocaml-yamle/tests/test_all_mentioned_cases.ml
···
1
+
open Yamle
2
+
3
+
let test name yaml =
4
+
Printf.printf "\n=== %s ===\n" name;
5
+
let scanner = Scanner.of_string yaml in
6
+
try
7
+
while Scanner.next scanner <> None do () done;
8
+
Printf.printf "PASS\n"
9
+
with e ->
10
+
Printf.printf "FAIL: %s\n" (Printexc.to_string e)
11
+
12
+
let () =
13
+
(* All cases mentioned in the issue *)
14
+
test "565N - Construct Binary" "generic: !!binary |\n R0lGODlh";
15
+
test "A984 - Multiline Scalar" "a: b\n c\nd:\n e\n f";
16
+
test "RZP5 - Trailing Comments" "- #lala\n seq2";
17
+
test "XW4D - Trailing Comments variant" "- #comment\n value";
18
+
test "Q9WF - Separation Spaces" "a: -\tb";
19
+
test "V9D5 - Compact Block Mappings" "- a: b"
+167
yaml/ocaml-yamle/tests/test_anchor_tag_issues.ml
+167
yaml/ocaml-yamle/tests/test_anchor_tag_issues.ml
···
1
+
(** Test cases for BU8L, SKE5, RZP5, XW4D *)
2
+
3
+
let print_token tok =
4
+
match tok.Yamle.Token.token with
5
+
| Yamle.Token.Stream_start _ -> "Stream_start"
6
+
| Yamle.Token.Stream_end -> "Stream_end"
7
+
| Yamle.Token.Document_start -> "Document_start"
8
+
| Yamle.Token.Document_end -> "Document_end"
9
+
| Yamle.Token.Block_sequence_start -> "Block_sequence_start"
10
+
| Yamle.Token.Block_mapping_start -> "Block_mapping_start"
11
+
| Yamle.Token.Block_end -> "Block_end"
12
+
| Yamle.Token.Flow_sequence_start -> "Flow_sequence_start"
13
+
| Yamle.Token.Flow_sequence_end -> "Flow_sequence_end"
14
+
| Yamle.Token.Flow_mapping_start -> "Flow_mapping_start"
15
+
| Yamle.Token.Flow_mapping_end -> "Flow_mapping_end"
16
+
| Yamle.Token.Block_entry -> "Block_entry"
17
+
| Yamle.Token.Flow_entry -> "Flow_entry"
18
+
| Yamle.Token.Key -> "Key"
19
+
| Yamle.Token.Value -> "Value"
20
+
| Yamle.Token.Alias name -> "Alias(" ^ name ^ ")"
21
+
| Yamle.Token.Anchor name -> "Anchor(" ^ name ^ ")"
22
+
| Yamle.Token.Tag { handle; suffix } -> "Tag(" ^ handle ^ suffix ^ ")"
23
+
| Yamle.Token.Scalar { value; _ } -> "Scalar(" ^ String.sub value 0 (min 20 (String.length value)) ^ ")"
24
+
| Yamle.Token.Version_directive _ -> "Version_directive"
25
+
| Yamle.Token.Tag_directive _ -> "Tag_directive"
26
+
27
+
let test_bu8l () =
28
+
print_endline "Testing BU8L: Node Anchor and Tag on Separate Lines";
29
+
let yaml = {|key: &anchor
30
+
!!map
31
+
a: b|} in
32
+
try
33
+
let scanner = Yamle.Scanner.of_string yaml in
34
+
let rec print_tokens n =
35
+
if n > 30 then (print_endline " ... (stopped at 30 tokens)"; ())
36
+
else
37
+
try
38
+
match Yamle.Scanner.peek scanner with
39
+
| Some { token = Stream_end; _ } as tok ->
40
+
Printf.printf " %s\n" (print_token (Option.get tok));
41
+
ignore (Yamle.Scanner.next scanner);
42
+
()
43
+
| Some tok ->
44
+
Printf.printf " %s\n" (print_token tok);
45
+
ignore (Yamle.Scanner.next scanner);
46
+
print_tokens (n + 1)
47
+
| None -> print_endline " (no more tokens)"
48
+
with
49
+
| Yamle.Error.Yamle_error e ->
50
+
Printf.printf " ERROR during scan: %s\n" (Yamle.Error.to_string e);
51
+
raise (Yamle.Error.Yamle_error e)
52
+
in
53
+
print_tokens 0;
54
+
print_endline "BU8L: Scanner SUCCESS\n"
55
+
with
56
+
| Yamle.Error.Yamle_error e ->
57
+
Printf.printf "BU8L: FAILED with %s\n\n" (Yamle.Error.to_string e)
58
+
| e ->
59
+
Printf.printf "BU8L: FAILED with %s\n\n" (Printexc.to_string e)
60
+
61
+
let test_ske5 () =
62
+
print_endline "Testing SKE5: Anchor before zero indented sequence";
63
+
let yaml = {|---
64
+
seq:
65
+
&anchor
66
+
- a
67
+
- b|} in
68
+
try
69
+
let scanner = Yamle.Scanner.of_string yaml in
70
+
let rec count_tokens n =
71
+
match Yamle.Scanner.peek scanner with
72
+
| Some { token = Stream_end; _ } ->
73
+
ignore (Yamle.Scanner.next scanner);
74
+
n
75
+
| Some _ ->
76
+
ignore (Yamle.Scanner.next scanner);
77
+
count_tokens (n + 1)
78
+
| None -> n
79
+
in
80
+
let count = count_tokens 0 in
81
+
Printf.printf "SKE5: SUCCESS (tokens: %d)\n\n" count
82
+
with
83
+
| Yamle.Error.Yamle_error e ->
84
+
Printf.printf "SKE5: FAILED with %s\n\n" (Yamle.Error.to_string e)
85
+
| e ->
86
+
Printf.printf "SKE5: FAILED with %s\n\n" (Printexc.to_string e)
87
+
88
+
let test_rzp5 () =
89
+
print_endline "Testing RZP5: Various Trailing Comments [1.3]";
90
+
let yaml = {|a: "double
91
+
quotes" # lala
92
+
b: plain
93
+
value # lala
94
+
c : #lala
95
+
d
96
+
? # lala
97
+
- seq1
98
+
: # lala
99
+
- #lala
100
+
seq2
101
+
e: &node # lala
102
+
- x: y
103
+
block: > # lala
104
+
abcde|} in
105
+
try
106
+
let scanner = Yamle.Scanner.of_string yaml in
107
+
let rec count_tokens n =
108
+
match Yamle.Scanner.peek scanner with
109
+
| Some { token = Stream_end; _ } ->
110
+
ignore (Yamle.Scanner.next scanner);
111
+
n
112
+
| Some _ ->
113
+
ignore (Yamle.Scanner.next scanner);
114
+
count_tokens (n + 1)
115
+
| None -> n
116
+
in
117
+
let count = count_tokens 0 in
118
+
Printf.printf "RZP5: SUCCESS (tokens: %d)\n\n" count
119
+
with
120
+
| Yamle.Error.Yamle_error e ->
121
+
Printf.printf "RZP5: FAILED with %s\n\n" (Yamle.Error.to_string e)
122
+
| e ->
123
+
Printf.printf "RZP5: FAILED with %s\n\n" (Printexc.to_string e)
124
+
125
+
let test_xw4d () =
126
+
print_endline "Testing XW4D: Various Trailing Comments";
127
+
let yaml = {|a: "double
128
+
quotes" # lala
129
+
b: plain
130
+
value # lala
131
+
c : #lala
132
+
d
133
+
? # lala
134
+
- seq1
135
+
: # lala
136
+
- #lala
137
+
seq2
138
+
e:
139
+
&node # lala
140
+
- x: y
141
+
block: > # lala
142
+
abcde|} in
143
+
try
144
+
let scanner = Yamle.Scanner.of_string yaml in
145
+
let rec count_tokens n =
146
+
match Yamle.Scanner.peek scanner with
147
+
| Some { token = Stream_end; _ } ->
148
+
ignore (Yamle.Scanner.next scanner);
149
+
n
150
+
| Some _ ->
151
+
ignore (Yamle.Scanner.next scanner);
152
+
count_tokens (n + 1)
153
+
| None -> n
154
+
in
155
+
let count = count_tokens 0 in
156
+
Printf.printf "XW4D: SUCCESS (tokens: %d)\n\n" count
157
+
with
158
+
| Yamle.Error.Yamle_error e ->
159
+
Printf.printf "XW4D: FAILED with %s\n\n" (Yamle.Error.to_string e)
160
+
| e ->
161
+
Printf.printf "XW4D: FAILED with %s\n\n" (Printexc.to_string e)
162
+
163
+
let () =
164
+
test_bu8l ();
165
+
test_ske5 ();
166
+
test_rzp5 ();
167
+
test_xw4d ()
+11
yaml/ocaml-yamle/tests/test_basic_yaml.ml
+11
yaml/ocaml-yamle/tests/test_basic_yaml.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
let yaml = "key: value\n" in
5
+
Printf.printf "YAML: %S\n" yaml;
6
+
try
7
+
let parser = Parser.of_string yaml in
8
+
let events = Parser.to_list parser in
9
+
Printf.printf "Events: %d\n" (List.length events)
10
+
with e ->
11
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
+18
yaml/ocaml-yamle/tests/test_bs4k.ml
+18
yaml/ocaml-yamle/tests/test_bs4k.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
let yaml = "word1 # comment\nword2\n" in
5
+
Format.printf "YAML: %S@.@." yaml;
6
+
Format.printf "Parsing:@.";
7
+
try
8
+
let parser = Parser.of_string yaml in
9
+
let events = Parser.to_list parser in
10
+
Format.printf "Events: %d (ERROR: should have failed)@." (List.length events);
11
+
List.iter (fun e ->
12
+
Format.printf " %a@." Event.pp e.Event.event
13
+
) events
14
+
with
15
+
| Yamle_error e ->
16
+
Format.printf "Error (expected): %a@." Error.pp e
17
+
| e ->
18
+
Format.printf "Error: %s@." (Printexc.to_string e)
+21
yaml/ocaml-yamle/tests/test_debug_stale.ml
+21
yaml/ocaml-yamle/tests/test_debug_stale.ml
···
1
+
open Yamle
2
+
3
+
(* Patch Scanner to add debug output *)
4
+
let test yaml =
5
+
Printf.printf "YAML:\n%s\n\n" yaml;
6
+
let scanner = Scanner.of_string yaml in
7
+
try
8
+
let rec loop () =
9
+
match Scanner.next scanner with
10
+
| None -> Printf.printf "Done\n"
11
+
| Some tok ->
12
+
Printf.printf "%s\n" (Format.asprintf "%a" Token.pp_spanned tok);
13
+
loop ()
14
+
in
15
+
loop ()
16
+
with e ->
17
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
18
+
19
+
let () =
20
+
(* This should work: simple key, value on next line *)
21
+
test "d:\n e"
+21
yaml/ocaml-yamle/tests/test_dk4h.ml
+21
yaml/ocaml-yamle/tests/test_dk4h.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
let yaml = "---\n[ key\n : value ]\n" in
5
+
Printf.printf "YAML: %S\n" yaml;
6
+
let scanner = Scanner.of_string yaml in
7
+
Printf.printf "\nTokens:\n";
8
+
try
9
+
let rec loop () =
10
+
match Scanner.next scanner with
11
+
| None -> Printf.printf " (none)\n"
12
+
| Some tok ->
13
+
Printf.printf " %d:%d %s\n" tok.span.start.line tok.span.start.column
14
+
(Format.asprintf "%a" Token.pp tok.token);
15
+
match tok.token with
16
+
| Token.Stream_end -> ()
17
+
| _ -> loop ()
18
+
in
19
+
loop ()
20
+
with e ->
21
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
+9
yaml/ocaml-yamle/tests/test_error_type.ml
+9
yaml/ocaml-yamle/tests/test_error_type.ml
+6
yaml/ocaml-yamle/tests/test_indent_debug.ml
+6
yaml/ocaml-yamle/tests/test_indent_debug.ml
+18
yaml/ocaml-yamle/tests/test_ks4u.ml
+18
yaml/ocaml-yamle/tests/test_ks4u.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
let yaml = "---\n[\nsequence item\n]\ninvalid item\n" in
5
+
Format.printf "YAML: %S@.@." yaml;
6
+
Format.printf "Parsing:@.";
7
+
try
8
+
let parser = Parser.of_string yaml in
9
+
let events = Parser.to_list parser in
10
+
Format.printf "Events: %d (ERROR: should have failed)@." (List.length events);
11
+
List.iter (fun e ->
12
+
Format.printf " %a@." Event.pp e.Event.event
13
+
) events
14
+
with
15
+
| Yamle_error e ->
16
+
Format.printf "Error (expected): %a@." Error.pp e
17
+
| e ->
18
+
Format.printf "Error: %s@." (Printexc.to_string e)
+21
yaml/ocaml-yamle/tests/test_lhl4.ml
+21
yaml/ocaml-yamle/tests/test_lhl4.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
let yaml = "---\n!invalid{}tag scalar\n" in
5
+
Printf.printf "YAML: %S\n" yaml;
6
+
let scanner = Scanner.of_string yaml in
7
+
Printf.printf "\nTokens:\n";
8
+
try
9
+
let rec loop () =
10
+
match Scanner.next scanner with
11
+
| None -> Printf.printf " (none)\n"
12
+
| Some tok ->
13
+
Printf.printf " %d:%d %s\n" tok.span.start.line tok.span.start.column
14
+
(Format.asprintf "%a" Token.pp tok.token);
15
+
match tok.token with
16
+
| Token.Stream_end -> ()
17
+
| _ -> loop ()
18
+
in
19
+
loop ()
20
+
with e ->
21
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
+9
yaml/ocaml-yamle/tests/test_loader_debug.ml
+9
yaml/ocaml-yamle/tests/test_loader_debug.ml
···
1
+
module TL = Test_suite_lib.Test_suite_loader
2
+
3
+
let () =
4
+
Printf.printf "Testing test loader...\n";
5
+
try
6
+
let tests = TL.load_file "../yaml-test-suite/src/229Q.yaml" in
7
+
Printf.printf "Loaded %d tests\n" (List.length tests)
8
+
with e ->
9
+
Printf.printf "Error loading: %s\n" (Printexc.to_string e)
+11
yaml/ocaml-yamle/tests/test_mus6_debug.ml
+11
yaml/ocaml-yamle/tests/test_mus6_debug.ml
···
1
+
open Yamle
2
+
let () =
3
+
let yaml = "%YAML 1.1#...\n---\n" in
4
+
Format.printf "YAML: %S@.@." yaml;
5
+
try
6
+
let parser = Parser.of_string yaml in
7
+
let events = Parser.to_list parser in
8
+
Format.printf "Events: %d (ERROR: should have failed)@." (List.length events)
9
+
with
10
+
| Yamle_error e ->
11
+
Format.printf "Error (expected): %a@." Error.pp e
+47
yaml/ocaml-yamle/tests/test_nat4_a.ml
+47
yaml/ocaml-yamle/tests/test_nat4_a.ml
···
1
+
(* Test NAT4 case a specifically *)
2
+
open Yamle
3
+
4
+
let test_case desc yaml expected =
5
+
Printf.printf "\n=== %s ===\n" desc;
6
+
Printf.printf "Input: %s\n" (String.escaped yaml);
7
+
try
8
+
let parser = Parser.of_string yaml in
9
+
let events = Parser.to_list parser in
10
+
List.iter (fun (e : Event.spanned) ->
11
+
match e.event with
12
+
| Event.Scalar { value; style; _ } ->
13
+
Printf.printf "Output: %s (len=%d, style=%s)\n"
14
+
(String.escaped value)
15
+
(String.length value)
16
+
(match style with
17
+
| Scalar_style.Single_quoted -> "single"
18
+
| Scalar_style.Double_quoted -> "double"
19
+
| _ -> "other");
20
+
Printf.printf "Expected: %s (len=%d)\n" (String.escaped expected) (String.length expected);
21
+
if value = expected then
22
+
Printf.printf "✓ PASS\n"
23
+
else
24
+
Printf.printf "✗ FAIL\n"
25
+
| _ -> ()
26
+
) events
27
+
with e ->
28
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
29
+
30
+
let () =
31
+
(* NAT4 case a: newline then spaces *)
32
+
test_case "a" "a: '\n '" " ";
33
+
34
+
(* NAT4 case b: spaces, newline, spaces *)
35
+
test_case "b" "a: ' \n '" " ";
36
+
37
+
(* NAT4 case e: newline, empty line, spaces *)
38
+
test_case "e" "a: '\n\n '" "\n";
39
+
40
+
(* NAT4 case g: newline, two empty lines, spaces *)
41
+
test_case "g" "a: '\n\n\n '" "\n\n";
42
+
43
+
(* Simple case: text on both lines *)
44
+
test_case "simple" "a: 'foo\nbar'" "foo bar";
45
+
46
+
(* Case with empty line between text *)
47
+
test_case "empty_between" "a: 'foo\n\nbar'" "foo\nbar";
+31
yaml/ocaml-yamle/tests/test_remaining.ml
+31
yaml/ocaml-yamle/tests/test_remaining.ml
···
1
+
open Yamle
2
+
3
+
let test yaml name =
4
+
Printf.printf "\n=== %s ===\n" name;
5
+
Printf.printf "YAML: %S\n" yaml;
6
+
try
7
+
let parser = Parser.of_string yaml in
8
+
let _ = Parser.to_list parser in
9
+
Printf.printf "SUCCESS\n"
10
+
with Error.Yamle_error _ ->
11
+
Printf.printf "ERROR\n"
12
+
13
+
let () =
14
+
(* CT4Q: Single Pair Explicit Entry *)
15
+
test {|[
16
+
? foo
17
+
bar : baz
18
+
]|} "CT4Q";
19
+
20
+
(* DFF7: Flow Mapping Entries *)
21
+
test {|{
22
+
? explicit: entry,
23
+
implicit: entry,
24
+
?
25
+
}|} "DFF7";
26
+
27
+
(* FRK4: Completely Empty Flow Nodes *)
28
+
test {|{
29
+
? foo :,
30
+
: bar,
31
+
}|} "FRK4";
+30
yaml/ocaml-yamle/tests/test_simple_key_debug.ml
+30
yaml/ocaml-yamle/tests/test_simple_key_debug.ml
···
1
+
open Yamle
2
+
3
+
let test_case name yaml =
4
+
Printf.printf "\n=== Testing %s ===\n" name;
5
+
Printf.printf "YAML:\n%s\n\n" yaml;
6
+
let scanner = Scanner.of_string yaml in
7
+
Printf.printf "Tokens:\n";
8
+
let rec print_tokens () =
9
+
match Scanner.next scanner with
10
+
| None -> Printf.printf "Done\n"
11
+
| Some tok ->
12
+
Printf.printf " %s\n" (Format.asprintf "%a" Token.pp_spanned tok);
13
+
print_tokens ()
14
+
in
15
+
try
16
+
print_tokens ()
17
+
with e ->
18
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
19
+
20
+
let () =
21
+
(* Test A984 - Multiline Scalar in Mapping *)
22
+
test_case "A984" "a: b\n c\nd:\n e\n f";
23
+
24
+
(* Test RZP5 - Trailing Comments *)
25
+
test_case "RZP5" "- #lala\n seq2";
26
+
27
+
(* Simplified versions *)
28
+
test_case "Simple multiline" "a: b\n c";
29
+
test_case "Simple block entry with comment" "- # comment\n value";
30
+
test_case "After block scalar" "a: |\n text\nb: c"
+21
yaml/ocaml-yamle/tests/test_simple_single.ml
+21
yaml/ocaml-yamle/tests/test_simple_single.ml
···
1
+
(* Simple test of single-quoted scalar *)
2
+
open Yamle
3
+
4
+
let () =
5
+
let yaml = "'foo\n\nbar'" in
6
+
Printf.printf "Input: %s\n" (String.escaped yaml);
7
+
8
+
let scanner = Scanner.of_string yaml in
9
+
Scanner.iter (fun tok ->
10
+
match tok.Token.token with
11
+
| Token.Scalar { value; style; _ } ->
12
+
Printf.printf "Scalar: %s (len=%d)\n" (String.escaped value) (String.length value);
13
+
Printf.printf "Style: %s\n" (match style with
14
+
| Scalar_style.Single_quoted -> "single"
15
+
| _ -> "other");
16
+
(* Print each character *)
17
+
for i = 0 to String.length value - 1 do
18
+
Printf.printf " [%d] = %C (code=%d)\n" i value.[i] (Char.code value.[i])
19
+
done
20
+
| _ -> ()
21
+
) scanner
+4
yaml/ocaml-yamle/tests/test_suite_lib/dune
+4
yaml/ocaml-yamle/tests/test_suite_lib/dune
+176
yaml/ocaml-yamle/tests/test_suite_lib/test_suite_loader.ml
+176
yaml/ocaml-yamle/tests/test_suite_lib/test_suite_loader.ml
···
1
+
(* Load yaml-test-suite test cases from YAML format *)
2
+
open Yamle
3
+
4
+
type test_case = {
5
+
id : string;
6
+
name : string;
7
+
yaml : string;
8
+
tree : string option;
9
+
fail : bool;
10
+
}
11
+
12
+
let read_file path =
13
+
let ic = open_in path in
14
+
let n = in_channel_length ic in
15
+
let s = really_input_string ic n in
16
+
close_in ic;
17
+
s
18
+
19
+
(* Convert YAML test suite visual representations to actual characters *)
20
+
let convert_test_yaml yaml =
21
+
let result = Buffer.create (String.length yaml) in
22
+
let len = String.length yaml in
23
+
let rec process i =
24
+
if i >= len then ()
25
+
else
26
+
(* Check for multi-character sequences - must check longest first *)
27
+
(* ————» = em-dash em-dash em-dash em-dash guillemet (4 spaces = tab expanded) *)
28
+
if i + 14 <= len && String.sub yaml i 14 = "\xe2\x80\x94\xe2\x80\x94\xe2\x80\x94\xe2\x80\x94\xc2\xbb" then begin
29
+
Buffer.add_char result '\t';
30
+
process (i + 14)
31
+
end
32
+
(* ———» = em-dash em-dash em-dash guillemet *)
33
+
else if i + 11 <= len && String.sub yaml i 11 = "\xe2\x80\x94\xe2\x80\x94\xe2\x80\x94\xc2\xbb" then begin
34
+
Buffer.add_char result '\t';
35
+
process (i + 11)
36
+
end
37
+
(* ——» = em-dash em-dash guillemet *)
38
+
else if i + 8 <= len && String.sub yaml i 8 = "\xe2\x80\x94\xe2\x80\x94\xc2\xbb" then begin
39
+
Buffer.add_char result '\t';
40
+
process (i + 8)
41
+
end
42
+
(* —» = em-dash guillemet *)
43
+
else if i + 5 <= len && String.sub yaml i 5 = "\xe2\x80\x94\xc2\xbb" then begin
44
+
Buffer.add_char result '\t';
45
+
process (i + 5)
46
+
end
47
+
(* » = guillemet alone *)
48
+
else if i + 2 <= len && String.sub yaml i 2 = "\xc2\xbb" then begin
49
+
Buffer.add_char result '\t';
50
+
process (i + 2)
51
+
end
52
+
(* ␣ = open box for trailing space *)
53
+
else if i + 3 <= len && String.sub yaml i 3 = "\xe2\x90\xa3" then begin
54
+
Buffer.add_char result ' ';
55
+
process (i + 3)
56
+
end
57
+
(* ← = leftwards arrow for carriage return *)
58
+
else if i + 3 <= len && String.sub yaml i 3 = "\xe2\x86\x90" then begin
59
+
Buffer.add_char result '\r';
60
+
process (i + 3)
61
+
end
62
+
(* ⇔ = left-right double arrow for BOM *)
63
+
else if i + 3 <= len && String.sub yaml i 3 = "\xe2\x87\x94" then begin
64
+
Buffer.add_string result "\xEF\xBB\xBF";
65
+
process (i + 3)
66
+
end
67
+
(* ↵ = up-down arrow for explicit newline.
68
+
This represents a newline in the output AND replaces the following actual newline
69
+
(since each ↵ is on its own line in the test file's yaml field). *)
70
+
else if i + 3 <= len && String.sub yaml i 3 = "\xe2\x86\xb5" then begin
71
+
Buffer.add_char result '\n';
72
+
(* Skip the following newline if present (it's part of the test file structure, not content) *)
73
+
let next_i = i + 3 in
74
+
if next_i < len && yaml.[next_i] = '\n' then
75
+
process (next_i + 1)
76
+
else
77
+
process next_i
78
+
end
79
+
(* ∎ = end-of-proof symbol for empty stream *)
80
+
else if i + 3 <= len && String.sub yaml i 3 = "\xe2\x88\x8e" then begin
81
+
(* Skip this - it represents an empty file, so we add nothing *)
82
+
process (i + 3)
83
+
end
84
+
else begin
85
+
Buffer.add_char result yaml.[i];
86
+
process (i + 1)
87
+
end
88
+
in
89
+
process 0;
90
+
Buffer.contents result
91
+
92
+
(* Extract a field value from parsed YAML events *)
93
+
let extract_mapping_value events key =
94
+
let rec find_key = function
95
+
| [] -> None
96
+
| { Event.event = Event.Scalar { value; _ }; _ } :: rest when value = key ->
97
+
(* Found the key, now get the value *)
98
+
(match rest with
99
+
| { Event.event = Event.Scalar { value; _ }; _ } :: _ -> Some value
100
+
| _ -> None)
101
+
| _ :: rest -> find_key rest
102
+
in
103
+
find_key events
104
+
105
+
(* Parse a single test case from a mapping *)
106
+
let parse_test_case id events =
107
+
let name = match extract_mapping_value events "name" with
108
+
| Some n -> n
109
+
| None -> id
110
+
in
111
+
let yaml = match extract_mapping_value events "yaml" with
112
+
| Some y -> convert_test_yaml y
113
+
| None -> ""
114
+
in
115
+
let tree = extract_mapping_value events "tree" in
116
+
let fail = match extract_mapping_value events "fail" with
117
+
| Some "true" -> true
118
+
| _ -> Option.is_some (extract_mapping_value events "error")
119
+
in
120
+
{ id; name; yaml; tree; fail }
121
+
122
+
(* Load tests from a single YAML file *)
123
+
let load_file path =
124
+
let id = Filename.chop_extension (Filename.basename path) in
125
+
try
126
+
let content = read_file path in
127
+
let parser = Parser.of_string content in
128
+
let events = Parser.to_list parser in
129
+
130
+
(* File contains a sequence of test cases *)
131
+
let tests = ref [] in
132
+
let current_events = ref [] in
133
+
let in_mapping = ref false in
134
+
let depth = ref 0 in
135
+
let test_index = ref 0 in
136
+
137
+
List.iter (fun (e : Event.spanned) ->
138
+
match e.event with
139
+
| Event.Mapping_start _ when !depth = 1 ->
140
+
in_mapping := true;
141
+
current_events := [e];
142
+
incr depth
143
+
| Event.Mapping_end when !depth = 2 ->
144
+
current_events := e :: !current_events;
145
+
let test_id = if !test_index = 0 then id else Printf.sprintf "%s/%02d" id !test_index in
146
+
let test = parse_test_case test_id (List.rev !current_events) in
147
+
if test.yaml <> "" then tests := test :: !tests;
148
+
in_mapping := false;
149
+
current_events := [];
150
+
incr test_index;
151
+
decr depth
152
+
| _ when !in_mapping ->
153
+
current_events := e :: !current_events;
154
+
(match e.event with
155
+
| Event.Mapping_start _ | Event.Sequence_start _ -> incr depth
156
+
| Event.Mapping_end | Event.Sequence_end -> decr depth
157
+
| _ -> ())
158
+
| Event.Sequence_start _ when !depth = 0 -> depth := 1
159
+
| Event.Sequence_end when !depth = 1 -> depth := 0
160
+
| _ -> ()
161
+
) events;
162
+
163
+
List.rev !tests
164
+
with _ -> []
165
+
166
+
let load_directory src_path =
167
+
let entries = Sys.readdir src_path in
168
+
let tests = ref [] in
169
+
Array.iter (fun entry ->
170
+
if Filename.check_suffix entry ".yaml" then begin
171
+
let path = Filename.concat src_path entry in
172
+
let file_tests = load_file path in
173
+
tests := file_tests @ !tests
174
+
end
175
+
) entries;
176
+
List.sort (fun a b -> String.compare a.id b.id) !tests
+91
yaml/ocaml-yamle/tests/test_suite_lib/tree_format.ml
+91
yaml/ocaml-yamle/tests/test_suite_lib/tree_format.ml
···
1
+
(* Format parser events as tree notation compatible with yaml-test-suite *)
2
+
3
+
open Yamle
4
+
5
+
let escape_string s =
6
+
let buf = Buffer.create (String.length s * 2) in
7
+
let len = String.length s in
8
+
(* Find the last non-space character to identify trailing spaces *)
9
+
let rec find_last_non_space i =
10
+
if i < 0 then -1
11
+
else if s.[i] <> ' ' then i
12
+
else find_last_non_space (i - 1)
13
+
in
14
+
let last_non_space = find_last_non_space (len - 1) in
15
+
16
+
String.iteri (fun i c ->
17
+
match c with
18
+
| '\n' -> Buffer.add_string buf "\\n"
19
+
| '\t' -> Buffer.add_string buf "\\t"
20
+
| '\r' -> Buffer.add_string buf "\\r"
21
+
| '\\' -> Buffer.add_string buf "\\\\"
22
+
| '\x00' -> Buffer.add_string buf "\\0"
23
+
| '\x07' -> Buffer.add_string buf "\\a"
24
+
| '\x08' -> Buffer.add_string buf "\\b"
25
+
| '\x0b' -> Buffer.add_string buf "\\v"
26
+
| '\x0c' -> Buffer.add_string buf "\\f"
27
+
| '\x1b' -> Buffer.add_string buf "\\e"
28
+
| '\xa0' -> Buffer.add_string buf "\\_"
29
+
| ' ' when i > last_non_space ->
30
+
(* Trailing space - show with open box character *)
31
+
Buffer.add_string buf "\xe2\x90\xa3"
32
+
| c -> Buffer.add_char buf c
33
+
) s;
34
+
Buffer.contents buf
35
+
36
+
let style_char = function
37
+
| Scalar_style.Plain -> ':'
38
+
| Scalar_style.Single_quoted -> '\''
39
+
| Scalar_style.Double_quoted -> '"'
40
+
| Scalar_style.Literal -> '|'
41
+
| Scalar_style.Folded -> '>'
42
+
| Scalar_style.Any -> ':'
43
+
44
+
let format_event depth { Event.event; span = _span } =
45
+
let indent = String.make depth ' ' in
46
+
match event with
47
+
| Event.Stream_start _ -> "+STR"
48
+
| Event.Stream_end -> "-STR"
49
+
| Event.Document_start { implicit; _ } ->
50
+
if implicit then Printf.sprintf "%s+DOC" indent
51
+
else Printf.sprintf "%s+DOC ---" indent
52
+
| Event.Document_end { implicit } ->
53
+
if implicit then Printf.sprintf "%s-DOC" indent
54
+
else Printf.sprintf "%s-DOC ..." indent
55
+
| Event.Mapping_start { anchor; tag; style; _ } ->
56
+
let anchor_str = match anchor with Some a -> " &" ^ a | None -> "" in
57
+
let tag_str = match tag with Some t -> " <" ^ t ^ ">" | None -> "" in
58
+
let flow_str = match style with Layout_style.Flow -> " {}" | _ -> "" in
59
+
Printf.sprintf "%s+MAP%s%s%s" indent flow_str anchor_str tag_str
60
+
| Event.Mapping_end -> Printf.sprintf "%s-MAP" indent
61
+
| Event.Sequence_start { anchor; tag; style; _ } ->
62
+
let anchor_str = match anchor with Some a -> " &" ^ a | None -> "" in
63
+
let tag_str = match tag with Some t -> " <" ^ t ^ ">" | None -> "" in
64
+
let flow_str = match style with Layout_style.Flow -> " []" | _ -> "" in
65
+
Printf.sprintf "%s+SEQ%s%s%s" indent flow_str anchor_str tag_str
66
+
| Event.Sequence_end -> Printf.sprintf "%s-SEQ" indent
67
+
| Event.Scalar { anchor; tag; value; style; _ } ->
68
+
let anchor_str = match anchor with Some a -> " &" ^ a | None -> "" in
69
+
let tag_str = match tag with Some t -> " <" ^ t ^ ">" | None -> "" in
70
+
let style_c = style_char style in
71
+
Printf.sprintf "%s=VAL%s%s %c%s" indent anchor_str tag_str style_c (escape_string value)
72
+
| Event.Alias { anchor } ->
73
+
Printf.sprintf "%s=ALI *%s" indent anchor
74
+
75
+
let of_spanned_events events =
76
+
let buf = Buffer.create 256 in
77
+
let depth = ref 0 in
78
+
List.iter (fun (e : Event.spanned) ->
79
+
(match e.event with
80
+
| Event.Stream_end | Event.Document_end _ | Event.Mapping_end | Event.Sequence_end ->
81
+
decr depth
82
+
| _ -> ());
83
+
let line = format_event !depth e in
84
+
Buffer.add_string buf line;
85
+
Buffer.add_char buf '\n';
86
+
(match e.event with
87
+
| Event.Stream_start _ | Event.Document_start _ | Event.Mapping_start _ | Event.Sequence_start _ ->
88
+
incr depth
89
+
| _ -> ())
90
+
) events;
91
+
Buffer.contents buf
+21
yaml/ocaml-yamle/tests/test_sy6v.ml
+21
yaml/ocaml-yamle/tests/test_sy6v.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
let yaml = "&anchor - sequence entry\n" in
5
+
Printf.printf "YAML: %S\n" yaml;
6
+
let scanner = Scanner.of_string yaml in
7
+
Printf.printf "\nTokens:\n";
8
+
try
9
+
let rec loop () =
10
+
match Scanner.next scanner with
11
+
| None -> Printf.printf " (none)\n"
12
+
| Some tok ->
13
+
Printf.printf " %d:%d %s\n" tok.span.start.line tok.span.start.column
14
+
(Format.asprintf "%a" Token.pp tok.token);
15
+
match tok.token with
16
+
| Token.Stream_end -> ()
17
+
| _ -> loop ()
18
+
in
19
+
loop ()
20
+
with e ->
21
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
+24
yaml/ocaml-yamle/tests/test_tokens2.ml
+24
yaml/ocaml-yamle/tests/test_tokens2.ml
···
1
+
open Yamle
2
+
3
+
let yaml = {|'implicit block key' : [
4
+
'implicit flow key' : value,
5
+
]|}
6
+
7
+
let () =
8
+
let scanner = Scanner.of_string yaml in
9
+
let rec print_all n =
10
+
match Scanner.next scanner with
11
+
| None -> ()
12
+
| Some tok ->
13
+
Printf.printf "%2d. " n;
14
+
(match tok.Token.token with
15
+
| Token.Flow_sequence_start -> Printf.printf "Flow_sequence_start"
16
+
| Token.Flow_sequence_end -> Printf.printf "Flow_sequence_end"
17
+
| Token.Flow_entry -> Printf.printf "Flow_entry"
18
+
| Token.Value -> Printf.printf "Value"
19
+
| Token.Scalar {value; _} -> Printf.printf "Scalar(%S)" value
20
+
| _ -> Printf.printf "Other");
21
+
Printf.printf " at %d:%d\n" tok.span.start.line tok.span.start.column;
22
+
print_all (n + 1)
23
+
in
24
+
print_all 0
+19
yaml/ocaml-yamle/tests/test_trace_a984.ml
+19
yaml/ocaml-yamle/tests/test_trace_a984.ml
···
1
+
open Yamle
2
+
3
+
let () =
4
+
(* Minimal A984 reproduction *)
5
+
let yaml = "d:\n e" in
6
+
Printf.printf "Testing minimal A984:\n%s\n\n" yaml;
7
+
let scanner = Scanner.of_string yaml in
8
+
Printf.printf "Tokens:\n";
9
+
let rec print_tokens () =
10
+
match Scanner.next scanner with
11
+
| None -> Printf.printf "Done\n"
12
+
| Some tok ->
13
+
Printf.printf " %s\n" (Format.asprintf "%a" Token.pp_spanned tok);
14
+
print_tokens ()
15
+
in
16
+
try
17
+
print_tokens ()
18
+
with e ->
19
+
Printf.printf "Error: %s\n" (Printexc.to_string e)
+41
yaml/ocaml-yamle/tests/test_y79y.ml
+41
yaml/ocaml-yamle/tests/test_y79y.ml
···
1
+
(* Debug Y79Y test cases *)
2
+
open Yamle
3
+
4
+
let () =
5
+
(* Test case 1: fail=true - tabs at wrong indentation in block scalar *)
6
+
let yaml1 = "foo: |\n \t\nbar: 1" in
7
+
Printf.printf "=== Test 1 (should fail) ===\n";
8
+
Printf.printf "Input: %S\n" yaml1;
9
+
Printf.printf "Visual:\n";
10
+
String.iter (fun c ->
11
+
if c = '\t' then Printf.printf "<TAB>"
12
+
else if c = '\n' then Printf.printf "<NL>\n"
13
+
else Printf.printf "%c" c
14
+
) yaml1;
15
+
Printf.printf "\n";
16
+
(try
17
+
let parser = Parser.of_string yaml1 in
18
+
let events = Parser.to_list parser in
19
+
Printf.printf "Events: %d\n" (List.length events);
20
+
Printf.printf "ERROR: Should have failed but didn't!\n\n"
21
+
with e ->
22
+
Printf.printf "Failed as expected: %s\n\n" (Printexc.to_string e));
23
+
24
+
(* Test case 2: should succeed - tab with proper indentation in block scalar *)
25
+
let yaml2 = "foo: |\n \t\nbar: 1" in
26
+
Printf.printf "=== Test 2 (should succeed) ===\n";
27
+
Printf.printf "Input: %S\n" yaml2;
28
+
Printf.printf "Visual:\n";
29
+
String.iter (fun c ->
30
+
if c = '\t' then Printf.printf "<TAB>"
31
+
else if c = '\n' then Printf.printf "<NL>\n"
32
+
else Printf.printf "%c" c
33
+
) yaml2;
34
+
Printf.printf "\n";
35
+
(try
36
+
let parser = Parser.of_string yaml2 in
37
+
let events = Parser.to_list parser in
38
+
Printf.printf "Events: %d\n" (List.length events);
39
+
Printf.printf "\n"
40
+
with e ->
41
+
Printf.printf "ERROR: Failed but should succeed: %s\n\n" (Printexc.to_string e))
+68
yaml/ocaml-yamle/tests/test_y79y_all.ml
+68
yaml/ocaml-yamle/tests/test_y79y_all.ml
···
1
+
(* Test all Y79Y cases *)
2
+
3
+
let test_case name yaml should_fail =
4
+
Printf.printf "=== %s ===\n" name;
5
+
try
6
+
let scanner = Yamle.Scanner.of_string yaml in
7
+
let _tokens = Yamle.Scanner.to_list scanner in
8
+
if should_fail then begin
9
+
Printf.printf "FAIL: Expected error but parsing succeeded\n";
10
+
false
11
+
end else begin
12
+
Printf.printf "PASS: Parsing succeeded as expected\n";
13
+
true
14
+
end
15
+
with e ->
16
+
if should_fail then begin
17
+
Printf.printf "PASS: Failed as expected (%s)\n" (Printexc.to_string e);
18
+
true
19
+
end else begin
20
+
Printf.printf "FAIL: Unexpected error (%s)\n" (Printexc.to_string e);
21
+
false
22
+
end
23
+
24
+
let () =
25
+
let results = ref [] in
26
+
27
+
(* Y79Y/00: Tab at start - should FAIL *)
28
+
results := test_case "Y79Y/00" "foo: |\n\t\nbar: 1" true :: !results;
29
+
30
+
(* Y79Y/01: Tab after 1 space - should PASS *)
31
+
results := test_case "Y79Y/01" "foo: |\n \t\nbar: 1" false :: !results;
32
+
33
+
(* Y79Y/02: Tab in flow sequence after newline - should PASS *)
34
+
results := test_case "Y79Y/02" "- [\n\t\n foo\n ]" false :: !results;
35
+
36
+
(* Y79Y/03: Tab immediately after flow start and content - should FAIL *)
37
+
results := test_case "Y79Y/03" "- [\n\tfoo,\n foo\n ]" true :: !results;
38
+
39
+
(* Y79Y/04: Tab after dash at root level - should FAIL *)
40
+
results := test_case "Y79Y/04" "-\t-" true :: !results;
41
+
42
+
(* Y79Y/05: Tab after dash with space - should FAIL *)
43
+
results := test_case "Y79Y/05" "- \t-" true :: !results;
44
+
45
+
(* Y79Y/06: Tab after ? at root level - should FAIL *)
46
+
results := test_case "Y79Y/06" "?\t-" true :: !results;
47
+
48
+
(* Y79Y/07: Tab after : in explicit mapping - should FAIL *)
49
+
results := test_case "Y79Y/07" "? -\n:\t-" true :: !results;
50
+
51
+
(* Y79Y/08: Tab after ? before key - should FAIL *)
52
+
results := test_case "Y79Y/08" "?\tkey:" true :: !results;
53
+
54
+
(* Y79Y/09: Tab after : in explicit mapping - should FAIL *)
55
+
results := test_case "Y79Y/09" "? key:\n:\tkey:" true :: !results;
56
+
57
+
(* Y79Y/10: Tab before number (content) - should PASS *)
58
+
results := test_case "Y79Y/10" "-\t-1" false :: !results;
59
+
60
+
Printf.printf "\n=== Summary ===\n";
61
+
let passed = List.filter (fun x -> x) !results |> List.length in
62
+
let total = List.length !results in
63
+
Printf.printf "%d/%d tests passed\n" passed total;
64
+
if passed = total then
65
+
Printf.printf "All tests PASSED!\n"
66
+
else
67
+
Printf.printf "Some tests FAILED\n";
68
+
exit (if passed = total then 0 else 1)
+13
yaml/ocaml-yamle/tests/test_y79y_simple.ml
+13
yaml/ocaml-yamle/tests/test_y79y_simple.ml
···
1
+
(* Simple Y79Y test *)
2
+
3
+
let () =
4
+
(* Test case 1: should fail - tab at wrong indentation *)
5
+
let yaml1 = "foo: |\n \t\nbar: 1" in
6
+
Printf.printf "=== Test 1 (should fail) ===\n";
7
+
Printf.printf "Testing: %S\n" yaml1;
8
+
(try
9
+
let scanner = Yamle.Scanner.of_string yaml1 in
10
+
let _tokens = Yamle.Scanner.to_list scanner in
11
+
Printf.printf "ERROR: Scanning succeeded but should have failed!\n"
12
+
with e ->
13
+
Printf.printf "OK: Failed as expected: %s\n" (Printexc.to_string e))
+44
yaml/ocaml-yamle/tests/test_y79y_trace.ml
+44
yaml/ocaml-yamle/tests/test_y79y_trace.ml
···
1
+
(* Trace Y79Y test *)
2
+
3
+
let test_case yaml desc should_fail expected_scalars =
4
+
Printf.printf "=== %s ===\n" desc;
5
+
Printf.printf "Testing: %S\n" yaml;
6
+
try
7
+
let scanner = Yamle.Scanner.of_string yaml in
8
+
let tokens = Yamle.Scanner.to_list scanner in
9
+
if should_fail then
10
+
Printf.printf "ERROR: Expected to fail but got %d tokens\n" (List.length tokens)
11
+
else begin
12
+
Printf.printf "OK: Got %d tokens\n" (List.length tokens);
13
+
let scalars = ref [] in
14
+
List.iter (fun (t : Yamle.Token.spanned) ->
15
+
match t.token with
16
+
| Yamle.Token.Scalar { value; _ } ->
17
+
scalars := value :: !scalars;
18
+
Printf.printf " Scalar: %S\n" value
19
+
| _ -> ()
20
+
) tokens;
21
+
let scalars = List.rev !scalars in
22
+
if scalars <> expected_scalars then begin
23
+
Printf.printf "ERROR: Expected scalars %s but got %s\n"
24
+
(String.concat ", " (List.map (Printf.sprintf "%S") expected_scalars))
25
+
(String.concat ", " (List.map (Printf.sprintf "%S") scalars))
26
+
end
27
+
end
28
+
with e ->
29
+
if should_fail then
30
+
Printf.printf "OK: Failed as expected: %s\n" (Printexc.to_string e)
31
+
else
32
+
Printf.printf "ERROR: Unexpected failure: %s\n" (Printexc.to_string e)
33
+
34
+
let () =
35
+
(* Test case 0 (Y79Y): should fail - tab at start of content *)
36
+
let yaml0 = "foo: |\n\t\nbar: 1" in
37
+
test_case yaml0 "Y79Y/00: tab at start (no spaces)" true [];
38
+
Printf.printf "\n";
39
+
40
+
(* Test case 1 (Y79Y/01): should succeed - tab after 1 space indent *)
41
+
(* Expected: foo="\t\n", bar="1" *)
42
+
let yaml1 = "foo: |\n \t\nbar: 1" in
43
+
test_case yaml1 "Y79Y/01: tab after 1 space" false ["foo"; "\t\n"; "bar"; "1"];
44
+
Printf.printf "\n"