view release on metacpan or  search on metacpan

t/encode_modes.t  view on Meta::CPAN

#!/usr/bin/env perl

package t::encode_modes;

use strict;
use warnings;

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

use parent qw( Test::Class::Tiny );

use Data::Dumper;

use CBOR::Free;

use constant xFF => "\xff";
use constant UTF8_00FF => do { utf8::encode( my $v = xFF ); $v };
use constant U_00FF => do { utf8::upgrade( my $v = "\xff"); $v };

use constant UNICODE_A => do { utf8::upgrade( my $v = "A"); $v };
use constant UNICODE_FF => do { utf8::upgrade( my $v = "\xff"); $v };

use constant UTF8_0100 => do { utf8::encode( my $v = "\x{100}" ); $v };

__PACKAGE__->runtests() if !caller;

sub T32_test_given_unchanged {
    for my $canonical ( 0, 1 ) {
        for my $mode ( qw( sv encode_text as_text as_binary ) ) {
            my $v = UTF8_00FF;
            my $utf8_flag = utf8::is_utf8($v);
            CBOR::Free::encode($v, canonical => $canonical, string_encode_mode => $mode);
            is( $v, UTF8_00FF, "$mode: given undecoded scalar is unchanged" );
            is( utf8::is_utf8($v), $utf8_flag, "$mode: undecoded scalar internals are unchanged (canonical: $canonical)" );

            utf8::decode($v);
            my $v_copy = $v;
            $utf8_flag = utf8::is_utf8($v);
            CBOR::Free::encode($v, canonical => $canonical, string_encode_mode => $mode);
            is( $v, $v_copy, "$mode: given decoded scalar is unchanged" );
            is( utf8::is_utf8($v), $utf8_flag, "$mode: decoded scalar internals are unchanged (canonical: $canonical)" );
        }
    }
}

sub T4_test_sv_hash_key {
    my $the_key = (sort keys %!)[0];

    my $key_cbor_text = CBOR::Free::encode($the_key, string_encode_mode => 'as_text');
    my $key_cbor_binary = CBOR::Free::encode($the_key, string_encode_mode => 'as_binary');

    my $cbor_plain = CBOR::Free::encode(\%!);

    cmp_ok(
        index($cbor_plain, $key_cbor_binary),
        '>',
        '-1',
        'encode() with %!',
    );

    my $cbor_encode = CBOR::Free::encode(\%!, string_encode_mode => 'encode_text');

    cmp_ok(
        index($cbor_encode, $key_cbor_text),
        '>',
        '-1',
        'encode() with %! (encode_text)',
    );

    my $cbor_as_text = CBOR::Free::encode(\%!, string_encode_mode => 'as_text');

    cmp_ok(
        index($cbor_as_text, $key_cbor_text),
        '>',
        '-1',
        'encode() with %! (as_text)',
    );

    my $cbor_as_binary = CBOR::Free::encode(\%!, string_encode_mode => 'as_binary');

    cmp_ok(
        index($cbor_as_binary, $key_cbor_binary),
        '>',
        '-1',
        'encode() with %! (as_binary)',
    );

    return;
}

sub T18_test_encode_text {
    my @t = (
        [
            "\x{100}",
            "\x62" . UTF8_0100,
            'SvUTF8, wide character',
        ],
        [
            do { utf8::decode( my $v = xFF() ); $v },
            "\x62" . UTF8_00FF,
            'SvUTF8',