This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Temporarily remove overload.t changes
authorDavid Mitchell <davem@iabyn.com>
Mon, 4 Jun 2012 14:25:23 +0000 (15:25 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 13 Jun 2012 12:25:47 +0000 (13:25 +0100)
undo commits done to lib/overload.t on the blead branch
between 2012/03/31 and 2012/06/04 to make rebasing the re_eval
branch easier. These changes will be re-applied at the end of the rebase

lib/overload.t

index 87845b1..c0478ee 100644 (file)
@@ -48,7 +48,7 @@ package main;
 
 $| = 1;
 BEGIN { require './test.pl' }
-plan tests => 5082;
+plan tests => 5041;
 
 use Scalar::Util qw(tainted);
 
@@ -131,7 +131,7 @@ $b++;
 
 is(ref $b, "Oscalar");
 is($a, "087");
-is($b, "89");
+is($b, "88");
 is(ref $a, "Oscalar");
 
 package Oscalar;
@@ -142,7 +142,7 @@ $b++;
 
 is(ref $b, "Oscalar");
 is($a, "087");
-is($b, "91");
+is($b, "90");
 is(ref $a, "Oscalar");
 
 $b=$a;
@@ -202,7 +202,7 @@ is($b, "89");
 is(ref $a, "Oscalar");
 is($copies, 1);
 
-eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*"$_[1]";
+eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*$_[1];
                                                   $_[0] } ) ];
 $c=new Oscalar;                        # Cause rehash
 
@@ -267,12 +267,11 @@ is("$aI", "xx");
 is($aI, "xx");
 is("b${aI}c", "_._.b.__.xx._.__.c._");
 
-# Here we test that both "no overload" and
-# blessing to a package update hash
+# Here we test blessing to a package updates hash
 
 eval "package Oscalar; no overload '.'";
 
-is("b${a}", "bxx");
+is("b${a}", "_.b.__.xx._");
 $x="1";
 bless \$x, Oscalar;
 is("b${a}c", "bxxc");
@@ -292,8 +291,8 @@ like($@, qr/no method found/);
 
 eval "package Oscalar; sub comple; use overload '~' => 'comple'";
 
-$na = eval { ~$a };
-is($@, '');
+$na = eval { ~$a };            # Hash was not updated
+like($@, qr/no method found/);
 
 bless \$x, Oscalar;
 
@@ -304,8 +303,8 @@ is($na, '_!_xx_!_');
 
 $na = 0;
 
-$na = eval { ~$aI };
-like($@, '');
+$na = eval { ~$aI };           # Hash was not updated
+like($@, qr/no method found/);
 
 bless \$x, OscalarI;
 
@@ -317,8 +316,8 @@ is($na, '_!_xx_!_');
 
 eval "package Oscalar; sub rshft; use overload '>>' => 'rshft'";
 
-$na = eval { $aI >> 1 };
-is($@, '');
+$na = eval { $aI >> 1 };       # Hash was not updated
+like($@, qr/no method found/);
 
 bless \$x, OscalarI;
 
@@ -962,16 +961,11 @@ unless ($aaa) {
     my $a = "" ;
     local $SIG{__WARN__} = sub {$a = $_[0]} ;
     $x = eval ' use overload "~|_|~" => sub{} ' ;
-    eval ' no overload "~|_|~" ' ;
     is($a, "");
     use warnings 'overload' ;
     $x = eval ' use overload "~|_|~" => sub{} ' ;
     like($a, qr/^overload arg '~\|_\|~' is invalid at \(eval \d+\) line /,
        'invalid arg warning');
-    undef $a;
-    eval ' no overload "~|_|~" ' ;
-    like($a, qr/^overload arg '~\|_\|~' is invalid at \(eval \d+\) line /,
-       'invalid arg warning');
 }
 
 {
@@ -1119,6 +1113,18 @@ like ($@, qr/zap/);
 }
 
 {
+    package Numify;
+    use overload (qw(0+ numify fallback 1));
+
+    sub new {
+       my $val = $_[1];
+       bless \$val, $_[0];
+    }
+
+    sub numify { ${$_[0]} }
+}
+
+{
     package perl31793;
     use overload cmp => sub { 0 };
     package perl31793_fb;
@@ -1139,20 +1145,8 @@ like ($@, qr/zap/);
     like(overload::StrVal($no),       qr/^no_overload=ARRAY\(0x[0-9a-f]+\)$/);
 }
 
-{
-    package Numify;
-    use overload (qw(0+ numify fallback 1));
-
-    sub new {
-       my $val = $_[1];
-       bless \$val, $_[0];
-    }
-
-    sub numify { ${$_[0]} }
-}
-
-# These all check that overloaded values, rather than reference addresses,
-# are what are getting tested.
+# These are all check that overloaded values rather than reference addresses
+# are what is getting tested.
 my ($two, $one, $un, $deux) = map {new Numify $_} 2, 1, 1, 2;
 my ($ein, $zwei) = (1, 2);
 
