openSUSE Build Service

Overview Repositories Revisions Requests Users Attributes Meta

File perl-reg89.diff of Package perl

--- ./regcomp.c.orig	2013-09-03 14:34:06.277801336 +0000
+++ ./regcomp.c	2013-09-03 14:34:38.600801279 +0000
@@ -10643,7 +10643,7 @@ tryagain:
                     if (num < 1)
                         vFAIL("Reference to nonexistent or unclosed group");
                 }
-		if (!isg && (num < 0 || (num > 9 && num >= RExC_npar)))
+		if (!isg && num > 9 && num >= RExC_npar && *RExC_parse != '8' && *RExC_parse != '9')
                     /* Probably a character specified in octal, e.g. \35 */
 		    goto defchar;
 		else {
@@ -10920,10 +10920,28 @@ tryagain:
 			p++;
 			ender = grok_bslash_c(*p++, UTF, SIZE_ONLY);
 			break;
-		    case '0': case '1': case '2': case '3':case '4':
+                    case '8': case '9': /* must be a backreference */
+                        --p;
+                        goto loopdone;
+		    case '1': case '2': case '3':case '4':
 		    case '5': case '6': case '7':
-			if (*p == '0' ||
-			    (isDIGIT(p[1]) && (U32)atoi(p) >= (U32)RExC_npar))
+                        /* When we parse backslash escapes there is ambiguity between
+                         * backreferences and octal escapes. Any escape from \1 - \9 is
+                         * a backreference, any multi-digit escape which does not start with
+                         * 0 and which when evaluated as decimal could refer to an already
+                         * parsed capture buffer is a backslash. Anything else is octal.
+                         *
+                         * Note this implies that \118 could be interpreted as 118 OR as
+                         * "\11" . "8" depending on whether there were 118 capture buffers
+                         * defined already in the pattern.
+                         */
+                        if ( !isDIGIT(p[1]) || atoi(p) <= RExC_npar )
+                        {  /* Not to be treated as an octal constant, go
+                                    find backref */
+                            --p;
+                            goto loopdone;
+                        }
+		    case '0':
 			{
 			    I32 flags = PERL_SCAN_SILENT_ILLDIGIT;
 			    STRLEN numlen = 3;
@@ -10942,11 +10960,6 @@ tryagain:
                                          form_short_octal_warning(p, numlen));
                             }
 			}
-                        else {  /* Not to be treated as an octal constant, go
-                                   find backref */
-			    --p;
-			    goto loopdone;
-			}
 			if (PL_encoding && ender < 0x100)
 			    goto recode_encoding;
 			break;
--- ./t/re/pat.t.orig	2013-09-03 14:34:06.277801336 +0000
+++ ./t/re/pat.t	2013-09-03 14:34:13.645801323 +0000
@@ -20,7 +20,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 472;  # Update this when adding/deleting tests.
+plan tests => 572;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1380,6 +1380,23 @@ EOP
 	is ($s, 'XXcdXXX&', 'RT #119125 with /x');
     }
 
+    {
+        # if we have 87 capture buffers defined then \87 should refer to the 87th.
+        # test that this is true for 1..100
+        my $str= "aa";
+        for my $i (1..100) {
+            my $pat= "a";
+            $pat= "($pat)" for 1 .. $i;
+            $pat.="\\$i";
+            eval {
+                ok($str=~/$pat/,"\\$i works with $i buffers");
+                1;
+            } or do {
+                ok(0,"\\$i works with $i buffers");
+            };
+        }
+    }
+
 } # End of sub run_tests
 
 1;
--- ./t/re/re_tests.orig	2013-09-03 14:34:06.277801336 +0000
+++ ./t/re/re_tests	2013-09-03 14:34:13.646801323 +0000
@@ -1487,9 +1487,9 @@ abc\N{def	-	c	-	\\N{NAME} must be resolv
 [a\o{1000}]	\x{200}	y	$&	\x{200}
 
 # The below were inserting a NULL
-\87	87	y	$&	87
-a\87	a87	y	$&	a87
-a\97	a97	y	$&	a97
+\87	87	c	-	Reference to nonexistent group in regex
+a\87	a87	c	-	Reference to nonexistent group in regex
+a\97	a97	c	-	Reference to nonexistent group in regex
 
 
 # The below was inserting a NULL into the character class.
--- ./t/re/reg_mesg.t.orig	2013-09-03 14:34:06.277801336 +0000
+++ ./t/re/reg_mesg.t	2013-09-03 14:34:13.646801323 +0000
@@ -174,6 +174,9 @@ my @death =
  'm/[\o]/' => 'Missing braces on \o{} {#} m/[\o{#}]/',
  'm/[\o{}]/' => 'Number with no digits {#} m/[\o{}{#}]/',
  'm/(?^-i:foo)/' => 'Sequence (?^-...) not recognized {#} m/(?^-{#}i:foo)/',
+ 'm/\87/' => 'Reference to nonexistent group {#} m/\87{#}/',
+ 'm/a\87/' => 'Reference to nonexistent group {#} m/a\87{#}/',
+ 'm/a\97/' => 'Reference to nonexistent group {#} m/a\97{#}/',
 );
 # Tests involving a user-defined charnames translator are in pat_advanced.t
 
@@ -200,9 +203,6 @@ my @warning = (
     '/\018/' => '\'\018\' resolved to \'\o{1}8\' {#} m/\018{#}/',
     '/[\08]/' => '\'\08\' resolved to \'\o{0}8\' {#} m/[\08{#}]/',
     '/[\018]/' => '\'\018\' resolved to \'\o{1}8\' {#} m/[\018{#}]/',
-    '/\87/' => 'Unrecognized escape \8 passed through {#} m/\8{#}7/',
-    '/a\87/' => 'Unrecognized escape \8 passed through {#} m/a\8{#}7/',
-    '/a\97/' => 'Unrecognized escape \9 passed through {#} m/a\9{#}7/',
     '/(?=a)*/' => '(?=a)* matches null string many times {#} m/(?=a)*{#}/',
     'my $x = \'\m\'; qr/a$x/' => 'Unrecognized escape \m passed through {#} m/a\m{#}/',
     '/\q/' => 'Unrecognized escape \q passed through {#} m/\q{#}/',

Places

File perl-reg89.diff of Package perl

Places