|
| 1 | +(* SPDX-License-Identifier: PMPL-1.0-or-later *) |
| 2 | +(* SPDX-FileCopyrightText: 2025 hyperpolymath *) |
| 3 | + |
| 4 | +(** STAGE-A closers (affinescript#128): |
| 5 | +
|
| 6 | + - #136: stdlib-wide AOT compile-smoke gate — every [stdlib/*.affine] |
| 7 | + driven through resolve -> typecheck -> borrow -> codegen |
| 8 | + (Deno-ESM), so the AOT path cannot silently rot again. |
| 9 | + - #137: a multi-module integration program that [use]s several |
| 10 | + stdlib modules together in one compiled unit, proving cross-module |
| 11 | + resolution/typecheck/codegen works as a coherent set. *) |
| 12 | + |
| 13 | +open Affinescript |
| 14 | + |
| 15 | +(* Locate the stdlib directory from the test's runtime cwd |
| 16 | + (`_build/default/test`). The `(source_tree ../stdlib)` dep |
| 17 | + materialises it; fall back to a couple of plausible roots. *) |
| 18 | +let stdlib_dir = |
| 19 | + let candidates = |
| 20 | + (match Sys.getenv_opt "AFFINESCRIPT_STDLIB" with |
| 21 | + | Some d -> [ d ] | None -> []) |
| 22 | + @ [ "../stdlib"; "stdlib"; "../../stdlib" ] |
| 23 | + in |
| 24 | + match |
| 25 | + List.find_opt |
| 26 | + (fun d -> Sys.file_exists (Filename.concat d "prelude.affine")) |
| 27 | + candidates |
| 28 | + with |
| 29 | + | Some d -> d |
| 30 | + | None -> failwith "test_stdlib_aot: cannot locate stdlib/ (no prelude.affine)" |
| 31 | + |
| 32 | +let loader () = |
| 33 | + let cfg = |
| 34 | + { (Module_loader.default_config ()) with |
| 35 | + Module_loader.stdlib_path = stdlib_dir } |
| 36 | + in |
| 37 | + Module_loader.create cfg |
| 38 | + |
| 39 | +(** Full AOT pipeline: resolve -> typecheck -> borrow -> Deno-ESM codegen. |
| 40 | + Returns [Ok js] (the emitted ES-module source) or [Error stage-msg]. *) |
| 41 | +let pipeline_to_deno (prog : Ast.program) : (string, string) result = |
| 42 | + let ld = loader () in |
| 43 | + match Resolve.resolve_program_with_loader prog ld with |
| 44 | + | Error (e, sp) -> |
| 45 | + Error (Printf.sprintf "resolve: %s @ %s" |
| 46 | + (Resolve.show_resolve_error e) (Span.show sp)) |
| 47 | + | Ok (rctx, itc) -> |
| 48 | + (match |
| 49 | + Typecheck.check_program |
| 50 | + ~import_types:itc.Typecheck.name_types rctx.symbols prog |
| 51 | + with |
| 52 | + | Error e -> |
| 53 | + Error (Printf.sprintf "typecheck: %s" (Typecheck.format_type_error e)) |
| 54 | + | Ok _ -> |
| 55 | + (match Borrow.check_program rctx.symbols prog with |
| 56 | + | Error e -> |
| 57 | + Error (Printf.sprintf "borrow: %s" (Borrow.format_borrow_error e)) |
| 58 | + | Ok () -> |
| 59 | + let flat = Module_loader.flatten_imports ld prog in |
| 60 | + (match Codegen_deno.codegen_deno flat rctx.symbols with |
| 61 | + | Error e -> Error (Printf.sprintf "deno-codegen: %s" e) |
| 62 | + | Ok js -> Ok js))) |
| 63 | + |
| 64 | +let parse_file_safe path = |
| 65 | + try Ok (Parse_driver.parse_file path) |
| 66 | + with |
| 67 | + | Parse_driver.Parse_error (msg, span) -> |
| 68 | + Error (Printf.sprintf "parse: %s @ %s" msg (Span.show span)) |
| 69 | + | e -> Error (Printf.sprintf "parse: %s" (Printexc.to_string e)) |
| 70 | + |
| 71 | +(* ---- #136: stdlib-wide AOT compile-smoke gate -------------------------- *) |
| 72 | + |
| 73 | +let stdlib_files () = |
| 74 | + Sys.readdir stdlib_dir |
| 75 | + |> Array.to_list |
| 76 | + |> List.filter (fun f -> Filename.check_suffix f ".affine") |
| 77 | + |> List.sort compare |
| 78 | + |> List.map (fun f -> Filename.concat stdlib_dir f) |
| 79 | + |
| 80 | +let check_one path () = |
| 81 | + let result = |
| 82 | + match parse_file_safe path with |
| 83 | + | Error m -> Error m |
| 84 | + | Ok prog -> pipeline_to_deno prog |
| 85 | + in |
| 86 | + match result with |
| 87 | + | Ok js -> |
| 88 | + Alcotest.(check bool) |
| 89 | + (Printf.sprintf "%s emits a non-empty ES module" (Filename.basename path)) |
| 90 | + true (String.length js > 0) |
| 91 | + | Error m -> |
| 92 | + Alcotest.failf "AOT pipeline failed for %s: %s" |
| 93 | + (Filename.basename path) m |
| 94 | + |
| 95 | +let aot_smoke_tests = |
| 96 | + List.map |
| 97 | + (fun path -> |
| 98 | + Alcotest.test_case |
| 99 | + (Printf.sprintf "AOT %s" (Filename.basename path)) |
| 100 | + `Quick (check_one path)) |
| 101 | + (stdlib_files ()) |
| 102 | + |
| 103 | +(* ---- #137: multi-module integration ----------------------------------- *) |
| 104 | + |
| 105 | +(* One compiled program that pulls in several stdlib modules together and |
| 106 | + actually uses a symbol from each, exercising cross-module |
| 107 | + resolution/typecheck/codegen as a coherent set (not file-by-file). *) |
| 108 | +let integration_src = {| |
| 109 | +use prelude::{ Option, Some, None }; |
| 110 | +use string::{ split, join }; |
| 111 | +use option::{ unwrap_or }; |
| 112 | +use collections::{ reverse }; |
| 113 | + |
| 114 | +fn pipeline(csv: String) -> String { |
| 115 | + let parts = split(csv, ","); |
| 116 | + let flipped = reverse(parts); |
| 117 | + join(flipped, "-") |
| 118 | +} |
| 119 | + |
| 120 | +fn first_or(xs: [String], dflt: String) -> String { |
| 121 | + let head: Option<String> = if len(xs) > 0 { Some(xs[0]) } else { None }; |
| 122 | + unwrap_or(head, dflt) |
| 123 | +} |
| 124 | +|} |
| 125 | + |
| 126 | +let test_multi_module_integration () = |
| 127 | + match Parse_driver.parse_string ~file:"<integration>" integration_src with |
| 128 | + | exception e -> |
| 129 | + Alcotest.failf "integration parse raised: %s" (Printexc.to_string e) |
| 130 | + | prog -> |
| 131 | + (match pipeline_to_deno prog with |
| 132 | + | Ok js -> |
| 133 | + Alcotest.(check bool) |
| 134 | + "multi-module program compiles to a non-empty ES module" |
| 135 | + true (String.length js > 0) |
| 136 | + | Error m -> |
| 137 | + Alcotest.failf "multi-module integration failed: %s" m) |
| 138 | + |
| 139 | +let integration_tests = |
| 140 | + [ Alcotest.test_case "string+option+collections together" `Quick |
| 141 | + test_multi_module_integration ] |
| 142 | + |
| 143 | +let tests = |
| 144 | + [ ("STAGE-A AOT smoke (#136)", aot_smoke_tests); |
| 145 | + ("STAGE-A multi-module integration (#137)", integration_tests) ] |
0 commit comments