view release on metacpan or  search on metacpan

t/binary-load.t  view on Meta::CPAN

isa_ok( $ret, "Data::Plist" );
is_deeply( $ret->raw_data => [ null => 0 ], "Has a null" );

### Trailer

# Invalid offset sizes
$ret = eval {
    $read->open_string(
        "bplist00" . pack( "Cnx6CC(x4N)3", 0, 8, 5, 1, 1, 0, 9 ) );
};
ok( not($ret), "Invalid offset" );
like( "$@", qr/invalid offset/i, "Threw an error" );

$ret = eval {
    $read->open_string(
        "bplist00" . pack( "Cnx6CC(x4N)3", 0, 8, 0, 1, 1, 0, 9 ) );
};
ok( not($ret), "Invalid offset" );
like( "$@", qr/invalid offset/i, "Threw an error" );

# Invalid refsize
$ret = eval {
    $read->open_string(
        "bplist00" . pack( "Cnx6CC(x4N)3", 0, 8, 2, 3, 1, 0, 9 ) );
};
ok( not($ret), "Invalid refsize" );
like( "$@", qr/invalid reference/i, "Threw an error" );

$ret = eval {
    $read->open_string(
        "bplist00" . pack( "Cnx6CC(x4N)3", 0, 8, 2, 0, 1, 0, 9 ) );
};
ok( not($ret), "Invalid refsize" );
like( "$@", qr/invalid reference/i, "Threw an error" );

# Invalid top object index
$ret = eval {
    $read->open_string(
        "bplist00" . pack( "Cnx6CC(x4N)3", 0, 8, 2, 1, 1, 1, 9 ) );
};
ok( not($ret), "Invalid top object id" );
like( "$@", qr/invalid top/i, "Threw an error" );

# Invalid offset table address
$ret = eval {
    $read->open_string(
        "bplist00" . pack( "Cnx6CC(x4N)3", 0, 8, 2, 1, 2, 0, 9 ) );
};
ok( not($ret), "Invalid offset table address" );
like( "$@", qr/invalid offset/i, "Threw an error" );

$ret = eval {
    $read->open_string(
        "bplist00" . pack( "CCx6CC(x4N)3", 0, 8, 1, 1, 1, 0, 7 ) );
};
ok( not($ret), "Invalid offset table address" );
like( "$@", qr/invalid offset table/i, "Threw an error" );

# Refsize is too small for NumObjects
my $string
    = do { local @ARGV = "t/data/longfile-03.binary.plist"; local $/; <> };
ok( $string, "Read from file." );
use bytes;
substr( $string, -25, 1, "\x01" );
$ret = eval { $read->open_string($string) };
ok( not($ret), "Refsize is too small for NumObjects." );
like( "$@", qr/purported number/, "Threw an error" );

### More complex testing

# Load from a file
$ret = $read->open_file("t/data/basic.binary.plist");
ok( $ret, "Got a value from open with a filename" );
isa_ok( $ret, "Data::Plist" );
ok( $ret->raw_data, "Has data inside" );

# Bad file
$ret = eval { $read->open_file("t/data/bad.binary.plist") };
ok( not($ret), "Not bplist doesn't load" );
like( "$@", qr/not a binary plist/i, "Threw an error" );

# ustring
$ret = $read->open_file("t/data/ustring.binary.plist");
ok( $ret, "Got a value from open with a filename" );
isa_ok( $ret, "Data::Plist" );
ok( $ret->raw_data, "Has data inside" );

# Load from fh
my $fh;
open( $fh, "<", "t/data/basic.binary.plist" );
$ret = $read->open_fh($fh);
ok( $ret, "Opening from a fh worked" );
isa_ok( $ret, "Data::Plist" );
ok( $ret->raw_data, "Has data inside" );

# Load from string
my $str = do { local @ARGV = "t/data/basic.binary.plist"; local $/; <> };
ok( $str, "Read binary data in by hand" );
$ret = $read->open_string($str);
ok( $ret, "Opening from a string worked" );
isa_ok( $ret, "Data::Plist" );
ok( $ret->raw_data, "Has data inside" );

# Test raw structure
is_deeply(
    $ret->raw_data,
    [   dict => {
            a => [
                array => [
                    [ integer => 1 ],
                    [ integer => 2 ],
                    [   dict => {
                            foo  => [ string => "bar" ],
                            baz  => [ string => "troz" ],
                            zort => [ string => '$null' ],
                        }
                    ]
                ]
            ]
        }
    ],
    "Raw structure matches",
);

# Data contains bplist
my $bplist = $write->write( {} );
my $in = $write->write( { "test" => $bplist } );
ok( $in, "Binary data written." );
$ret = $read->open_string($in);
ok( $ret, "Opening from string worked" );