this repo has no description
more
+94
-198
+1
-2
yaml/ocaml-yamle/tests/run_all_tests.ml
+1
-2
yaml/ocaml-yamle/tests/run_all_tests.ml
···
349
349
] in
350
350
Arg.parse args (fun _ -> ()) "Usage: run_all_tests [--html <file>] [--show-skipped]";
351
351
352
-
let src_path = Filename.concat test_suite_path "src" in
353
-
let all_tests = TL.load_directory src_path in
352
+
let all_tests = TL.load_directory test_suite_path in
354
353
Printf.printf "Total tests loaded: %d\n%!" (List.length all_tests);
355
354
356
355
let results = List.map run_test all_tests in
+79
-160
yaml/ocaml-yamle/tests/test_suite_lib/test_suite_loader.ml
+79
-160
yaml/ocaml-yamle/tests/test_suite_lib/test_suite_loader.ml
···
1
-
(* Load yaml-test-suite test cases from YAML format *)
2
-
open Yamle
1
+
(* Load yaml-test-suite test cases from data branch format *)
3
2
4
3
type test_case = {
5
4
id : string;
6
5
name : string;
7
6
yaml : string;
8
7
tree : string option;
9
-
json : string option; (* If present, indicates test should parse successfully *)
8
+
json : string option;
10
9
fail : bool;
11
10
}
12
11
13
12
let read_file path =
14
-
let ic = open_in path in
15
-
let n = in_channel_length ic in
16
-
let s = really_input_string ic n in
17
-
close_in ic;
18
-
s
13
+
try
14
+
let ic = open_in path in
15
+
let n = in_channel_length ic in
16
+
let s = really_input_string ic n in
17
+
close_in ic;
18
+
Some s
19
+
with _ -> None
19
20
20
-
(* Convert YAML test suite visual representations to actual characters *)
21
-
let convert_test_yaml yaml =
22
-
let result = Buffer.create (String.length yaml) in
23
-
let len = String.length yaml in
24
-
let rec process i =
25
-
if i >= len then ()
26
-
else
27
-
(* Check for multi-character sequences - must check longest first *)
28
-
(* ————» = em-dash em-dash em-dash em-dash guillemet (4 spaces = tab expanded) *)
29
-
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
30
-
Buffer.add_char result '\t';
31
-
process (i + 14)
32
-
end
33
-
(* ———» = em-dash em-dash em-dash guillemet *)
34
-
else if i + 11 <= len && String.sub yaml i 11 = "\xe2\x80\x94\xe2\x80\x94\xe2\x80\x94\xc2\xbb" then begin
35
-
Buffer.add_char result '\t';
36
-
process (i + 11)
37
-
end
38
-
(* ——» = em-dash em-dash guillemet *)
39
-
else if i + 8 <= len && String.sub yaml i 8 = "\xe2\x80\x94\xe2\x80\x94\xc2\xbb" then begin
40
-
Buffer.add_char result '\t';
41
-
process (i + 8)
42
-
end
43
-
(* —» = em-dash guillemet *)
44
-
else if i + 5 <= len && String.sub yaml i 5 = "\xe2\x80\x94\xc2\xbb" then begin
45
-
Buffer.add_char result '\t';
46
-
process (i + 5)
47
-
end
48
-
(* » = guillemet alone *)
49
-
else if i + 2 <= len && String.sub yaml i 2 = "\xc2\xbb" then begin
50
-
Buffer.add_char result '\t';
51
-
process (i + 2)
52
-
end
53
-
(* ␣ = open box for trailing space *)
54
-
else if i + 3 <= len && String.sub yaml i 3 = "\xe2\x90\xa3" then begin
55
-
Buffer.add_char result ' ';
56
-
process (i + 3)
57
-
end
58
-
(* ← = leftwards arrow for carriage return *)
59
-
else if i + 3 <= len && String.sub yaml i 3 = "\xe2\x86\x90" then begin
60
-
Buffer.add_char result '\r';
61
-
process (i + 3)
62
-
end
63
-
(* ⇔ = left-right double arrow for BOM *)
64
-
else if i + 3 <= len && String.sub yaml i 3 = "\xe2\x87\x94" then begin
65
-
Buffer.add_string result "\xEF\xBB\xBF";
66
-
process (i + 3)
67
-
end
68
-
(* ↵ = up-down arrow for explicit newline.
69
-
This represents a newline in the output AND replaces the following actual newline
70
-
(since each ↵ is on its own line in the test file's yaml field). *)
71
-
else if i + 3 <= len && String.sub yaml i 3 = "\xe2\x86\xb5" then begin
72
-
Buffer.add_char result '\n';
73
-
(* Skip the following newline if present (it's part of the test file structure, not content) *)
74
-
let next_i = i + 3 in
75
-
if next_i < len && yaml.[next_i] = '\n' then
76
-
process (next_i + 1)
77
-
else
78
-
process next_i
79
-
end
80
-
(* ∎ = end-of-proof symbol for empty stream *)
81
-
else if i + 3 <= len && String.sub yaml i 3 = "\xe2\x88\x8e" then begin
82
-
(* Skip this - it represents an empty file, so we add nothing *)
83
-
process (i + 3)
84
-
end
85
-
else begin
86
-
Buffer.add_char result yaml.[i];
87
-
process (i + 1)
88
-
end
89
-
in
90
-
process 0;
91
-
Buffer.contents result
21
+
let read_file_required path =
22
+
match read_file path with
23
+
| Some s -> s
24
+
| None -> ""
92
25
93
-
(* Extract a field value from parsed YAML events *)
94
-
let extract_mapping_value events key =
95
-
let rec find_key = function
96
-
| [] -> None
97
-
| { Event.event = Event.Scalar { value; _ }; _ } :: rest when value = key ->
98
-
(* Found the key, now get the value *)
99
-
(match rest with
100
-
| { Event.event = Event.Scalar { value; _ }; _ } :: _ -> Some value
101
-
| _ -> None)
102
-
| _ :: rest -> find_key rest
103
-
in
104
-
find_key events
26
+
let file_exists path =
27
+
Sys.file_exists path
105
28
106
-
(* Parse a single test case from a mapping *)
107
-
let parse_test_case id events =
108
-
let name = match extract_mapping_value events "name" with
109
-
| Some n -> n
110
-
| None -> id
111
-
in
112
-
let yaml = match extract_mapping_value events "yaml" with
113
-
| Some y -> convert_test_yaml y
114
-
| None -> ""
115
-
in
116
-
let tree = extract_mapping_value events "tree" in
117
-
let json = extract_mapping_value events "json" in
118
-
let fail = match extract_mapping_value events "fail" with
119
-
| Some "true" -> true
120
-
| _ -> Option.is_some (extract_mapping_value events "error")
121
-
in
122
-
{ id; name; yaml; tree; json; fail }
29
+
let is_directory path =
30
+
Sys.file_exists path && Sys.is_directory path
123
31
124
-
(* Load tests from a single YAML file *)
125
-
let load_file path =
126
-
let id = Filename.chop_extension (Filename.basename path) in
127
-
try
128
-
let content = read_file path in
129
-
let parser = Parser.of_string content in
130
-
let events = Parser.to_list parser in
32
+
(* Load a single test from a directory *)
33
+
let load_test_dir base_id dir_path =
34
+
let name_file = Filename.concat dir_path "===" in
35
+
let yaml_file = Filename.concat dir_path "in.yaml" in
36
+
let tree_file = Filename.concat dir_path "test.event" in
37
+
let json_file = Filename.concat dir_path "in.json" in
38
+
let error_file = Filename.concat dir_path "error" in
131
39
132
-
(* File contains a sequence of test cases *)
133
-
let tests = ref [] in
134
-
let current_events = ref [] in
135
-
let in_mapping = ref false in
136
-
let depth = ref 0 in
137
-
let test_index = ref 0 in
40
+
(* Must have in.yaml to be a valid test *)
41
+
if not (file_exists yaml_file) then None
42
+
else
43
+
let name = match read_file name_file with
44
+
| Some s -> String.trim s
45
+
| None -> base_id
46
+
in
47
+
let yaml = read_file_required yaml_file in
48
+
let tree = read_file tree_file in
49
+
let json = read_file json_file in
50
+
let fail = file_exists error_file in
51
+
Some { id = base_id; name; yaml; tree; json; fail }
138
52
139
-
List.iter (fun (e : Event.spanned) ->
140
-
match e.event with
141
-
| Event.Mapping_start _ when !depth = 1 ->
142
-
in_mapping := true;
143
-
current_events := [e];
144
-
incr depth
145
-
| Event.Mapping_end when !depth = 2 ->
146
-
current_events := e :: !current_events;
147
-
let test_id = if !test_index = 0 then id else Printf.sprintf "%s/%02d" id !test_index in
148
-
let test = parse_test_case test_id (List.rev !current_events) in
149
-
if test.yaml <> "" then tests := test :: !tests;
150
-
in_mapping := false;
151
-
current_events := [];
152
-
incr test_index;
153
-
decr depth
154
-
| _ when !in_mapping ->
155
-
current_events := e :: !current_events;
156
-
(match e.event with
157
-
| Event.Mapping_start _ | Event.Sequence_start _ -> incr depth
158
-
| Event.Mapping_end | Event.Sequence_end -> decr depth
159
-
| _ -> ())
160
-
| Event.Sequence_start _ when !depth = 0 -> depth := 1
161
-
| Event.Sequence_end when !depth = 1 -> depth := 0
162
-
| _ -> ()
163
-
) events;
53
+
(* Load tests from a test ID directory (may have subdirectories for variants) *)
54
+
let load_test_id test_suite_path test_id =
55
+
let dir_path = Filename.concat test_suite_path test_id in
56
+
if not (is_directory dir_path) then []
57
+
else
58
+
(* Check if this directory has variant subdirectories (00, 01, etc.) *)
59
+
let entries = Sys.readdir dir_path in
60
+
let has_variants = Array.exists (fun e ->
61
+
let subdir = Filename.concat dir_path e in
62
+
is_directory subdir &&
63
+
String.length e >= 2 &&
64
+
e.[0] >= '0' && e.[0] <= '9'
65
+
) entries in
164
66
165
-
List.rev !tests
166
-
with _ -> []
67
+
if has_variants then
68
+
(* Load each variant subdirectory *)
69
+
let variants = Array.to_list entries
70
+
|> List.filter (fun e ->
71
+
let subdir = Filename.concat dir_path e in
72
+
is_directory subdir && String.length e >= 2 && e.[0] >= '0' && e.[0] <= '9')
73
+
|> List.sort String.compare
74
+
in
75
+
List.filter_map (fun variant ->
76
+
let variant_path = Filename.concat dir_path variant in
77
+
let variant_id = Printf.sprintf "%s:%s" test_id variant in
78
+
load_test_dir variant_id variant_path
79
+
) variants
80
+
else
81
+
(* Single test in this directory *)
82
+
match load_test_dir test_id dir_path with
83
+
| Some t -> [t]
84
+
| None -> []
167
85
168
-
let load_directory src_path =
169
-
let entries = Sys.readdir src_path in
170
-
let tests = ref [] in
171
-
Array.iter (fun entry ->
172
-
if Filename.check_suffix entry ".yaml" then begin
173
-
let path = Filename.concat src_path entry in
174
-
let file_tests = load_file path in
175
-
tests := file_tests @ !tests
176
-
end
177
-
) entries;
178
-
List.sort (fun a b -> String.compare a.id b.id) !tests
86
+
let load_directory test_suite_path =
87
+
if not (is_directory test_suite_path) then []
88
+
else
89
+
let entries = Sys.readdir test_suite_path in
90
+
let test_ids = Array.to_list entries
91
+
|> List.filter (fun e ->
92
+
is_directory (Filename.concat test_suite_path e) &&
93
+
String.length e >= 4 && (* Test IDs are 4 chars *)
94
+
e.[0] >= '0' && e.[0] <= 'Z') (* Start with alphanumeric *)
95
+
|> List.sort String.compare
96
+
in
97
+
List.concat_map (load_test_id test_suite_path) test_ids
+14
-36
yaml/ocaml-yamle/tests/test_suite_lib/tree_format.ml
+14
-36
yaml/ocaml-yamle/tests/test_suite_lib/tree_format.ml
···
4
4
5
5
let escape_string s =
6
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 ->
7
+
String.iter (fun c ->
17
8
match c with
18
9
| '\n' -> Buffer.add_string buf "\\n"
19
10
| '\t' -> Buffer.add_string buf "\\t"
···
26
17
| '\x0c' -> Buffer.add_string buf "\\f"
27
18
| '\x1b' -> Buffer.add_string buf "\\e"
28
19
| '\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
20
| c -> Buffer.add_char buf c
33
21
) s;
34
22
Buffer.contents buf
···
41
29
| Scalar_style.Folded -> '>'
42
30
| Scalar_style.Any -> ':'
43
31
44
-
let format_event depth { Event.event; span = _span } =
45
-
let indent = String.make depth ' ' in
32
+
let format_event { Event.event; span = _span } =
46
33
match event with
47
34
| Event.Stream_start _ -> "+STR"
48
35
| Event.Stream_end -> "-STR"
49
36
| Event.Document_start { implicit; _ } ->
50
-
if implicit then Printf.sprintf "%s+DOC" indent
51
-
else Printf.sprintf "%s+DOC ---" indent
37
+
if implicit then "+DOC"
38
+
else "+DOC ---"
52
39
| Event.Document_end { implicit } ->
53
-
if implicit then Printf.sprintf "%s-DOC" indent
54
-
else Printf.sprintf "%s-DOC ..." indent
40
+
if implicit then "-DOC"
41
+
else "-DOC ..."
55
42
| Event.Mapping_start { anchor; tag; style; _ } ->
56
43
let anchor_str = match anchor with Some a -> " &" ^ a | None -> "" in
57
44
let tag_str = match tag with Some t -> " <" ^ t ^ ">" | None -> "" in
58
45
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
46
+
Printf.sprintf "+MAP%s%s%s" flow_str anchor_str tag_str
47
+
| Event.Mapping_end -> "-MAP"
61
48
| Event.Sequence_start { anchor; tag; style; _ } ->
62
49
let anchor_str = match anchor with Some a -> " &" ^ a | None -> "" in
63
50
let tag_str = match tag with Some t -> " <" ^ t ^ ">" | None -> "" in
64
51
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
52
+
Printf.sprintf "+SEQ%s%s%s" flow_str anchor_str tag_str
53
+
| Event.Sequence_end -> "-SEQ"
67
54
| Event.Scalar { anchor; tag; value; style; _ } ->
68
55
let anchor_str = match anchor with Some a -> " &" ^ a | None -> "" in
69
56
let tag_str = match tag with Some t -> " <" ^ t ^ ">" | None -> "" in
70
57
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)
58
+
Printf.sprintf "=VAL%s%s %c%s" anchor_str tag_str style_c (escape_string value)
72
59
| Event.Alias { anchor } ->
73
-
Printf.sprintf "%s=ALI *%s" indent anchor
60
+
Printf.sprintf "=ALI *%s" anchor
74
61
75
62
let of_spanned_events events =
76
63
let buf = Buffer.create 256 in
77
-
let depth = ref 0 in
78
64
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
65
+
let line = format_event e in
84
66
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
-
| _ -> ())
67
+
Buffer.add_char buf '\n'
90
68
) events;
91
69
Buffer.contents buf