From: Ben Morrow <ben@morrow.me.uk>
Date: Mon, 19 Jan 2009 23:32:29 +0000 (+0000)
Subject: More tests for -X/string/random overloading.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f6aa80235c3fbb719271d2e0f4463ba710cceea6;p=p5sagit%2Fp5-mst-13.2.git

More tests for -X/string/random overloading.
---

diff --git a/t/op/filetest.t b/t/op/filetest.t
index 8c8ecd4..0fec3c1 100755
--- a/t/op/filetest.t
+++ b/t/op/filetest.t
@@ -10,7 +10,7 @@ BEGIN {
 }
 
 use Config;
-plan(tests => 28);
+plan(tests => 28 + 27*10);
 
 ok( -d 'op' );
 ok( -f 'TEST' );
@@ -105,14 +105,59 @@ my $over;
         "-$_[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" );