This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/re/subst.t: tests for RT #23624
authorDan Collins <dcollinsn@gmail.com>
Tue, 5 Jul 2016 23:32:56 +0000 (19:32 -0400)
committerYves Orton <demerphq@gmail.com>
Fri, 21 Oct 2016 07:09:44 +0000 (09:09 +0200)
t/re/subst.t

index d32e7b8..6224d64 100644 (file)
@@ -11,7 +11,7 @@ BEGIN {
     require './loc_tools.pl';
 }
 
-plan( tests => 271 );
+plan( tests => 274 );
 
 $_ = 'david';
 $a = s/david/rules/r;
@@ -1119,3 +1119,31 @@ SKIP: {
                    {stderr => 1 },
                    '[perl #129038 ] s/\xff//l no longer crashes');
 }
+
+{
+    # RT #23624 scoping of @+/@- when used with tie()
+    #! /usr/bin/perl -w
+
+    package Tie::Prematch;
+    sub TIEHASH { bless \my $dummy => __PACKAGE__ }
+    sub FETCH   { return substr $_[1], 0, $-[0] }
+
+    package main;
+
+    tie my %pre, 'Tie::Prematch';
+    my $foo = 'foobar';
+    $foo =~ s/.ob/$pre{ $foo }/;
+    is($foo, 'ffar', 'RT #23624');
+
+    $foo = 'foobar';
+    $foo =~ s/.ob/tied(%pre)->FETCH($foo)/e;
+    is($foo, 'ffar', 'RT #23624');
+
+    tie %-, 'Tie::Prematch';
+    $foo = 'foobar';
+    $foo =~ s/.ob/$-{$foo}/;
+    is($foo, 'ffar', 'RT #23624');
+
+    undef *Tie::Prematch::TIEHASH;
+    undef *Tie::Prematch::FETCH;
+}