Tests: load one-per-file _islands/ dirs with path-derived names
Why: the one-per-file migration leaves `defcomp`/`defisland` unnamed in each file; the test runner now walks `_islands/` recursively and injects a name derived from the relative path (e.g. `geography/cek/_islands/demo-counter.sx` → `~geography/cek/demo-counter`), matching the runtime's path-based naming.
This commit is contained in:
@@ -1367,6 +1367,64 @@ let run_spec_tests env test_files =
|
||||
) exprs
|
||||
in
|
||||
|
||||
(* Path-based name injection for unnamed defcomp/defisland (one-per-file) *)
|
||||
let def_keywords = ["defcomp"; "defisland"; "defmacro"; "define";
|
||||
"defhandler"; "defstyle"; "deftype"; "defeffect";
|
||||
"defrelation"; "deftest"; "defpage"] in
|
||||
let inject_path_name expr path base_dir =
|
||||
match expr with
|
||||
| Sx_types.List (Sx_types.Symbol kw :: rest) when List.mem kw def_keywords ->
|
||||
(match rest with
|
||||
| Sx_types.Symbol _ :: _ -> expr
|
||||
| _ ->
|
||||
let rel = if String.length path > String.length base_dir + 1
|
||||
then String.sub path (String.length base_dir + 1)
|
||||
(String.length path - String.length base_dir - 1)
|
||||
else Filename.basename path in
|
||||
let stem = if Filename.check_suffix rel ".sx"
|
||||
then String.sub rel 0 (String.length rel - 3)
|
||||
else rel in
|
||||
let stem = let parts = String.split_on_char '/' stem in
|
||||
String.concat "/" (List.filter (fun p -> p <> "_islands") parts) in
|
||||
let name = if Filename.basename stem = "index"
|
||||
then let d = Filename.dirname stem in
|
||||
if d = "." then "index" else d
|
||||
else stem in
|
||||
let prefixed = if kw = "defcomp" || kw = "defisland"
|
||||
then "~" ^ name else name in
|
||||
Sx_types.List (Sx_types.Symbol kw :: Sx_types.Symbol prefixed :: rest))
|
||||
| _ -> expr
|
||||
in
|
||||
let load_with_path path base_dir =
|
||||
let ic = open_in path in
|
||||
let n = in_channel_length ic in
|
||||
let s = Bytes.create n in
|
||||
really_input ic s 0 n;
|
||||
close_in ic;
|
||||
let src = Bytes.to_string s in
|
||||
let exprs = parse_all src in
|
||||
List.iter (fun expr ->
|
||||
let expr' = inject_path_name expr path base_dir in
|
||||
try ignore (eval_with_io expr' (Env env))
|
||||
with Sx_types.Eval_error _ -> ()
|
||||
) exprs
|
||||
in
|
||||
let rec load_dir_recursive dir base_dir =
|
||||
if Sys.file_exists dir && Sys.is_directory dir then
|
||||
let entries = Sys.readdir dir in
|
||||
Array.sort compare entries;
|
||||
Array.iter (fun name ->
|
||||
let path = Filename.concat dir name in
|
||||
if Sys.is_directory path then
|
||||
load_dir_recursive path base_dir
|
||||
else if Filename.check_suffix name ".sx" then
|
||||
(try load_with_path path base_dir
|
||||
with e -> Printf.eprintf "Warning: %s: %s\n%!" path (Printexc.to_string e))
|
||||
) entries
|
||||
in
|
||||
let _ = load_dir_recursive in
|
||||
let _ = load_with_path in
|
||||
|
||||
Printf.printf "\nLoading test framework...\n%!";
|
||||
load_and_eval framework_path;
|
||||
|
||||
@@ -2423,6 +2481,15 @@ let run_spec_tests env test_files =
|
||||
load_module "demo.sx" sx_islands_dir;
|
||||
load_module "marshes.sx" sx_islands_dir;
|
||||
load_module "cek.sx" sx_geo_dir;
|
||||
(* Load one-per-file islands from _islands/ directories.
|
||||
The inject_path_name derives ~geography/cek/demo-counter from the file path. *)
|
||||
load_dir_recursive (Filename.concat sx_geo_dir "cek/_islands") sx_sx_dir;
|
||||
let sx_reactive_dir = Filename.concat sx_geo_dir "reactive" in
|
||||
if Sys.file_exists (Filename.concat sx_reactive_dir "_islands") then
|
||||
load_dir_recursive (Filename.concat sx_reactive_dir "_islands") sx_sx_dir;
|
||||
let sx_reactive_runtime_dir = Filename.concat sx_geo_dir "reactive-runtime" in
|
||||
if Sys.file_exists (Filename.concat sx_reactive_runtime_dir "_islands") then
|
||||
load_dir_recursive (Filename.concat sx_reactive_runtime_dir "_islands") sx_geo_dir;
|
||||
load_module "reactive-runtime.sx" sx_sx_dir;
|
||||
|
||||
(* Create short-name aliases for reactive-islands tests *)
|
||||
|
||||
Reference in New Issue
Block a user