@@ -1857,9 +1851,6 @@ foreach my $op (qw(<=> == != < <= > >=)) {
            or die "open of \$iter_text gave ($!)\n";
        $subs{'<>'} = '<$iter_fh>';
        push @tests, [ $iter_fh, '<%s>', '(<>)', undef, [ 1, 1, 0 ], 1 ];
-       push @tests, [ $iter_fh,
-                     'local *CORE::GLOBAL::glob = sub {}; eval q|<%s>|',
-                     '(<>)', undef, [ 1, 1, 0 ], 1 ];
 
        # eval should do tie, overload on its arg before checking taint */
        push @tests, [ '1;', 'eval q(eval %s); $@ =~ /Insecure/',
@@ -2194,7 +2185,7 @@ fresh_perl_is
 {
     package Justus;
     use overload '+' => 'justice';
-    eval {"".bless[]};
+    eval {bless[]};
     ::like $@, qr/^Can't resolve method "justice" overloading "\+" in p(?x:
                   )ackage "Justus" at /,
       'Error message when explicitly named overload method does not exist';
@@ -2203,12 +2194,21 @@ fresh_perl_is
     our @ISA = 'JustYou';
     package JustYou { use overload '+' => 'injustice'; }
     "JustUs"->${\"(+"};
-    eval {"".bless []};
+    eval {bless []};
     ::like $@, qr/^Stub found while resolving method "\?{3}" overloadin(?x:
                   )g "\+" in package "JustUs" at /,
       'Error message when sub stub is encountered';
 }
 
+{ # undefining the overload stash -- KEEP THIS TEST LAST
+    package ant;
+    use overload '+' => 'onion';
+    $_ = \&overload::nil;
+    undef %overload::;
+    bless[];
+    ::ok(1, 'no crash when undefining %overload::');
+}
+
 # [perl #40333]
 # overload::Overloaded should not use a ->can designed for autoloading.
 # This example attempts to be as realistic as possible.  The o class has a
@@ -2243,96 +2243,5 @@ ok !overload::Overloaded(new proxy new o),
     ok(overload::Overloaded($obj));
 }
 
-sub eleventative::cos { 'eleven' }
-sub twelvetative::abs { 'twelve' }
-sub thirteentative::abs { 'thirteen' }
-sub fourteentative::abs { 'fourteen' }
-@eleventative::ISA = twelvetative::;
-{
-    my $o = bless [], 'eleventative';
-    eval 'package eleventative; use overload map +($_)x2, cos=>abs=>';
-    is cos $o, 'eleven', 'overloading applies to object blessed before';
-    bless [], 'eleventative';
-    is cos $o, 'eleven',
-      'ovrld applies to previously-blessed obj after other obj is blessed';
-    $o = bless [], 'eleventative';
-    *eleventative::cos = sub { 'ten' };
-    is cos $o, 'ten', 'method changes affect overloading';
-    @eleventative::ISA = thirteentative::;
-    is abs $o, 'thirteen', 'isa changes affect overloading';
-    bless $o, 'fourteentative';
-    @fourteentative::ISA = 'eleventative';
-    is abs $o, 'fourteen', 'isa changes can turn overloading on';
-}
-
-# no overload "fallback";
-{ package phake;
-  use overload fallback => 1, '""' => sub { 'arakas' };
-  no overload 'fallback';
-}
-$a = bless [], 'phake';
-is "$a", "arakas",
-    'no overload "fallback" does not stop overload from working';
-ok !eval { () = $a eq 'mpizeli'; 1 },
-    'no overload "fallback" resets fallback to undef on overloaded class';
-{ package ent; use overload fallback => 0, abs => sub{};
-  our@ISA = 'huorn';
-  package huorn;
-  use overload fallback => 1;
-  package ent;
-  no overload "fallback"; # disable previous declaration
-}
-$a = bless [], ent::;
-is eval {"$a"}, overload::StrVal($a),
-    'no overload undoes fallback declaration completetly'
- or diag $@;
-
-# inherited fallback
-{
- package pervyy;
- our @ISA = 'vtoryy';
- use overload "abs" =>=> sub {};
- package vtoryy;
- use overload fallback => 1, 'sin' =>=> sub{}
-}
-$a = bless [], pervyy::;
-is eval {"$a"}, overload::StrVal($a),
- 'fallback is inherited by classes that have their own overloading'
- or diag $@;
-
-# package separators in method names
-{
- package mane;
- use overload q\""\ => "bear::strength";
- use overload bool  => "bear'bouillon";
-}
-@bear::ISA = 'food';
-sub food::strength { 'twine' }
-sub food::bouillon { 0 }
-$a = bless[], mane::;
-is eval { "$a" }, 'twine', ':: in method name' or diag $@;
-is eval { !$a  },   1,      "' in method name" or diag $@;
-
-# [perl #113050] Half of CPAN assumes fallback is under "()"
-{
-  package dodo;
-  use overload '+' => sub {};
-  no strict;
-  *{"dodo::()"} = sub{};
-  ${"dodo::()"} = 1;
-}
-$a = bless [],'dodo';
-is eval {"$a"}, overload::StrVal($a), 'fallback is stored under "()"';
-
-
-{ # undefining the overload stash -- KEEP THIS TEST LAST
-    package ant;
-    use overload '+' => 'onion';
-    $_ = \&overload::nil;
-    undef %overload::;
-    ()=0+bless[];
-    ::ok(1, 'no crash when undefining %overload::');
-}
-
 
 # EOF