@voxgig/sdkgen 4.8.2 → 4.9.0

package/project/.sdk/tm/ocaml/test/corpus_runner.ml

@@ -1,185 +0,0 @@
-(* Shared corpus harness for the ProjectName SDK.
- *
- * Extracted from struct_corpus.ml so the primary-utility suite can drive the
- * SAME runner over test.json's "primary" section. OCaml runs a module's
- * top-level effects on link, so a harness sitting beside a `let () = ...` main
- * cannot be reused — linking it would run the struct corpus as a side effect.
- * This module deliberately has no main.
- *)
-
-(* Test runner for the shared JSON corpus (build/test/test.json).
- * Self-contained: an in-tree JSON reader builds the library's `value` type
- * directly, so the OCaml port is exercised exactly as in production. *)
-
-open Voxgig_struct
-
-let nullmark = "__NULL__"
-let undefmark = "__UNDEF__"
-let existsmark = "__EXISTS__"
-
-(* The JSON reader now lives in the runtime (sdk_json.ml) so the SDK's
- * generated config can use it; the corpus runs against that same function
- * rather than a second copy that could drift from it. *)
-let json_read = Sdk_json.json_read
-
-(* ---------------- fixJSON / equality ---------------- *)
-
-let rec fix_json v flag_null =
-  match v with
-  | Noval | Null -> if flag_null then Str nullmark else v
-  | Map m -> let o = empty_map () in
-    List.iter (fun (k, x) -> ignore (setprop o (Str k) (fix_json x flag_null))) m.entries; o
-  | List r -> lst (List.map (fun x -> fix_json x flag_null) !r)
-  | _ -> v
-
-(* Order-independent deep equality for maps; sequence equality for lists. *)
-let rec eqv a b =
-  match a, b with
-  | (Noval | Null), (Noval | Null) -> true
-  | Bool x, Bool y -> x = y
-  | Num x, Num y -> x = y
-  | Str x, Str y -> x = y
-  | List x, List y -> List.length !x = List.length !y && List.for_all2 eqv !x !y
-  | Map x, Map y ->
-    omap_len x = omap_len y &&
-    List.for_all (fun (k, v) -> match omap_get y k with Some w -> eqv v w | None -> false) x.entries
-  | _ -> a == b
-
-(* ---------------- match support ---------------- *)
-
-let matchval check base =
-  let check = if check = Str undefmark || check = Str nullmark then Noval else check in
-  if eqv check base then true
-  else match check with
-    | Str cs ->
-      let basestr = stringify base in
-      if String.length cs >= 2 && cs.[0] = '/' && cs.[String.length cs - 1] = '/' then
-        Vregex.test_str (String.sub cs 1 (String.length cs - 2)) basestr
-      else
-        let low s = String.lowercase_ascii s in
-        let contains hay needle =
-          let hl = String.length hay and nl = String.length needle in
-          let rec go i = if i + nl > hl then false
-            else if String.sub hay i nl = needle then true else go (i + 1) in
-          nl = 0 || go 0 in
-        contains (low basestr) (low (stringify check))
-    | Func _ -> true
-    | _ -> false
-
-let do_match check base =
-  let base = clone base in
-  ignore (walk ~before:(fun _k v _p path ->
-      (if not (isnode v) then begin
-          let baseval = getpath base path in
-          if eqv baseval v then ()
-          else if v = Str undefmark && is_nullish baseval then ()
-          else if v = Str existsmark && not (is_nullish baseval) then ()
-          else if not (matchval v baseval) then
-            raise (Struct_error (Printf.sprintf "MATCH: %s: [%s] <=> [%s]"
-                                   (String.concat "." (List.map js_string (match path with List r -> !r | _ -> [])))
-                                   (stringify v) (stringify baseval)))
-        end);
-      v) check)
-
-(* ---------------- result tracking ---------------- *)
-
-let npass = ref 0
-let nfail = ref 0
-let failures = ref []
-
-let record group name ok msg =
-  if ok then incr npass
-  else (incr nfail; failures := Printf.sprintf "FAIL %s %s - %s" group name msg :: !failures)
-
-(* ---------------- per-entry runner ---------------- *)
-
-let omap_v kvs =
-  let m = empty_map () in
-  List.iter (fun (k, v) -> ignore (setprop m (Str k) v)) kvs; m
-
-let getprop_raw_pub e k = (match e with Map m -> (match omap_get m k with Some x -> x | None -> Noval) | _ -> Noval)
-let entry_get e k = getprop_raw_pub e k
-let entry_has e k = match e with Map m -> omap_has m k | _ -> false
-let default_injdef_pub () =
-  { d_meta = Noval; d_extra = Noval; d_errs = Noval; d_modify = None; d_handler = None;
-    d_base = Noval; d_dparent = Noval; d_dpath = Noval; d_key = Noval }
-
-let resolve_args entry =
-  if entry_has entry "ctx" then [entry_get entry "ctx"]
-  else if entry_has entry "args" then (
-    match entry_get entry "args" with
-    | List r ->
-      (* ts's resolveArgs writes the live first arg back as entry.ctx, so a
-         `match: {ctx: ...}` resolves for args-style entries too. Without it
-         every such assertion reads null and asserts nothing. *)
-      (match !r with
-       | (Map _ as first) :: _ -> ignore (setprop entry (Str "ctx") first)
-       | _ -> ());
-      !r
-    | _ -> [])
-  else if entry_has entry "in" then [clone (entry_get entry "in")]
-  else [Noval]
-
-let check_result entry args res =
-  let matched = ref false in
-  (if entry_has entry "match" then begin
-      do_match (entry_get entry "match")
-        (omap_v ["in", entry_get entry "in"; "args", lst args;
-                 "out", entry_get entry "res"; "ctx", entry_get entry "ctx"]);
-      matched := true
-    end);
-  let out = entry_get entry "out" in
-  if eqv out res then ()
-  else if !matched && (out = Str nullmark || is_nullish out) then ()
-  else raise (Struct_error (Printf.sprintf "Expected: %s, got: %s" (stringify out) (stringify res)))
-
-let handle_error entry err =
-  let msg = (match err with Struct_error m -> m | e -> Printexc.to_string e) in
-  if entry_has entry "err" then begin
-    let entry_err = entry_get entry "err" in
-    if entry_err = Bool true || matchval entry_err (Str msg) then begin
-      if entry_has entry "match" then
-        do_match (entry_get entry "match")
-          (omap_v ["in", entry_get entry "in"; "out", entry_get entry "res";
-                   (* ts hands do_match the ERROR OBJECT, so a corpus
-                      `match: {err: {message: ...}}` resolves; a bare string
-                      leaves err.message reading null. *)
-                   "ctx", entry_get entry "ctx";
-                   "err", omap_v ["message", Str msg]])
-    end else
-      raise (Struct_error (Printf.sprintf "ERROR MATCH: [%s] <=> [%s]" (stringify entry_err) msg))
-  end else raise err
-
-let run_set ?(flags = []) group node subject =
-  let flag_null = (match List.assoc_opt "null" flags with Some b -> b | None -> true) in
-  let fixed = fix_json node flag_null in
-  let testset = (match getprop fixed (Str "set") with List r -> !r | _ -> []) in
-  List.iter (fun entry ->
-      let name = js_string (entry_get entry "name") in
-      try
-        (if not (entry_has entry "out") && flag_null then ignore (setprop entry (Str "out") (Str nullmark)));
-        let args = resolve_args entry in
-        let res = fix_json (subject args) flag_null in
-        ignore (setprop entry (Str "res") res);
-        check_result entry args res;
-        record group name true ""
-      with
-      | e ->
-        (try handle_error entry e; record group name true ""
-         with e2 -> record group name false
-                      (match e2 with Struct_error m -> m | _ -> Printexc.to_string e2)))
-    testset
-
-let run_single group node actual_fn =
-  try
-    let expected = getprop_raw_pub node "out" in
-    let actual = actual_fn (getprop_raw_pub node "in") in
-    if eqv expected actual then record group "single" true ""
-    else record group "single" false (Printf.sprintf "Expected: %s, got: %s" (stringify expected) (stringify actual))
-  with e -> record group "single" false (match e with Struct_error m -> m | _ -> Printexc.to_string e)
-
-(* ---------------- arg helpers ---------------- *)
-
-let arg1 f = fun args -> f (match args with x :: _ -> x | [] -> Noval)
-let vget vin k = match vin with Map m -> (match omap_get m k with Some x -> x | None -> Noval) | _ -> Noval
-let vhas vin k = match vin with Map m -> omap_has m k | _ -> false

