|
Packit |
37d9e7 |
#!/usr/bin/perl
|
|
Packit |
37d9e7 |
|
|
Packit |
37d9e7 |
use strict;
|
|
Packit |
37d9e7 |
BEGIN {
|
|
Packit |
37d9e7 |
$| = 1;
|
|
Packit |
37d9e7 |
$^W = 1;
|
|
Packit |
37d9e7 |
$ENV{PERL_PARAMS_UTIL_PP} ||= 0;
|
|
Packit |
37d9e7 |
}
|
|
Packit |
37d9e7 |
|
|
Packit |
37d9e7 |
use Test::More tests => 44;
|
|
Packit |
37d9e7 |
use Scalar::Util 'refaddr';
|
|
Packit |
37d9e7 |
use File::Spec::Functions ':ALL';
|
|
Packit |
37d9e7 |
use Params::Util qw{_ARRAYLIKE _HASHLIKE};
|
|
Packit |
37d9e7 |
|
|
Packit |
37d9e7 |
# Tests that two objects are the same object
|
|
Packit |
37d9e7 |
sub addr {
|
|
Packit |
37d9e7 |
my $have = shift;
|
|
Packit |
37d9e7 |
my $want = shift;
|
|
Packit |
37d9e7 |
is( refaddr($have), refaddr($want), 'Objects are the same object' );
|
|
Packit |
37d9e7 |
}
|
|
Packit |
37d9e7 |
|
|
Packit |
37d9e7 |
my $listS = bless \do { my $i } => 'Foo::Listy';
|
|
Packit |
37d9e7 |
my $hashS = bless \do { my $i } => 'Foo::Hashy';
|
|
Packit |
37d9e7 |
my $bothS = bless \do { my $i } => 'Foo::Bothy';
|
|
Packit |
37d9e7 |
|
|
Packit |
37d9e7 |
my $listH = bless {} => 'Foo::Listy';
|
|
Packit |
37d9e7 |
my $hashH = bless {} => 'Foo::Hashy';
|
|
Packit |
37d9e7 |
my $bothH = bless {} => 'Foo::Bothy';
|
|
Packit |
37d9e7 |
|
|
Packit |
37d9e7 |
my $listA = bless [] => 'Foo::Listy';
|
|
Packit |
37d9e7 |
my $hashA = bless [] => 'Foo::Hashy';
|
|
Packit |
37d9e7 |
my $bothA = bless [] => 'Foo::Bothy';
|
|
Packit |
37d9e7 |
|
|
Packit |
37d9e7 |
my @data = (# A H
|
|
Packit |
37d9e7 |
[ undef , 0, 0, 'undef' ],
|
|
Packit |
37d9e7 |
[ 1000 => 0, 0, '1000' ],
|
|
Packit |
37d9e7 |
[ 'Foo' => 0, 0, '"Foo"' ],
|
|
Packit |
37d9e7 |
[ [] => 1, 0, '[]' ],
|
|
Packit |
37d9e7 |
[ {} => 0, 1, '{}' ],
|
|
Packit |
37d9e7 |
[ $listS => 1, 0, 'scalar-based Foo::Listy' ],
|
|
Packit |
37d9e7 |
[ $hashS => 0, 1, 'scalar-based Foo::Hashy' ],
|
|
Packit |
37d9e7 |
[ $bothS => 1, 1, 'scalar-based Foo::Bothy' ],
|
|
Packit |
37d9e7 |
[ $listH => 1, 1, 'hash-based Foo::Listy' ],
|
|
Packit |
37d9e7 |
[ $hashH => 0, 1, 'hash-based Foo::Hashy' ],
|
|
Packit |
37d9e7 |
[ $bothH => 1, 1, 'hash-based Foo::Bothy' ],
|
|
Packit |
37d9e7 |
[ $listA => 1, 0, 'array-based Foo::Listy' ],
|
|
Packit |
37d9e7 |
[ $hashA => 1, 1, 'array-based Foo::Hashy' ],
|
|
Packit |
37d9e7 |
[ $bothA => 1, 1, 'array-based Foo::Bothy' ],
|
|
Packit |
37d9e7 |
);
|
|
Packit |
37d9e7 |
|
|
Packit |
37d9e7 |
for my $t (@data) {
|
|
Packit |
37d9e7 |
is(
|
|
Packit |
37d9e7 |
_ARRAYLIKE($t->[0]) ? 1 : 0,
|
|
Packit |
37d9e7 |
$t->[1],
|
|
Packit |
37d9e7 |
"$t->[3] " . ($t->[1] ? 'is' : "isn't") . ' @ish'
|
|
Packit |
37d9e7 |
);
|
|
Packit |
37d9e7 |
if ( _ARRAYLIKE($t->[0]) ) {
|
|
Packit |
37d9e7 |
addr( _ARRAYLIKE($t->[0]), $t->[0] );
|
|
Packit |
37d9e7 |
}
|
|
Packit |
37d9e7 |
is(
|
|
Packit |
37d9e7 |
_HASHLIKE( $t->[0]) ? 1 : 0,
|
|
Packit |
37d9e7 |
$t->[2],
|
|
Packit |
37d9e7 |
"$t->[3] " . ($t->[2] ? 'is' : "isn't") . ' %ish'
|
|
Packit |
37d9e7 |
);
|
|
Packit |
37d9e7 |
if ( _HASHLIKE($t->[0]) ) {
|
|
Packit |
37d9e7 |
addr( _HASHLIKE($t->[0]), $t->[0] );
|
|
Packit |
37d9e7 |
}
|
|
Packit |
37d9e7 |
}
|
|
Packit |
37d9e7 |
|
|
Packit |
37d9e7 |
package Foo;
|
|
Packit |
37d9e7 |
# this package is totally unremarkable;
|
|
Packit |
37d9e7 |
|
|
Packit |
37d9e7 |
package Foo::Listy;
|
|
Packit |
37d9e7 |
use overload
|
|
Packit |
37d9e7 |
'@{}' => sub { [] },
|
|
Packit |
37d9e7 |
fallback => 1;
|
|
Packit |
37d9e7 |
|
|
Packit |
37d9e7 |
package Foo::Hashy;
|
|
Packit |
37d9e7 |
use overload
|
|
Packit |
37d9e7 |
'%{}' => sub { {} },
|
|
Packit |
37d9e7 |
fallback => 1;
|
|
Packit |
37d9e7 |
|
|
Packit |
37d9e7 |
package Foo::Bothy;
|
|
Packit |
37d9e7 |
use overload
|
|
Packit |
37d9e7 |
'@{}' => sub { [] },
|
|
Packit |
37d9e7 |
'%{}' => sub { {} },
|
|
Packit |
37d9e7 |
fallback => 1;
|