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
|
) exprs
|
||||||
in
|
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%!";
|
Printf.printf "\nLoading test framework...\n%!";
|
||||||
load_and_eval framework_path;
|
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 "demo.sx" sx_islands_dir;
|
||||||
load_module "marshes.sx" sx_islands_dir;
|
load_module "marshes.sx" sx_islands_dir;
|
||||||
load_module "cek.sx" sx_geo_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;
|
load_module "reactive-runtime.sx" sx_sx_dir;
|
||||||
|
|
||||||
(* Create short-name aliases for reactive-islands tests *)
|
(* Create short-name aliases for reactive-islands tests *)
|
||||||
|
|||||||
Reference in New Issue
Block a user