In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/933f1527ef5cdf83dd6c18ffb5dd61bf54a975ee?hp=fead0e11288c6958a66d99adf72d4635f93363d4>

- Log -----------------------------------------------------------------
commit 933f1527ef5cdf83dd6c18ffb5dd61bf54a975ee
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Sun Sep 18 12:11:28 2016 -0700

    Make regexp_nonull.t test patterns without null
    
    It was only testing matches against strings without a trailing
    null byte.  Now it also tests compilation of patterns without
    a trailing null byte.

M       t/re/regexp.t

commit b10cb25a6c86fd96fff8f2dfa6d8df3e6b51a451
Author: Yves Orton <demer...@gmail.com>
Date:   Sat Sep 17 20:14:53 2016 +0200

    regcomp.c: S_concat_pat: guard against missing trailing nulls
    
    The regex engine expects the pattern to have a null byte at
    SvEND(pat), but is not guaranteed to receive such a pattern
    when it is called, so S_concat_pat should guard against this
    case. It turns out this is only an issue when there is exactly
    one "argument" to the pattern. (Consider concatenation rules, etc).

M       regcomp.c

commit 0a5fcc380f7f35fa2a6d7c16524a7a27ec4d0b08
Author: Yves Orton <demer...@gmail.com>
Date:   Sat Sep 17 20:13:23 2016 +0200

    sv.c: sv_grow: newlen cannot be smaller than SvCUR()
    
    This expression dates back to about 2003 or so, and as
    far as I can tell is no longer necessary.

M       sv.c

commit 96160768517a92e1ca0bc25a0f2e1c8bf1461aae
Author: Yves Orton <demer...@gmail.com>
Date:   Sat Sep 17 20:12:26 2016 +0200

    doop.c: use sv_setpvn() instead of sv_setpvs()

M       doop.c
-----------------------------------------------------------------------

Summary of changes:
 doop.c        |  2 +-
 regcomp.c     | 16 ++++++++++++++--
 sv.c          |  2 +-
 t/re/regexp.t | 18 +++++++++++++++++-
 4 files changed, 33 insertions(+), 5 deletions(-)

diff --git a/doop.c b/doop.c
index 234a425..e6c7fe4 100644
--- a/doop.c
+++ b/doop.c
@@ -1008,7 +1008,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
     PERL_ARGS_ASSERT_DO_VOP;
 
     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv)))
-       sv_setpvs(sv, "");      /* avoid undef warning on |= and ^= */
+        sv_setpvn(sv, "", 0);        /* avoid undef warning on |= and ^= */
     if (sv == left) {
        lsave = lc = SvPV_force_nomg(left, leftlen);
     }
diff --git a/regcomp.c b/regcomp.c
index e7e41ff..8806c34 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -6321,8 +6321,20 @@ S_concat_pat(pTHX_ RExC_state_t * const pRExC_state,
                 sv_catsv_nomg(pat, msv);
                 rx = msv;
             }
-            else
-                pat = msv;
+            else {
+                /* We have only one SV to process, but we need to verify
+                 * it is properly null terminated or we will fail asserts
+                 * later. In theory we probably shouldn't get such SV's,
+                 * but if we do we should handle it gracefully. */
+                if ( SvTYPE(msv) != SVt_PV || (SvLEN(msv) > SvCUR(msv) && 
*(SvEND(msv)) == 0) ) {
+                    /* not a string, or a string with a trailing null */
+                    pat = msv;
+                } else {
+                    /* a string with no trailing null, we need to copy it
+                     * so it we have a trailing null */
+                    pat = newSVsv(msv);
+                }
+            }
 
             if (code)
                 pRExC_state->code_blocks[n-1].end = SvCUR(pat)-1;
diff --git a/sv.c b/sv.c
index 3e8fb3d..e2f199f 100644
--- a/sv.c
+++ b/sv.c
@@ -1604,7 +1604,7 @@ Perl_sv_grow(pTHX_ SV *const sv, STRLEN newlen)
        else {
            s = (char*)safemalloc(newlen);
            if (SvPVX_const(sv) && SvCUR(sv)) {
-               Move(SvPVX_const(sv), s, (newlen < SvCUR(sv)) ? newlen : 
SvCUR(sv), char);
+                Move(SvPVX_const(sv), s, SvCUR(sv), char);
            }
        }
        SvPV_set(sv, s);
diff --git a/t/re/regexp.t b/t/re/regexp.t
index 1e85c93..49aba5d 100644
--- a/t/re/regexp.t
+++ b/t/re/regexp.t
@@ -146,6 +146,11 @@ foreach (@tests) {
     $pat =~ s/\\n/\n/g unless $regex_sets;
     $pat = convert_from_ascii($pat) if ord("A") != 65;
 
+    my $no_null_pat;
+    if ($no_null && $pat =~ /^'(.*)'\z/) {
+       $no_null_pat = XS::APItest::string_without_null($1);
+    }
+
     $subject = convert_from_ascii($subject) if ord("A") != 65;
     $subject = eval qq("$subject"); die $@ if $@;
 
@@ -369,10 +374,12 @@ foreach (@tests) {
        my $c = $iters;
        my ($code, $match, $got);
         if ($repl eq 'pos') {
+            my $patcode = defined $no_null_pat ? '/$no_null_pat/g'
+                                               : "m${pat}g";
             $code= <<EOFCODE;
                 $study
                 pos(\$subject)=0;
-                \$match = ( \$subject =~ m${pat}g );
+                \$match = ( \$subject =~ $patcode );
                 \$got = pos(\$subject);
 EOFCODE
         }
@@ -394,6 +401,15 @@ EOFCODE
                 \$got = "$repl";
 EOFCODE
         }
+        elsif ($no_null) {
+            my $patcode = defined $no_null_pat ? '/$no_null_pat/'
+                                               :  $pat;
+            $code= <<EOFCODE;
+                $study
+                \$match = (\$subject =~ $OP$pat) while \$c--;
+                \$got = "$repl";
+EOFCODE
+        }
         else {
             $code= <<EOFCODE;
                 $study

--
Perl5 Master Repository

Reply via email to