In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/5d42e1d7536fcbff51cd85029cbd5cdf2bb9ce97?hp=e0c6a6b8c9a5470601df2e25f77f2422fb3f2ea5>
- Log ----------------------------------------------------------------- commit 5d42e1d7536fcbff51cd85029cbd5cdf2bb9ce97 Author: Father Chrysostomos <[email protected]> Date: Sun Jan 11 21:44:53 2015 -0800 perldelta for 58480c3bb M pod/perldelta.pod commit 3d37dc2e824f060757259073b4f8bb489f293109 Author: Father Chrysostomos <[email protected]> Date: Sun Jan 11 21:44:13 2015 -0800 perldelta for 62ae7cfb674910 M pod/perldelta.pod commit d2fff9f6be38f2130cd29a5c7a2a82897a511f2d Author: Father Chrysostomos <[email protected]> Date: Sun Jan 11 21:38:07 2015 -0800 perldelta for 2e4af4cf6b M pod/perldelta.pod commit a3be5ee7857e3bd21db692b2200f237c8d791830 Author: Father Chrysostomos <[email protected]> Date: Sun Jan 11 21:34:06 2015 -0800 Correct perl ver in Safe Changes M dist/Safe/Changes commit ed9feedd0527ff7353894db934c3ef325519b6df Author: Daniel Dragan <[email protected]> Date: Wed Dec 31 23:09:28 2014 -0500 refactor op.c S_bad_type_*v -flags arg of both funcs is unused in all callers. Move the 0 to the funcs. flags arg is from commit ce16c625ec in 2012 -all bad_type_gv calls are right before the end of the switch, the pushing of 1st 3 args and call asm ops can be merged together, leaving the 1 string constant push as the only unique op between the 7 src code callers of bad_type_gv, this requires reordering the args so the only unique one is the last/right most one, reordering can't be done to bad_type_pv because each following execution point after each bad_type_pv is different, bad_type_pv's caller/s are not a switch statement - commit 53e06cf030 probably overlooked the 2 PL_op_desc[type] places, OP_DESC is a fancier superset of PL_op_desc[type], since calling bad_type_pv only happens during a PP syntax error, that is not performance critical, so replace PL_op_desc[type] with OP_DESC and factor out OP to description string lookup, plus custom ops are very rare so this shouldn't impact the error message seen by the user VC2003 .text section of perl521.dll before 0xc9543 after 0xC9523 M embed.fnc M embed.h M op.c M proto.h ----------------------------------------------------------------------- Summary of changes: dist/Safe/Changes | 2 +- embed.fnc | 4 ++-- embed.h | 4 ++-- op.c | 37 ++++++++++++++++++------------------- pod/perldelta.pod | 15 +++++++++++++++ proto.h | 12 ++++++------ 6 files changed, 44 insertions(+), 30 deletions(-) diff --git a/dist/Safe/Changes b/dist/Safe/Changes index c0c7315..a707195 100644 --- a/dist/Safe/Changes +++ b/dist/Safe/Changes @@ -1,6 +1,6 @@ 2.39 xxxxx - reval was not propagating void context properly. - The fix is partly in Opcode, so it requires 5.21.7 or higher. + The fix is partly in Opcode, so it requires 5.21.8 or higher. 2.38 Mon Aug 04 2014 - critical bugfix: outside packages could be replaced (fix in Opcode) diff --git a/embed.fnc b/embed.fnc index 020872c..187d113 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1938,8 +1938,8 @@ s |OP * |my_kid |NULLOK OP *o|NULLOK OP *attrs|NN OP **imopsp s |OP * |dup_attrlist |NN OP *o s |void |apply_attrs |NN HV *stash|NN SV *target|NULLOK OP *attrs s |void |apply_attrs_my |NN HV *stash|NN OP *target|NULLOK OP *attrs|NN OP **imopsp -s |void |bad_type_pv |I32 n|NN const char *t|NN const char *name|U32 flags|NN const OP *kid -s |void |bad_type_gv |I32 n|NN const char *t|NN GV *gv|U32 flags|NN const OP *kid +s |void |bad_type_pv |I32 n|NN const char *t|NN const OP *o|NN const OP *kid +s |void |bad_type_gv |I32 n|NN GV *gv|NN const OP *kid|NN const char *t s |void |no_bareword_allowed|NN OP *o sR |OP* |no_fh_allowed|NN OP *o sR |OP* |too_few_arguments_pv|NN OP *o|NN const char* name|U32 flags diff --git a/embed.h b/embed.h index c484be0..70cab3e 100644 --- a/embed.h +++ b/embed.h @@ -1518,8 +1518,8 @@ #define apply_attrs(a,b,c) S_apply_attrs(aTHX_ a,b,c) #define apply_attrs_my(a,b,c,d) S_apply_attrs_my(aTHX_ a,b,c,d) #define assignment_type(a) S_assignment_type(aTHX_ a) -#define bad_type_gv(a,b,c,d,e) S_bad_type_gv(aTHX_ a,b,c,d,e) -#define bad_type_pv(a,b,c,d,e) S_bad_type_pv(aTHX_ a,b,c,d,e) +#define bad_type_gv(a,b,c,d) S_bad_type_gv(aTHX_ a,b,c,d) +#define bad_type_pv(a,b,c,d) S_bad_type_pv(aTHX_ a,b,c,d) #define clear_special_blocks(a,b,c) S_clear_special_blocks(aTHX_ a,b,c) #define cop_free(a) S_cop_free(aTHX_ a) #define dup_attrlist(a) S_dup_attrlist(aTHX_ a) diff --git a/op.c b/op.c index 28cca42..637a60e 100644 --- a/op.c +++ b/op.c @@ -541,22 +541,24 @@ S_too_many_arguments_pv(pTHX_ OP *o, const char *name, U32 flags) } STATIC void -S_bad_type_pv(pTHX_ I32 n, const char *t, const char *name, U32 flags, const OP *kid) +S_bad_type_pv(pTHX_ I32 n, const char *t, const OP *o, const OP *kid) { PERL_ARGS_ASSERT_BAD_TYPE_PV; yyerror_pv(Perl_form(aTHX_ "Type of arg %d to %s must be %s (not %s)", - (int)n, name, t, OP_DESC(kid)), flags); + (int)n, PL_op_desc[(o)->op_type], t, OP_DESC(kid)), 0); } +/* remove flags var, its unused in all callers, move to to right end since gv + and kid are always the same */ STATIC void -S_bad_type_gv(pTHX_ I32 n, const char *t, GV *gv, U32 flags, const OP *kid) +S_bad_type_gv(pTHX_ I32 n, GV *gv, const OP *kid, const char *t) { SV * const namesv = cv_name((CV *)gv, NULL, 0); PERL_ARGS_ASSERT_BAD_TYPE_GV; yyerror_pv(Perl_form(aTHX_ "Type of arg %d to %"SVf" must be %s (not %s)", - (int)n, SVfARG(namesv), t, OP_DESC(kid)), SvUTF8(namesv) | flags); + (int)n, SVfARG(namesv), t, OP_DESC(kid)), SvUTF8(namesv)); } STATIC void @@ -9969,7 +9971,7 @@ Perl_ck_fun(pTHX_ OP *o) && ( !SvROK(cSVOPx_sv(kid)) || SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVAV ) ) - bad_type_pv(numargs, "array", PL_op_desc[type], 0, kid); + bad_type_pv(numargs, "array", o, kid); /* Defer checks to run-time if we have a scalar arg */ if (kid->op_type == OP_RV2AV || kid->op_type == OP_PADAV) op_lvalue(kid, type); @@ -9984,7 +9986,7 @@ Perl_ck_fun(pTHX_ OP *o) break; case OA_HVREF: if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV) - bad_type_pv(numargs, "hash", PL_op_desc[type], 0, kid); + bad_type_pv(numargs, "hash", o, kid); op_lvalue(kid, type); break; case OA_CVREF: @@ -10010,7 +10012,7 @@ Perl_ck_fun(pTHX_ OP *o) } else if (kid->op_type == OP_READLINE) { /* neophyte patrol: open(<FH>), close(<FH>) etc. */ - bad_type_pv(numargs, "HANDLE", OP_DESC(o), 0, kid); + bad_type_pv(numargs, "HANDLE", o, kid); } else { I32 flags = OPf_SPECIAL; @@ -11417,9 +11419,8 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) != OP_ANONCODE && cUNOPx(cUNOPx(o3)->op_first)->op_first->op_type != OP_RV2CV)) - bad_type_gv(arg, - arg == 1 ? "block or sub {}" : "sub {}", - namegv, 0, o3); + bad_type_gv(arg, namegv, o3, + arg == 1 ? "block or sub {}" : "sub {}"); break; case '*': /* '*' allows any scalar type, including bareword */ @@ -11474,9 +11475,8 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) OP_READ, /* not entersub */ OP_LVALUE_NO_CROAK )) goto wrapref; - bad_type_gv(arg, Perl_form(aTHX_ "one of %.*s", - (int)(end - p), p), - namegv, 0, o3); + bad_type_gv(arg, namegv, o3, + Perl_form(aTHX_ "one of %.*s",(int)(end - p), p)); } else goto oops; break; @@ -11484,15 +11484,14 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) if (o3->op_type == OP_RV2GV) goto wrapref; if (!contextclass) - bad_type_gv(arg, "symbol", namegv, 0, o3); + bad_type_gv(arg, namegv, o3, "symbol"); break; case '&': if (o3->op_type == OP_ENTERSUB && !(o3->op_flags & OPf_STACKED)) goto wrapref; if (!contextclass) - bad_type_gv(arg, "subroutine", namegv, 0, - o3); + bad_type_gv(arg, namegv, o3, "subroutine"); break; case '$': if (o3->op_type == OP_RV2SV || @@ -11507,7 +11506,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) OP_READ, /* not entersub */ OP_LVALUE_NO_CROAK )) goto wrapref; - bad_type_gv(arg, "scalar", namegv, 0, o3); + bad_type_gv(arg, namegv, o3, "scalar"); } break; case '@': @@ -11518,7 +11517,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) goto wrapref; } if (!contextclass) - bad_type_gv(arg, "array", namegv, 0, o3); + bad_type_gv(arg, namegv, o3, "array"); break; case '%': if (o3->op_type == OP_RV2HV || @@ -11528,7 +11527,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) goto wrapref; } if (!contextclass) - bad_type_gv(arg, "hash", namegv, 0, o3); + bad_type_gv(arg, namegv, o3, "hash"); break; wrapref: aop = S_op_sibling_newUNOP(aTHX_ parent, prev, diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 8e6706e..80bc261 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -161,6 +161,21 @@ A bug where, after an ithread creation or psuedofork, special/immortal SVs in the child ithread/psuedoprocess did not have the correct class of C<B::SPECIAL>, has been fixed. +The C<id> and C<outid> PADLIST methods have been added. + +=item * + +L<B::Deparse> has been upgraded from version 1.31 to 1.32. + +Deparsing C<BEGIN { undef &foo }> with the B<-w> switch enabled started to +emit 'uninitialized' warnings in Perl 5.14. This has been fixed. + +=item * + +L<Safe> has been upgraded from version 2.38 to 2.39. + +C<reval> was not propagating void context properly. + =back =head2 Removed Modules and Pragmata diff --git a/proto.h b/proto.h index b72c283..58724ac 100644 --- a/proto.h +++ b/proto.h @@ -6305,19 +6305,19 @@ STATIC void S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp STATIC I32 S_assignment_type(pTHX_ const OP *o) __attribute__warn_unused_result__; -STATIC void S_bad_type_gv(pTHX_ I32 n, const char *t, GV *gv, U32 flags, const OP *kid) +STATIC void S_bad_type_gv(pTHX_ I32 n, GV *gv, const OP *kid, const char *t) __attribute__nonnull__(pTHX_2) __attribute__nonnull__(pTHX_3) - __attribute__nonnull__(pTHX_5); + __attribute__nonnull__(pTHX_4); #define PERL_ARGS_ASSERT_BAD_TYPE_GV \ - assert(t); assert(gv); assert(kid) + assert(gv); assert(kid); assert(t) -STATIC void S_bad_type_pv(pTHX_ I32 n, const char *t, const char *name, U32 flags, const OP *kid) +STATIC void S_bad_type_pv(pTHX_ I32 n, const char *t, const OP *o, const OP *kid) __attribute__nonnull__(pTHX_2) __attribute__nonnull__(pTHX_3) - __attribute__nonnull__(pTHX_5); + __attribute__nonnull__(pTHX_4); #define PERL_ARGS_ASSERT_BAD_TYPE_PV \ - assert(t); assert(name); assert(kid) + assert(t); assert(o); assert(kid) STATIC void S_clear_special_blocks(pTHX_ const char *const fullname, GV *const gv, CV *const cv) __attribute__nonnull__(pTHX_1) -- Perl5 Master Repository
