This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fixes to make test pass for regexp nocapture bit addition.
[perl5.git] / lib / overload.t
index e9ceb50..524d99f 100644 (file)
@@ -48,7 +48,7 @@ package main;
 
 $| = 1;
 BEGIN { require './test.pl' }
-plan tests => 5193;
+plan tests => 5199;
 
 use Scalar::Util qw(tainted);
 
@@ -305,7 +305,7 @@ is($na, '_!_xx_!_');
 $na = 0;
 
 $na = eval { ~$aI };
-like($@, '');
+is($@, '');
 
 bless \$x, OscalarI;
 
@@ -1293,15 +1293,16 @@ foreach my $op (qw(<=> == != < <= > >=)) {
 }
 
 {
-    # Check readonliness of constants (brought up in bug #109744)
-    # For historical reasons, shared hash key scalars are exempt
+    # Check readonliness of constants, whether shared hash key
+    # scalars or no (brought up in bug #109744)
     BEGIN { overload::constant integer => sub { "main" }; }
     eval { ${\5} = 'whatever' };
     like $@, qr/^Modification of a read-only value attempted at /,
        'constant overloading makes read-only constants';
     BEGIN { overload::constant integer => sub { __PACKAGE__ }; }
     eval { ${\5} = 'whatever' };
-    is $@, "", 'except with shared hash key scalars';
+    like $@, qr/^Modification of a read-only value attempted at /,
+       '... even with shared hash key scalars';
 }
 
 {
@@ -2064,11 +2065,11 @@ fresh_perl_is
     }
 
     package NCmp;
-    use base 'CmpBase';
+    use parent '-norequire', 'CmpBase';
     use overload '<=>' => 'cmp';
 
     package SCmp;
-    use base 'CmpBase';
+    use parent '-norequire', 'CmpBase';
     use overload 'cmp' => 'cmp';
 
     package main;
@@ -2132,7 +2133,7 @@ fresh_perl_is
                 ? $nomethod . "=>'nomethod'," : '';
             eval qq{
                     package NuMB$fall$nomethod;
-                    use base qw/NuMB/;
+                    use parent '-norequire', qw/NuMB/;
                     use overload $nomethod_decl
                     fallback => $fall;
                 };
@@ -2701,6 +2702,58 @@ EOF
     );
 }
 
+{
+    # RT #121362
+    # splitting the stash HV while rebuilding the overload cache gave
+    # valgrind errors. This test code triggers such a split. It doesn't
+    # actually test anything; its just there for valgrind to spot
+    # problems.
+
+    package A_121362;
+
+    sub stringify { }
+    use overload '""' => 'stringify';
+
+    package B_121362;
+    our @ISA = qw(A_121362);
+
+    package main;
+
+    my $x = bless { }, 'B_121362';
+
+    for ('a'..'z') {
+        delete $B_121362::{stringify}; # delete cache entry
+        no strict 'refs';
+        *{"B_121362::$_"}  = sub { };  # increase size of %B_121362
+        my $y = $x->{value};       # trigger cache add to %B_121362
+    }
+    pass("RT 121362");
+}
+
+package refsgalore {
+    use overload
+       '${}' => sub { \42  },
+       '@{}' => sub { [43] },
+       '%{}' => sub { { 44 => 45 } },
+       '&{}' => sub { sub { 46 } };
+}
+{
+    use feature 'postderef';
+    no warnings 'experimental::postderef';
+    tell myio; # vivifies *myio{IO} at compile time
+    use constant ioref => bless *myio{IO}, refsgalore::;
+    is ioref->$*, 42, '(overloaded constant that is not a scalar ref)->$*';
+    is ioref->[0], 43, '(ovrld constant that is not an array ref)->[0]';
+    is ioref->{44}, 45, "(ovrld const that is not a hash ref)->{key}";
+    is ioref->(), 46, '(overloaded constant that is not a sub ref)->()';
+}
+
+package xstack { use overload 'x' => sub { shift . " x " . shift },
+                              '""'=> sub { "xstack" } }
+is join(",", 1..3, scalar((bless([], 'xstack')) x 3, 1), 4..6),
+  "1,2,3,1,4,5,6",
+  '(...)x... in void cx with x overloaded [perl #121827]';
+
 { # undefining the overload stash -- KEEP THIS TEST LAST
     package ant;
     use overload '+' => 'onion';