summaryrefslogtreecommitdiff
path: root/t/06_invocant.t
diff options
context:
space:
mode:
Diffstat (limited to 't/06_invocant.t')
-rw-r--r--t/06_invocant.t59
1 files changed, 59 insertions, 0 deletions
diff --git a/t/06_invocant.t b/t/06_invocant.t
new file mode 100644
index 0000000..2722c63
--- /dev/null
+++ b/t/06_invocant.t
@@ -0,0 +1,59 @@
+#!/usr/bin/perl
+
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+ $ENV{PERL_PARAMS_UTIL_PP} ||= 0;
+}
+
+use Test::More tests => 11;
+use File::Spec::Functions ':ALL';
+BEGIN {
+ use_ok('Params::Util', qw(_INVOCANT));
+}
+
+my $object = bless \do { my $i } => 'Params::Util::Test::Bogus::Whatever';
+my $false_obj1 = bless \do { my $i } => 0;
+my $false_obj2 = bless \do { my $i } => "\0";
+my $tied = tie my $x, 'Params::Util::Test::_INVOCANT::Tied';
+my $unpkg = 'Params::Util::Test::_INVOCANT::Fake';
+my $pkg = 'Params::Util::Test::_INVOCANT::Real'; eval "package $pkg;"; ## no critic
+
+my @data = (# I
+ [ undef , 0, 'undef' ],
+ [ 1000 => 0, '1000' ],
+ [ $unpkg => 1, qq("$unpkg") ],
+ [ $pkg => 1, qq("$pkg") ],
+ [ [] => 0, '[]' ],
+ [ {} => 0, '{}' ],
+ [ $object => 1, 'blessed reference' ],
+ [ $false_obj1 => 1, 'blessed reference' ],
+ [ $tied => 1, 'tied value' ],
+);
+
+for my $datum (@data) {
+ is(
+ _INVOCANT($datum->[0]) ? 1 : 0,
+ $datum->[1],
+ "$datum->[2] " . ($datum->[1] ? 'is' : "isn't") . " _IN"
+ );
+}
+
+# Skip the most evil test except on automated testing, because it
+# fails on at least one common production OS (RedHat Enterprise Linux 4)
+# and the test case should be practically impossible to encounter
+# in real life. The damage the bug could cause users in production is
+# far lower than the damage caused by Params::Util failing to install.
+SKIP: {
+ unless ( $ENV{AUTOMATED_TESTING} ) {
+ skip("Skipping nasty test unless AUTOMATED_TESTING", 1);
+ }
+ ok( !! _INVOCANT($false_obj2), 'Testing null class as an invocant' );
+}
+
+package Params::Util::Test::_INVOCANT::Tied;
+sub TIESCALAR {
+ my ($class, $value) = @_;
+ return bless \$value => $class;
+}