}
use Config;
-plan(tests => 28);
+plan(tests => 28 + 27*10);
ok( -d 'op' );
ok( -f 'TEST' );
"-$_[1]";
};
}
+{
+ package OverString;
+
+ # No fallback. -X should fall back to string overload even without
+ # it.
+ use overload q/""/ => sub { $over = 1; "TEST" };
+}
+{
+ package OverBoth;
+
+ use overload
+ q/""/ => sub { "TEST" },
+ -X => sub { "-$_[1]" };
+}
+{
+ package OverNeither;
+
+ # Need fallback. Previous veraions of perl required 'fallback' to do
+ # -X operations on an object with no "" overload.
+ use overload
+ '+' => sub { 1 },
+ fallback => 1;
+}
+
+my $ft = bless [], "OverFtest";
+my $ftstr = overload::StrVal($ft);
+my $str = bless [], "OverString";
+my $both = bless [], "OverBoth";
+my $neither = bless [], "OverNeither";
+my $nstr = overload::StrVal($neither);
-my $o = bless [], "OverFtest";
-my $str = overload::StrVal($o);
for my $op (split //, "rwxoRWXOezsfdlpSbctugkTMBAC") {
$over = [];
- ok( my $rv = eval "-$op \$o", "overloaded -$op succeeds" );
- $@ and diag( $@ );
- is( $over->[0], $str, "correct object for overloaded -$op" );
+ ok( my $rv = eval "-$op \$ft", "overloaded -$op succeeds" )
+ or diag( $@ );
+ is( $over->[0], $ftstr, "correct object for overloaded -$op" );
is( $over->[1], $op, "correct op for overloaded -$op" );
is( $rv, "-$op", "correct return value for overloaded -$op");
+
+ $over = 0;
+ $rv = eval "-$op \$str";
+ ok( !$@, "-$op succeeds with string overloading" )
+ or diag( $@ );
+ is( $rv, eval "-$op 'TEST'", "correct -$op on string overload" );
+ is( $over, 1, "string overload called for -$op" );
+
+ $rv = eval "-$op \$both";
+ is( $rv, "-$op", "correct -$op on string/-X overload" );
+
+ $rv = eval "-$op \$neither";
+ ok( !$@, "-$op succeeds with random overloading" )
+ or diag( $@ );
+ is( $rv, eval "-$op \$nstr", "correct -$op with random overloading" );
}
+
+is( -r -f $ft, "-r", "stacked overloaded -X" );