view release on metacpan or  search on metacpan

t/002-scalar.t  view on Meta::CPAN

#!perl -T
# ^^ taint mode must be on for taint checking.
use strict;
use warnings;
use Test::More tests => 72;
use Data::Printer::Object;
use Scalar::Util;

test_basic_values();
test_boolean_values();
test_tainted_values();
test_unicode_string();
test_escape_chars();
test_print_escapes();
test_max_string();
test_weak_ref();
test_readonly();
test_dualvar_lax();
test_dualvar_strict();
test_dualvar_off();

sub test_weak_ref {
    my $num = 3.14;
    my $ref = \$num;
    Scalar::Util::weaken($ref);
    my $ddp = Data::Printer::Object->new( colored => 0 );
    is $ddp->parse($ref), '3.14 (weak)', 'parse() after weaken';
}

sub test_basic_values {
    my $object = Data::Printer::Object->new( colored => 0 );

    # hardcoded values:
    is $object->parse(\undef)  , 'undef (read-only)'  , 'hardcoded undef value';
    is $object->parse(\123)    , '123 (read-only)'    , 'hardcoded integer value';
    is $object->parse(\0)      , '0 (read-only)'      , 'hardcoded integer value';
    is $object->parse(\123.456), '123.456 (read-only)', 'hardcoded floating point value';
    is $object->parse(\'meep!'), '"meep!" (read-only)', 'hardcoded string value';

    # variable values:
    my $var;
    is $object->parse(\$var), 'undef', 'undefined variable';

    $var = undef;
    $object = Data::Printer::Object->new( colored => 0 );
    is $object->parse(\$var), 'undef', 'explicitly undefined variable';

    $object = Data::Printer::Object->new( colored => 0 );
    $var = 0;
    is $object->parse(\$var), '0', 'integer 0 in variable';

    $object = Data::Printer::Object->new( colored => 0 );
    $var = -1;
    is $object->parse(\$var), '-1', 'integer -1 in variable';

    $object = Data::Printer::Object->new( colored => 0 );
    $var = 123;
    is $object->parse(\$var), '123', 'integer 123 in variable';
}

sub test_boolean_values {
    SKIP: {
        skip 'booleans only exist after 5.36', 5 unless $] ge '5.036000';
        my $object = Data::Printer::Object->new( colored => 0 );
        my $var = 1 == 1;
        is $object->parse(\$var), 'true', 'boolean true is "true"';
        $var = 1 == 2;
        is $object->parse(\$var), 'false', 'boolean false is "false"';
        $var = 1;
        is $object->parse(\$var), '1', '1 is 1, not "true"';
        $var = '';
        is $object->parse(\$var), '""', 'empty string is "", not "false"';
        $var = 0;
        is $object->parse(\$var), '0', '0 is 0, not "false"';
    };
}

sub test_tainted_values {
    SKIP: {
        # only use 1 char substring to avoid leaking
        # user information on test results:
        my $tainted = substr $ENV{'PATH'}, 0, 1;
        skip 'Skipping taint test: sample not found.', 2
            => unless Scalar::Util::tainted($tainted);

        my $object = Data::Printer::Object->new( colored => 0 );
        is $object->parse(\$tainted), qq("$tainted" (TAINTED)), 'show tainted scalar';