view release on metacpan or  search on metacpan

t/helper_vectors.t  view on Meta::CPAN

        if ($d->{throws}) {
            ok($err, $label) or diag("expected the call to die, got: " . explain_value($got));
            next;
        }
        if ($err) {
            fail($label);
            diag("died unexpectedly: $err");
            next;
        }
        if (_match($got, $case->{expect})) {
            fail("stale divergence declaration for '$key' — the backend now matches JS; remove it");
            next;
        }
        die "divergence '$key' has neither throws nor expect — malformed perl.json entry"
            unless exists $d->{expect};
        ok(_match($got, $d->{expect}), $label)
            or diag('got ' . explain_value($got) . ', pinned ' . explain_value($d->{expect}));
        next;
    }

    if ($err) {
        fail("$key died: $err");
        next;
    }
    ok(_match($got, $case->{expect}), "$key")
        or diag('got ' . explain_value($got) . ', want ' . explain_value($case->{expect}));
}

for my $key (keys %DIVERGENCES) {
    fail("divergence declaration '$key' matches no vector case — renamed note?")
        unless $seen_declarations{$key};
}

done_testing;

# Spec value-compat contract: numbers compare numerically (JSON::PP
# decodes vector numbers to IV/NV, `==` compares the values), booleans
# by truthiness, everything else structurally. Arrays currently go
# through is_deeply (string compare per element) — refine to a
# recursive numeric walk when the first float-array vector lands.
# Production Perl template data has no boolean type — the adapters pass
# 1/0 where JS has true/false — so JSON::PP boolean objects in vector
# ARGS are lowered to 1/0 before reaching a binding. Expects keep their
# boolean identity (vector_ok compares those by truthiness).
sub normalize_arg {
    my ($v) = @_;
    return [ map { normalize_arg($_) } @$v ] if ref $v eq 'ARRAY';
    return { map { $_ => normalize_arg($v->{$_}) } keys %$v } if ref $v eq 'HASH';
    return JSON::PP::is_bool($v) ? ($v ? 1 : 0) : $v;
}

# _match: boolean form of the spec's value-compat comparison against a
# JSON-decoded expect — sentinel hashes, booleans by truthiness,
# numbers numerically, arrays/hashes recursively.
sub _match {
    my ($got, $expect) = @_;
    return !defined $got if !defined $expect;
    if (ref $expect eq 'HASH' && exists $expect->{'$num'}) {
        my $kind = $expect->{'$num'};
        return 0 unless defined $got && looks_like_number($got);
        return $got != $got ? 1 : 0 if $kind eq 'NaN';
        my $inf = 9**9**9;
        return $got == ($kind eq 'Infinity' ? $inf : -$inf) ? 1 : 0;
    }
    if (JSON::PP::is_bool($expect)) {
        return (!!$got eq !!$expect) ? 1 : 0;
    }
    if (ref $expect eq 'ARRAY') {
        return 0 unless ref $got eq 'ARRAY' && @$got == @$expect;
        _match($got->[$_], $expect->[$_]) or return 0 for 0 .. $#$expect;
        return 1;
    }
    if (ref $expect eq 'HASH') {
        return 0 unless ref $got eq 'HASH' && keys %$got == keys %$expect;
        for my $k (keys %$expect) {
            return 0 unless exists $got->{$k};
            _match($got->{$k}, $expect->{$k}) or return 0;
        }
        return 1;
    }
    return 0 if !defined $got || ref $got;
    return ($got == $expect ? 1 : 0) if looks_like_number($expect) && looks_like_number($got);
    return ($got eq $expect) ? 1 : 0;
}

sub explain_value {
    my ($v) = @_;
    return 'undef' unless defined $v;
    return JSON::PP->new->canonical->allow_nonref->allow_blessed->convert_blessed->encode($v)
        if ref $v;
    return "'$v'";
}