package/project/.sdk/tm/perl/t/struct_runner.pm

@@ -1,275 +0,0 @@
-# Vendored from voxgig/struct/perl (adapted).
-# Test runner that uses the test model in .sdk/test - mirrors the rb
-# struct_runner make_runner protocol on top of the perl struct port.
-
-use strict;
-use warnings;
-
-use File::Basename ();
-use Cwd ();
-use Scalar::Util ();
-
-my $__dir;
-BEGIN { $__dir = File::Basename::dirname(Cwd::abs_path(__FILE__)) }
-require(Cwd::abs_path("$__dir/../lib/Voxgig/Struct.pm"));
-require(Cwd::abs_path("$__dir/../core/helpers.pm"));
-
-package StructRunner;
-
-our $NULLMARK = '__NULL__';   # Represents a JSON null in tests
-our $UNDEFMARK = '__UNDEF__'; # Represents an undefined value
-
-# Canonical comparison string: sorted-key JSON so key order is ignored
-# (matches node's deepStrictEqual over the corpus).
-sub canon {
-  my ($v) = @_;
-  return Voxgig::Struct::_stringify_inner($v, 1);
-}
-
-# make_runner($testfile, $client)
-# Returns a sub that accepts a name (e.g. "struct") and an optional store,
-# and returns a hash (runpack) with:
-#   spec        -> the extracted spec for that name,
-#   runset      -> a sub to run a test set without extra flags,
-#   runsetflags -> a sub to run a test set with flags,
-#   subject     -> the function (from the client utility) under test,
-#   client      -> the client instance.
-sub make_runner {
-  my ($testfile, $client) = @_;
-  return sub {
-    my ($name, $store) = @_;
-    $store = {} unless defined $store;
-
-    my $utility = $client->utility;
-    my $struct_utils = $utility->{struct};
-
-    my $spec = resolve_spec($name, $testfile);
-    my $clients = resolve_clients($client, $spec, $store, $struct_utils);
-    my $subject = resolve_subject($name, $utility);
-
-    my $runsetflags = sub {
-      my ($testspec, $flags, $testsubject) = @_;
-      my $use_subject = defined $testsubject ? $testsubject : $subject;
-      $flags = resolve_flags($flags);
-      my $testset = (Voxgig::Struct::ismap($testspec) && $testspec->{set}) || [];
-      my $idx = 0;
-      for my $entry (@{ Voxgig::Struct::islist($testset) ? $testset : [] }) {
-        next unless Voxgig::Struct::ismap($entry);
-        my $this_subject = $use_subject;
-        if (exists $entry->{client} && defined $clients->{ $entry->{client} }) {
-          my $cutil = $clients->{ $entry->{client} }->utility;
-          $this_subject = resolve_subject($name, $cutil);
-        }
-        my @args = resolve_args($entry);
-        my $got = eval { $this_subject->(@args) };
-        my $err = $@;
-        check_entry($name, $idx, $entry, $got, $err);
-        $idx++;
-      }
-    };
-
-    my $runset = sub {
-      my ($testspec, $testsubject) = @_;
-      $runsetflags->($testspec, {}, $testsubject);
-    };
-
-    return {
-      spec => $spec,
-      runset => $runset,
-      runsetflags => $runsetflags,
-      subject => $subject,
-      client => $client,
-    };
-  };
-}
-
-# Loads the test JSON file and extracts the spec for the given name.
-# Follows the pattern: alltests.primary?[name] || alltests[name] || alltests.
-sub resolve_spec {
-  my ($name, $testfile) = @_;
-  my $text = do {
-    open my $fh, '<:raw', $testfile or die "Cannot open $testfile: $!";
-    local $/;
-    <$fh>;
-  };
-  my $all_tests = Voxgig::Struct::parse_json($text);
-  if (Voxgig::Struct::ismap($all_tests->{primary})
-    && Voxgig::Struct::ismap($all_tests->{primary}{$name})) {
-    return $all_tests->{primary}{$name};
-  }
-  return $all_tests->{$name} if Voxgig::Struct::ismap($all_tests->{$name});
-  return $all_tests;
-}
-
-# If the spec contains a DEF section with client definitions, resolve them.
-sub resolve_clients {
-  my ($client, $spec, $store, $struct_utils) = @_;
-  my $clients = {};
-  my $defs = Voxgig::Struct::ismap($spec) ? $spec->{DEF} : undef;
-  if (Voxgig::Struct::ismap($defs) && Voxgig::Struct::ismap($defs->{client})) {
-    for my $cn (keys %{ $defs->{client} }) {
-      my $cdef = $defs->{client}{$cn};
-      my $copts = (Voxgig::Struct::ismap($cdef->{test})
-        && Voxgig::Struct::ismap($cdef->{test}{options}))
-        ? $cdef->{test}{options} : {};
-      $clients->{$cn} = $client->test($copts);
-    }
-  }
-  return $clients;
-}
-
-# Returns the subject under test: the named entry of the utility map.
-sub resolve_subject {
-  my ($name, $container, $subject) = @_;
-  return $subject if defined $subject;
-  return undef unless defined $container;
-  return $container->{$name} if ref($container) eq 'HASH'
-    || (Scalar::Util::reftype($container) // '') eq 'HASH';
-  return undef;
-}
-
-# Ensure flags is a hash and set "null" flag to 1 if not provided.
-sub resolve_flags {
-  my ($flags) = @_;
-  $flags = {} unless defined $flags && ref $flags;
-  $flags->{null} = 1 unless exists $flags->{null};
-  return $flags;
-}
-
-# By default pass a clone of entry.in; entry.ctx / entry.args override.
-sub resolve_args {
-  my ($entry) = @_;
-  my @args;
-  if (exists $entry->{ctx}) {
-    @args = ($entry->{ctx});
-  }
-  elsif (exists $entry->{args}) {
-    my $a = $entry->{args};
-    @args = Voxgig::Struct::islist($a) ? @$a : ($a);
-  }
-  elsif (exists $entry->{in}) {
-    @args = (Voxgig::Struct::clone($entry->{in}), $entry);
-  }
-  else {
-    @args = (undef, $entry);
-  }
-  return @args;
-}
-
-# Compare the run outcome against the entry (out / err / match).
-sub check_entry {
-  my ($label_base, $idx, $entry, $got, $err) = @_;
-  my $label = "$label_base#$idx";
-  my $err_field = $entry->{err};
-
-  if (defined $err_field) {
-    # An error is expected: the subject must throw, and (unless err is
-    # literally true) the thrown message must contain the expected
-    # substring or match the /regex/.
-    if (!$err) {
-      die "[$label] expected error but none thrown (err=" . canon($err_field) . ")\n";
-    }
-    my $msg = "$err";
-    my $ok;
-    if (Voxgig::Struct::is_jbool($err_field)) {
-      $ok = $$err_field ? 1 : 0;   # err: true -> any error
-    }
-    elsif (!ref $err_field) {
-      if ($err_field =~ m{^/(.+)/$}s) {
-        my $re = $1;
-        $ok = ($msg =~ /$re/) ? 1 : 0;
-      }
-      else {
-        $ok = (index(lc $msg, lc $err_field) >= 0) ? 1 : 0;
-      }
-    }
-    else {
-      $ok = 1;
-    }
-    die "[$label] ERROR MATCH: [" . canon($err_field) . "] <=> [$msg]\n" unless $ok;
-    return;
-  }
-
-  die "[$label] unexpected error: $err\n" if $err;
-
-  # Optional deep match against { in, out }.
-  if (Voxgig::Struct::ismap($entry->{match})) {
-    my $base = { 'in' => $entry->{in}, 'out' => $got };
-    match($label, $entry->{match}, $base);
-  }
-
-  my $expected = exists $entry->{out} ? $entry->{out} : undef;
-  my $got_j = canon($got);
-  my $exp_j = canon($expected);
-  if ($got_j ne $exp_j) {
-    die "[$label] Mismatch: Expected $exp_j but got $got_j\n";
-  }
-  return;
-}
-
-# Compares scalar values along each path of the check structure against
-# the base.
-sub match {
-  my ($label, $check, $base) = @_;
-  _match_walk($label, $check, $base, []);
-  return;
-}
-
-sub _match_walk {
-  my ($label, $val, $base, $path) = @_;
-  if (Voxgig::Struct::ismap($val)) {
-    for my $k (keys %$val) {
-      _match_walk($label, $val->{$k}, $base, [@$path, $k]);
-    }
-  }
-  elsif (Voxgig::Struct::islist($val)) {
-    for my $i (0 .. $#$val) {
-      _match_walk($label, $val->[$i], $base, [@$path, $i]);
-    }
-  }
-  else {
-    my $baseval = ProjectNameHelpers::gpath($base, [@$path]);
-    return if canon($val) eq canon($baseval);
-    return if defined $val && !ref($val) && $val eq $UNDEFMARK && !defined $baseval;
-    if (matchval($val, $baseval)) {
-      return;
-    }
-    die "[$label] MATCH: " . join('.', @$path) . ' : ['
-      . canon($val) . '] <=> [' . canon($baseval) . "]\n";
-  }
-  return;
-}
-
-sub matchval {
-  my ($check, $base) = @_;
-  return 1 if canon($check) eq canon($base);
-  if (defined $check && !ref $check) {
-    my $basestr = Voxgig::Struct::stringify($base);
-    if ($check =~ m{^/(.+)/$}s) {
-      my $re = $1;
-      return ($basestr =~ /$re/) ? 1 : 0;
-    }
-    return (index(lc $basestr, lc Voxgig::Struct::stringify($check)) >= 0) ? 1 : 0;
-  }
-  return ref $check eq 'CODE' ? 1 : 0;
-}
-
-# StructTestClient is a minimal shim that provides the client interface
-# needed by the struct test runner within the SDK context.
-package StructTestClient;
-
-sub new {
-  my ($class) = @_;
-  return bless {}, $class;
-}
-
-sub utility {
-  return { struct => ProjectNameHelpers::struct_facade() };
-}
-
-sub test {
-  my ($self, $options) = @_;
-  return $self;
-}
-
-1;