In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/2a2626d8512fc09c6ef077095e4e075978a5c2df?hp=71390552257ec020456a2c3cd395e2afd534d031>

- Log -----------------------------------------------------------------
commit 2a2626d8512fc09c6ef077095e4e075978a5c2df
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Sat Oct 4 05:56:11 2014 -0700

    Consistent spaces after dots in perlfunc

M       pod/perlfunc.pod

commit b39691c2f7d54897113063413c374b78418a1684
Author: Doug Bell <madcity...@gmail.com>
Date:   Thu Oct 2 22:52:24 2014 -0500

    clarify use VERSION docs
    
    Anything that C<use VERSION> adds, another C<use VERSION> may take away.
    Explicitly doing the C<use strict> and/or C<use feature> means that
    C<use VERSION> will not change them. C<use VERSION> will only change
    the defaults, or things done by C<use VERSION>.

M       pod/perlfunc.pod

commit ad7111d78cf2ef19b7153bd2dd4c9ef10e5b5e11
Author: Daniel Dragan <bul...@hotmail.com>
Date:   Sat Oct 4 01:39:36 2014 -0400

    silence compiler warnings in utf8_mg_pos_cache_update
    
    commit 73ecc8cb69 added warnings on VC2003, silence them
    ..\sv.c(7556) : warning C4244: '=' : conversion from 'STRLEN' to 'float', 
possible loss of data
    ..\sv.c(7557) : warning C4244: '=' : conversion from 'const STRLEN' to 
'float', possible loss of data
    ..\sv.c(7560) : warning C4244: '=' : conversion from 'const STRLEN' to 
'float', possible loss of data
    ..\sv.c(7561) : warning C4244: '=' : conversion from 'STRLEN' to 'float', 
possible loss of data

M       sv.c

commit ff121dc6349d6a8a9f9fa598e3955c1d701e3f60
Author: Daniel Dragan <bul...@hotmail.com>
Date:   Sat Oct 4 02:14:02 2014 -0400

    optimize SV creation funcs in sv.c
    
    In Perl_newSV, the sv_upgrade is redundant, except to protect against a
    segv in blindly SV body derefing SvGROW (but not in sv_grow). sv_grow has
    always upgraded a non-PV SV to PV. So don't it here. Since a new SV will
    never have be a COW, have a SvLEN or a body, all of which SvGROW uses,
    just call sv_grow. Less branching, and smaller code that way.
    
    In Perl_newSV_type, give a hint to compiler that if a platform's
    symbol visibility allows inlining, and newSV_type's arg is the base type
    (currently SVt_NULL, maybe SVt_IV in future (see ML)), to possibly inline
    new_SV into the caller and remove the sv_upgrade call. Also don't call
    sv_upgrade if it isn't needed (SVt_NULL) in the public symbol version.
    
    The redundant sv_upgrade then sv_grow goes to commit 79072805bf
    "perl 5.0 alpha 2". VC 2003 -01 32 bit threaded machine code size in bytes
    of 2 functions
    Perl_newSV_type before 0x2f after 0x29
    Perl_newSV  before 0x48 after 0x28

M       sv.c
M       sv.h

commit 2ff4512f4d92cb81d1db548ba0655eb9bfb081e3
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Sat Oct 4 05:32:50 2014 -0700

    regcomp.c: Compiler warning
    
    Shut up this warning:
    
    regcomp.c:7346:13: warning: format specifies type 'unsigned long' but the
          argument has type 'U32' (aka 'unsigned int') [-Wformat]
                RExC_study_chunk_recursed_count);
                ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    by casting to auld lang syne—I mean unsigned long.

M       regcomp.c

