view release on metacpan or  search on metacpan

t_manual/upstream_test_vectors.t  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;

use Test::More;
use Test::FailWarnings;

my %diagnostic = (
    Infinity => unpack("f>", "\x7f\x80\x00\x00"),
    NaN => unpack("f>", "\x7f\xc0\x00\x00"),
    '-Infinity' => unpack("f>", "\xff\x80\x00\x00"),
    undefined => undef,
);

diag explain \%ENV;

SKIP: {
    skip "Only for interactive testing!" if $ENV{'NONINTERACTIVE_TESTING'};

    my $tests_ar = eval {
        require HTTP::Tiny;
        require JSON;

        my $json = HTTP::Tiny->new()->get('https://raw.githubusercontent.com/cbor/test-vectors/master/appendix_a.json')->{'content'};

        JSON::decode_json($json);
    };

    skip "Failed to download test vectors: $@" if !$tests_ar;

    use_ok('CBOR::Free');

  CBOR_VALUE:
    for my $t (@$tests_ar) {

        # Tagged bignums, which CBOR::Free doesn’t support:
        next if $t->{'hex'} =~ m<\Ac[23]>i;

        # Perl can’t store -(~0).
        next if $t->{'hex'} eq '3bffffffffffffffff';

        # diag $t->{'hex'};

        my $cbor = pack 'H*', $t->{'hex'};

        my $expected;

        if (exists $t->{'decoded'}) {
            $expected = $t->{'decoded'};
        }
        elsif (my $diag = $t->{'diagnostic'}) {
            if (!exists $diagnostic{$diag}) {
                diag "Unknown diagnostic: “$diag”";
                next CBOR_VALUE;
            }

            $expected = $diagnostic{$diag};
        }

        my $decoded = CBOR::Free::decode($cbor);

        is_deeply( $decoded, $expected, "decode: $t->{'hex'}" );

        if ($t->{'roundtrip'}) {
            my $back2cbor = CBOR::Free::encode($expected);
            my $reparsed = CBOR::Free::decode($back2cbor);

            is_deeply(
                $reparsed,
                $expected,