diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index 32cc2cee..067e6abf 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -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 *)