···
-
(* Load yaml-test-suite test cases from YAML format *)
-
json : string option; (* If present, indicates test should parse successfully *)
-
let ic = open_in path in
-
let n = in_channel_length ic in
-
let s = really_input_string ic n in
-
(* Convert YAML test suite visual representations to actual characters *)
-
let convert_test_yaml yaml =
-
let result = Buffer.create (String.length yaml) in
-
let len = String.length yaml in
-
(* Check for multi-character sequences - must check longest first *)
-
(* ————» = em-dash em-dash em-dash em-dash guillemet (4 spaces = tab expanded) *)
-
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
-
Buffer.add_char result '\t';
-
(* ———» = em-dash em-dash em-dash guillemet *)
-
else if i + 11 <= len && String.sub yaml i 11 = "\xe2\x80\x94\xe2\x80\x94\xe2\x80\x94\xc2\xbb" then begin
-
Buffer.add_char result '\t';
-
(* ——» = em-dash em-dash guillemet *)
-
else if i + 8 <= len && String.sub yaml i 8 = "\xe2\x80\x94\xe2\x80\x94\xc2\xbb" then begin
-
Buffer.add_char result '\t';
-
(* —» = em-dash guillemet *)
-
else if i + 5 <= len && String.sub yaml i 5 = "\xe2\x80\x94\xc2\xbb" then begin
-
Buffer.add_char result '\t';
-
(* » = guillemet alone *)
-
else if i + 2 <= len && String.sub yaml i 2 = "\xc2\xbb" then begin
-
Buffer.add_char result '\t';
-
(* ␣ = open box for trailing space *)
-
else if i + 3 <= len && String.sub yaml i 3 = "\xe2\x90\xa3" then begin
-
Buffer.add_char result ' ';
-
(* ← = leftwards arrow for carriage return *)
-
else if i + 3 <= len && String.sub yaml i 3 = "\xe2\x86\x90" then begin
-
Buffer.add_char result '\r';
-
(* ⇔ = left-right double arrow for BOM *)
-
else if i + 3 <= len && String.sub yaml i 3 = "\xe2\x87\x94" then begin
-
Buffer.add_string result "\xEF\xBB\xBF";
-
(* ↵ = up-down arrow for explicit newline.
-
This represents a newline in the output AND replaces the following actual newline
-
(since each ↵ is on its own line in the test file's yaml field). *)
-
else if i + 3 <= len && String.sub yaml i 3 = "\xe2\x86\xb5" then begin
-
Buffer.add_char result '\n';
-
(* Skip the following newline if present (it's part of the test file structure, not content) *)
-
if next_i < len && yaml.[next_i] = '\n' then
-
(* ∎ = end-of-proof symbol for empty stream *)
-
else if i + 3 <= len && String.sub yaml i 3 = "\xe2\x88\x8e" then begin
-
(* Skip this - it represents an empty file, so we add nothing *)
-
Buffer.add_char result yaml.[i];
-
(* Extract a field value from parsed YAML events *)
-
let extract_mapping_value events key =
-
let rec find_key = function
-
| { Event.event = Event.Scalar { value; _ }; _ } :: rest when value = key ->
-
(* Found the key, now get the value *)
-
| { Event.event = Event.Scalar { value; _ }; _ } :: _ -> Some value
-
| _ :: rest -> find_key rest
-
(* Parse a single test case from a mapping *)
-
let parse_test_case id events =
-
let name = match extract_mapping_value events "name" with
-
let yaml = match extract_mapping_value events "yaml" with
-
| Some y -> convert_test_yaml y
-
let tree = extract_mapping_value events "tree" in
-
let json = extract_mapping_value events "json" in
-
let fail = match extract_mapping_value events "fail" with
-
| _ -> Option.is_some (extract_mapping_value events "error")
-
{ id; name; yaml; tree; json; fail }
-
(* Load tests from a single YAML file *)
-
let id = Filename.chop_extension (Filename.basename path) in
-
let content = read_file path in
-
let parser = Parser.of_string content in
-
let events = Parser.to_list parser in
-
(* File contains a sequence of test cases *)
-
let current_events = ref [] in
-
let in_mapping = ref false in
-
let test_index = ref 0 in
-
List.iter (fun (e : Event.spanned) ->
-
| Event.Mapping_start _ when !depth = 1 ->
-
| Event.Mapping_end when !depth = 2 ->
-
current_events := e :: !current_events;
-
let test_id = if !test_index = 0 then id else Printf.sprintf "%s/%02d" id !test_index in
-
let test = parse_test_case test_id (List.rev !current_events) in
-
if test.yaml <> "" then tests := test :: !tests;
-
| _ when !in_mapping ->
-
current_events := e :: !current_events;
-
| Event.Mapping_start _ | Event.Sequence_start _ -> incr depth
-
| Event.Mapping_end | Event.Sequence_end -> decr depth
-
| Event.Sequence_start _ when !depth = 0 -> depth := 1
-
| Event.Sequence_end when !depth = 1 -> depth := 0
-
let load_directory src_path =
-
let entries = Sys.readdir src_path in
-
Array.iter (fun entry ->
-
if Filename.check_suffix entry ".yaml" then begin
-
let path = Filename.concat src_path entry in
-
let file_tests = load_file path in
-
tests := file_tests @ !tests
-
List.sort (fun a b -> String.compare a.id b.id) !tests
anil.recoil.org