···
1
-
(* Load yaml-test-suite test cases from YAML format *)
1
+
(* Load yaml-test-suite test cases from data branch format *)
9
-
json : string option; (* If present, indicates test should parse successfully *)
8
+
json : string option;
14
-
let ic = open_in path in
15
-
let n = in_channel_length ic in
16
-
let s = really_input_string ic n in
14
+
let ic = open_in path in
15
+
let n = in_channel_length ic in
16
+
let s = really_input_string ic n in
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
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';
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';
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';
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';
48
-
(* » = guillemet alone *)
49
-
else if i + 2 <= len && String.sub yaml i 2 = "\xc2\xbb" then begin
50
-
Buffer.add_char result '\t';
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 ' ';
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';
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";
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)
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 *)
86
-
Buffer.add_char result yaml.[i];
91
-
Buffer.contents result
21
+
let read_file_required path =
22
+
match read_file path with
93
-
(* Extract a field value from parsed YAML events *)
94
-
let extract_mapping_value events key =
95
-
let rec find_key = function
97
-
| { Event.event = Event.Scalar { value; _ }; _ } :: rest when value = key ->
98
-
(* Found the key, now get the value *)
100
-
| { Event.event = Event.Scalar { value; _ }; _ } :: _ -> Some value
102
-
| _ :: rest -> find_key rest
26
+
let file_exists path =
27
+
Sys.file_exists path
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
112
-
let yaml = match extract_mapping_value events "yaml" with
113
-
| Some y -> convert_test_yaml y
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")
122
-
{ id; name; yaml; tree; json; fail }
29
+
let is_directory path =
30
+
Sys.file_exists path && Sys.is_directory path
124
-
(* Load tests from a single YAML file *)
125
-
let load_file path =
126
-
let id = Filename.chop_extension (Filename.basename path) in
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
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
43
+
let name = match read_file name_file with
44
+
| Some s -> String.trim s
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 }
139
-
List.iter (fun (e : Event.spanned) ->
141
-
| Event.Mapping_start _ when !depth = 1 ->
142
-
in_mapping := true;
143
-
current_events := [e];
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 := [];
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
160
-
| Event.Sequence_start _ when !depth = 0 -> depth := 1
161
-
| Event.Sequence_end when !depth = 1 -> depth := 0
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 []
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'
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
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
81
+
(* Single test in this directory *)
82
+
match load_test_dir test_id dir_path with
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
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 []
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
97
+
List.concat_map (load_test_id test_suite_path) test_ids
anil.recoil.org