1#!/usr/bin/perl 2 3use strict; 4BEGIN { 5 $| = 1; 6 $^W = 1; 7 $ENV{PERL_PARAMS_UTIL_PP} ||= 0; 8} 9 10use Test::More tests => 11; 11use File::Spec::Functions ':ALL'; 12BEGIN { 13 use_ok('Params::Util', qw(_INVOCANT)); 14} 15 16my $object = bless \do { my $i } => 'Params::Util::Test::Bogus::Whatever'; 17my $false_obj1 = bless \do { my $i } => 0; 18my $false_obj2 = bless \do { my $i } => "\0"; 19my $tied = tie my $x, 'Params::Util::Test::_INVOCANT::Tied'; 20my $unpkg = 'Params::Util::Test::_INVOCANT::Fake'; 21my $pkg = 'Params::Util::Test::_INVOCANT::Real'; eval "package $pkg;"; ## no critic 22 23my @data = (# I 24 [ undef , 0, 'undef' ], 25 [ 1000 => 0, '1000' ], 26 [ $unpkg => 1, qq("$unpkg") ], 27 [ $pkg => 1, qq("$pkg") ], 28 [ [] => 0, '[]' ], 29 [ {} => 0, '{}' ], 30 [ $object => 1, 'blessed reference' ], 31 [ $false_obj1 => 1, 'blessed reference' ], 32 [ $tied => 1, 'tied value' ], 33); 34 35for my $datum (@data) { 36 is( 37 _INVOCANT($datum->[0]) ? 1 : 0, 38 $datum->[1], 39 "$datum->[2] " . ($datum->[1] ? 'is' : "isn't") . " _IN" 40 ); 41} 42 43# Skip the most evil test except on automated testing, because it 44# fails on at least one common production OS (RedHat Enterprise Linux 4) 45# and the test case should be practically impossible to encounter 46# in real life. The damage the bug could cause users in production is 47# far lower than the damage caused by Params::Util failing to install. 48SKIP: { 49 unless ( $ENV{AUTOMATED_TESTING} ) { 50 skip("Skipping nasty test unless AUTOMATED_TESTING", 1); 51 } 52 ok( !! _INVOCANT($false_obj2), 'Testing null class as an invocant' ); 53} 54 55package Params::Util::Test::_INVOCANT::Tied; 56sub TIESCALAR { 57 my ($class, $value) = @_; 58 return bless \$value => $class; 59} 60