commit f8a7ccebba5637bf0cf5a23cea563b2ccd62312d
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Fri Oct 3 22:40:36 2014 -0700

    Fix assertion failure/hang with / (?{(^{})/
    
    When this invalid construct is parsed, the resulting op tree for the
    pattern has a code block with no constant item following it, breaking
    the assumptions made by pmruntime.
    
    Fixing this was not so easy.
    
    You can’t just adjust the assertions, because the hang that non-debug-
    ging builds exhibited is still there.
    
    You can’t just return NULL from pmruntime when encounting the bad op
    tree, because the parser will crash on the null pointer.
    
    You can’t just return the empty pmop, because the wrong pad is
    active, and other functions in op.c will try to access nonexistent
    pad entries.
    
    You can’t just LEAVE_SCOPE and return the pmop, because then PL_parser
    will be null in yyerror.  Changing yyerror to account is not suffi-
    cient, because then you get double-freed SVs.  At that point I gave up
    with that approach.
    
    The easiest solution turned out to be to fake up the op that we were
    expecting to see.

M       op.c
M       t/re/re_tests
-----------------------------------------------------------------------

Summary of changes:
 op.c             | 10 +++++++++-
 pod/perlfunc.pod | 10 +++++++---
 regcomp.c        |  2 +-
 sv.c             | 15 ++++++++-------
 sv.h             |  3 +++
 t/re/re_tests    |  1 +
 6 files changed, 29 insertions(+), 12 deletions(-)

diff --git a/op.c b/op.c
index 930df2d..c864a26 100644
--- a/op.c
+++ b/op.c
@@ -4922,7 +4922,15 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 
floor)
        for (o = cLISTOPx(expr)->op_first; o; o = OP_SIBLING(o)) {
            if (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)) {
                has_code = 1;
-               assert(!o->op_next && OP_HAS_SIBLING(o));
+               assert(!o->op_next);
+               if (UNLIKELY(!OP_HAS_SIBLING(o))) {
+                   assert(PL_parser && PL_parser->error_count);
+                   /* This can happen with qr/ (?{(^{})/.  Just fake up
+                      the op we were expecting to see, to avoid crashing
+                      elsewhere.  */
+                   op_sibling_splice(expr, o, 0,
+                                     newSVOP(OP_CONST, 0, &PL_sv_no));
+               }
                o->op_next = OP_SIBLING(o);
            }
            else if (o->op_type != OP_CONST && o->op_type != OP_PUSHMARK)
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 58f39bc..8806486 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -8612,15 +8612,19 @@ This is often useful if you need to check the current 
Perl version before
 C<use>ing library modules that won't work with older versions of Perl.
 (We try not to do this more than we have to.)
 
-C<use VERSION> also enables all features available in the requested
+C<use VERSION> also lexically enables all features available in the requested
 version as defined by the C<feature> pragma, disabling any features
 not in the requested version's feature bundle.  See L<feature>.
 Similarly, if the specified Perl version is greater than or equal to
 5.12.0, strictures are enabled lexically as
 with C<use strict>.  Any explicit use of
 C<use strict> or C<no strict> overrides C<use VERSION>, even if it comes
-before it.  In both cases, the F<feature.pm> and F<strict.pm> files are
-not actually loaded.
+before it.  Later use of C<use VERSION>
+will override all behavior of a previous
+C<use VERSION>, possibly removing the C<strict> and C<feature> added by
+C<use VERSION>.  C<use VERSION> does not
+load the F<feature.pm> or F<strict.pm>
+files.
 
 The C<BEGIN> forces the C<require> and C<import> to happen at compile time.  
The
 C<require> makes sure the module is loaded into memory if it hasn't been
diff --git a/regcomp.c b/regcomp.c
index c8df348..ca32120 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -7343,7 +7343,7 @@ reStudy:
     /* assume we don't need to swap parens around before we match */
     DEBUG_TEST_r({
         PerlIO_printf(Perl_debug_log,"study_chunk_recursed_count: %lu\n",
-            RExC_study_chunk_recursed_count);
+            (unsigned long)RExC_study_chunk_recursed_count);
     });
     DEBUG_DUMP_r({
         DEBUG_RExC_seen();
diff --git a/sv.c b/sv.c
index c3594b2..94849e9 100644
--- a/sv.c
+++ b/sv.c
@@ -5573,8 +5573,7 @@ Perl_newSV(pTHX_ const STRLEN len)
 
     new_SV(sv);
     if (len) {
-       sv_upgrade(sv, SVt_PV);
-       SvGROW(sv, len + 1);
+       sv_grow(sv, len + 1);
     }
     return sv;
 }
@@ -7464,12 +7463,12 @@ S_utf8_mg_pos_cache_update(pTHX_ SV *const sv, MAGIC 
**const mgp, const STRLEN b
            float b, c, keep_earlier;
            if (byte > cache[3]) {
                /* New position is between the existing pair of pairs.  */
-               b = cache[3];
-               c = byte;
+               b = (float)cache[3];
+               c = (float)byte;
            } else {
                /* New position is before the existing pair of pairs.  */
-               b = byte;
-               c = cache[3];
+               b = (float)byte;
+               c = (float)cache[3];
            }
            keep_earlier = THREEWAY_SQUARE(0, b, c, blen);
            if (byte > cache[3]) {
@@ -9345,7 +9344,9 @@ Perl_newSV_type(pTHX_ const svtype type)
     SV *sv;
 
     new_SV(sv);
-    sv_upgrade(sv, type);
+    ASSUME(SvTYPE(sv) == SVt_FIRST);
+    if(type != SVt_FIRST)
+       sv_upgrade(sv, type);
     return sv;
 }
 
diff --git a/sv.h b/sv.h
index 5e01390..8c751dc 100644
--- a/sv.h
+++ b/sv.h
@@ -176,6 +176,9 @@ typedef enum {
 #if defined(PERL_IN_HV_C) || defined(PERL_IN_XS_APITEST)
 #define HE_SVSLOT      SVt_NULL
 #endif
+#ifdef PERL_IN_SV_C
+#  define SVt_FIRST SVt_NULL   /* the type of SV that new_SV() in sv.c returns 
*/
+#endif
 
 #define PERL_ARENA_ROOTS_SIZE  (SVt_LAST)
 
diff --git a/t/re/re_tests b/t/re/re_tests
index 964360d..2c40e85 100644
--- a/t/re/re_tests
+++ b/t/re/re_tests
@@ -539,6 +539,7 @@ foo\w*\d{4}baz      foobar1234baz   y       $&      
foobar1234baz
 a(?{})b        cabd    y       $&      ab
 a(?{f()+       -       c       -       Missing right curly or square bracket
 a(?{{1}+       -       c       -       Missing right curly or square bracket
+ (?{(^{})      -       c       -       syntax error
 a(?{}})b       -       c       -       
 a(?{"{"})b     ab      y       -       -
 a(?{"\{"})b    cabd    y       $&      ab

--
Perl5 Master Repository

Reply via email to