diff options
| -rw-r--r-- | cop.h | 19 | ||||
| -rw-r--r-- | embed.fnc | 4 | ||||
| -rw-r--r-- | ext/B/B.xs | 4 | ||||
| -rw-r--r-- | lib/warnings.pm | 2 | ||||
| -rw-r--r-- | mg.c | 4 | ||||
| -rw-r--r-- | op.c | 8 | ||||
| -rw-r--r-- | perl.h | 4 | ||||
| -rw-r--r-- | pp_ctl.c | 4 | ||||
| -rw-r--r-- | proto.h | 4 | ||||
| -rw-r--r-- | regen/warnings.pl | 15 | ||||
| -rw-r--r-- | scope.c | 2 | ||||
| -rw-r--r-- | sv.c | 2 | ||||
| -rw-r--r-- | utf8.c | 14 | ||||
| -rw-r--r-- | util.c | 15 | ||||
| -rw-r--r-- | warnings.h | 13 |
15 files changed, 46 insertions, 68 deletions
@@ -446,18 +446,13 @@ struct cop { #endif U32 cop_hints; /* hints bits from pragmata */ U32 cop_seq; /* parse sequence number */ - /* Beware. mg.c and warnings.pl assume the type of this is STRLEN *: */ - STRLEN * cop_warnings; /* Lexical warnings bitmask vector. - Munged copy of ${^WARNING_BITS}. - This is not actually an array of STRLEN, - it is a STRLEN followed by a certain - number of bytes, as determined by the - initial STRLEN. The pointer is either - to constant storage, or it is a rcpv - (refcounted string) style pointer similar - to cop_file under threads. The value - is read-only as it is shared amongst - many COP structures */ + char * cop_warnings; /* Lexical warnings bitmask vector. + Refcounted shared copy of ${^WARNING_BITS}. + This pointer either points at one of the + magic values for warnings, or it points + at a buffer constructed with rcpv_new(). + Use the RCPV_LEN() macro to get its length. + */ /* compile time state of %^H. See the comment in op.c for how this is used to recreate a hash to return from caller. */ COPHH * cop_hints_hash; @@ -3725,7 +3725,7 @@ S |bool |ckwarn_common |U32 w CpoP |bool |ckwarn |U32 w CpoP |bool |ckwarn_d |U32 w : FIXME - exported for ByteLoader - public or private? -XEopxR |STRLEN *|new_warnings_bitfield|NULLOK STRLEN *buffer \ +XEopxR |char *|new_warnings_bitfield|NULLOK char *buffer \ |NN const char *const bits|STRLEN size AMpTdf |int |my_snprintf |NN char *buffer|const Size_t len|NN const char *format|... @@ -3883,7 +3883,7 @@ XEop |void |dtrace_probe_op |NN const OP *op XEop |void |dtrace_probe_phase|enum perl_phase phase #endif -XEop |STRLEN*|dup_warnings |NULLOK STRLEN* warnings +XEop |char *|dup_warnings |NULLOK char* warnings #ifndef USE_ITHREADS Amd |void |CopFILEGV_set |NN COP * c|NN GV * gv diff --git a/ext/B/B.xs b/ext/B/B.xs index b3d441db81..b7f763d347 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -188,7 +188,7 @@ make_temp_object(pTHX_ SV *temp) static SV * make_warnings_object(pTHX_ const COP *const cop) { - const STRLEN *const warnings = cop->cop_warnings; + const char *const warnings = cop->cop_warnings; const char *type = 0; dMY_CXT; IV iv = sizeof(specialsv_list)/sizeof(SV*); @@ -210,7 +210,7 @@ make_warnings_object(pTHX_ const COP *const cop) } else { /* B assumes that warnings are a regular SV. Seems easier to keep it happy by making them into a regular SV. */ - return make_temp_object(aTHX_ newSVpvn((char *)(warnings + 1), *warnings)); + return make_temp_object(aTHX_ newSVpvn(warnings, RCPV_LEN(warnings))); } } diff --git a/lib/warnings.pm b/lib/warnings.pm index 38a6b602c5..8931215ab0 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -5,7 +5,7 @@ package warnings; -our $VERSION = "1.60"; +our $VERSION = "1.61"; # Verify that we're called correctly so that warnings will work. # Can't use Carp, since Carp uses us! @@ -1082,8 +1082,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) sv_setpvn(sv, WARN_ALLstring, WARNsize); } else { - sv_setpvn(sv, (char *) (PL_compiling.cop_warnings + 1), - *PL_compiling.cop_warnings); + sv_setpvn(sv, PL_compiling.cop_warnings, + RCPV_LEN(PL_compiling.cop_warnings)); } } break; @@ -1331,7 +1331,7 @@ S_cop_free(pTHX_ COP* cop) } CopFILE_free(cop); if (! specialWARN(cop->cop_warnings)) - cop->cop_warnings = (STRLEN*)rcpv_free((char*)cop->cop_warnings); + cop->cop_warnings = rcpv_free(cop->cop_warnings); cophh_free(CopHINTHASH_get(cop)); if (PL_curcop == cop) @@ -15230,13 +15230,13 @@ const_av_xsub(pTHX_ CV* cv) * This is the e implementation for the DUP_WARNINGS() macro */ -STRLEN* -Perl_dup_warnings(pTHX_ STRLEN* warnings) +char * +Perl_dup_warnings(pTHX_ char* warnings) { if (warnings == NULL || specialWARN(warnings)) return warnings; - return (STRLEN*)rcpv_copy((char*)warnings); + return rcpv_copy(warnings); } /* @@ -5405,9 +5405,9 @@ Indices outside the range 0..31 result in (bad) undedefined behavior. EXTCONST char PL_hexdigit[] INIT("0123456789abcdef0123456789ABCDEF"); -EXTCONST STRLEN PL_WARN_ALL +EXT char PL_WARN_ALL INIT(0); -EXTCONST STRLEN PL_WARN_NONE +EXT char PL_WARN_NONE INIT(0); /* This is constant on most architectures, a global on OS/2 */ @@ -2074,7 +2074,7 @@ PP(pp_caller) mPUSHi(CopHINTS_get(cx->blk_oldcop)); { SV * mask ; - STRLEN * const old_warnings = cx->blk_oldcop->cop_warnings ; + char *old_warnings = cx->blk_oldcop->cop_warnings; if (old_warnings == pWARN_NONE) mask = newSVpvn(WARN_NONEstring, WARNsize) ; @@ -2085,7 +2085,7 @@ PP(pp_caller) mask = newSVpvn(WARN_ALLstring, WARNsize) ; } else - mask = newSVpvn((char *) (old_warnings + 1), old_warnings[0]); + mask = newSVpvn(old_warnings, RCPV_LEN(old_warnings)); mPUSHs(mask); } @@ -1219,7 +1219,7 @@ PERL_CALLCONV void Perl_dump_sub_perl(pTHX_ const GV* gv, bool justperl) PERL_CALLCONV void Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args); #define PERL_ARGS_ASSERT_DUMP_VINDENT \ assert(file); assert(pat) -PERL_CALLCONV STRLEN* Perl_dup_warnings(pTHX_ STRLEN* warnings); +PERL_CALLCONV char * Perl_dup_warnings(pTHX_ char* warnings); #define PERL_ARGS_ASSERT_DUP_WARNINGS PERL_CALLCONV void Perl_emulate_cop_io(pTHX_ const COP *const c, SV *const sv); #define PERL_ARGS_ASSERT_EMULATE_COP_IO \ @@ -2954,7 +2954,7 @@ PERL_CALLCONV PERL_SI* Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems) PERL_CALLCONV SV* Perl_new_version(pTHX_ SV *ver); #define PERL_ARGS_ASSERT_NEW_VERSION \ assert(ver) -PERL_CALLCONV STRLEN * Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const char *const bits, STRLEN size) +PERL_CALLCONV char * Perl_new_warnings_bitfield(pTHX_ char *buffer, const char *const bits, STRLEN size) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_NEW_WARNINGS_BITFIELD \ assert(bits) diff --git a/regen/warnings.pl b/regen/warnings.pl index f7622a6bba..55b98bc6f6 100644 --- a/regen/warnings.pl +++ b/regen/warnings.pl @@ -16,7 +16,7 @@ # # This script is normally invoked from regen.pl. -$VERSION = '1.60'; +$VERSION = '1.61'; BEGIN { require './regen/regen_lib.pl'; @@ -541,7 +541,6 @@ sub warnings_h_boilerplate_1 { return <<'EOM'; } #define Perl_Warn_Bit_(x) (1 << ((x) % 8)) #define PerlWarnIsSet_(a, x) ((a)[Perl_Warn_Off_(x)] & Perl_Warn_Bit_(x)) - #define G_WARN_OFF 0 /* $^W == 0 */ #define G_WARN_ON 1 /* -w flag and $^W != 0 */ #define G_WARN_ALL_ON 2 /* -W flag */ @@ -550,8 +549,8 @@ sub warnings_h_boilerplate_1 { return <<'EOM'; } #define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF) #define pWARN_STD NULL -#define pWARN_ALL (STRLEN *) &PL_WARN_ALL /* use warnings 'all' */ -#define pWARN_NONE (STRLEN *) &PL_WARN_NONE /* no warnings 'all' */ +#define pWARN_ALL &PL_WARN_ALL /* use warnings 'all' */ +#define pWARN_NONE &PL_WARN_NONE /* no warnings 'all' */ #define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL || \ (x) == pWARN_NONE) @@ -569,18 +568,18 @@ sub warnings_h_boilerplate_2 { return <<'EOM'; } #define isLEXWARN_off \ cBOOL(!PL_curcop || PL_curcop->cop_warnings == pWARN_STD) #define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE)) -#define hasWARNBIT(c,x) ((c)[0] > (2*(x)/8)) +#define hasWARNBIT(c,x) (RCPV_LEN(c) > (2*(x)/8)) #define isWARN_on(c,x) (hasWARNBIT(c,x) \ - ? PerlWarnIsSet_((U8 *)((c) + 1), 2*(x)) \ + ? PerlWarnIsSet_((U8 *)(c), 2*(x)) \ : 0) #define isWARNf_on(c,x) (hasWARNBIT(c,x) \ - ? PerlWarnIsSet_((U8 *)((c) + 1), 2*(x)+1) \ + ? PerlWarnIsSet_((U8 *)(c), 2*(x)+1) \ : 0) #define DUP_WARNINGS(p) Perl_dup_warnings(aTHX_ p) #define free_and_set_cop_warnings(cmp,w) STMT_START { \ - if (!specialWARN((cmp)->cop_warnings)) rcpv_free((char*)((cmp)->cop_warnings)); \ + if (!specialWARN((cmp)->cop_warnings)) rcpv_free((cmp)->cop_warnings); \ (cmp)->cop_warnings = w; \ } STMT_END @@ -1640,7 +1640,7 @@ Perl_leave_scope(pTHX_ I32 base) case SAVEt_COMPILE_WARNINGS: a0 = ap[0]; a1 = ap[1]; - free_and_set_cop_warnings((COP*)a0.any_ptr, (STRLEN*)a1.any_ptr); + free_and_set_cop_warnings((COP*)a0.any_ptr, a1.any_pv); break; case SAVEt_PARSER: @@ -15336,7 +15336,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param) break; case SAVEt_COMPILE_WARNINGS: ptr = POPPTR(ss,ix); - TOPPTR(nss,ix) = DUP_WARNINGS((STRLEN*)ptr); + TOPPTR(nss,ix) = DUP_WARNINGS((char*)ptr); break; case SAVEt_PARSER: ptr = POPPTR(ss,ix); @@ -45,17 +45,6 @@ characters in the ASCII range are unmodified, and a zero byte never appears within non-zero characters. */ -/* helper for Perl__force_out_malformed_utf8_message(). Like - * SAVECOMPILEWARNINGS(), but works with PL_curcop rather than - * PL_compiling */ - -static void -S_restore_cop_warnings(pTHX_ void *p) -{ - free_and_set_cop_warnings(PL_curcop, (STRLEN*) p); -} - - void Perl__force_out_malformed_utf8_message(pTHX_ const U8 *const p, /* First byte in UTF-8 sequence */ @@ -89,8 +78,7 @@ Perl__force_out_malformed_utf8_message(pTHX_ if (PL_curcop) { /* this is like SAVECOMPILEWARNINGS() except with PL_curcop rather * than PL_compiling */ - SAVEDESTRUCTOR_X(S_restore_cop_warnings, - (void*)PL_curcop->cop_warnings); + SAVECOPWARNINGS(PL_curcop); PL_curcop->cop_warnings = pWARN_ALL; } @@ -2382,20 +2382,17 @@ S_ckwarn_common(pTHX_ U32 w) return FALSE; } -/* Set buffer=NULL to get a new one. */ -STRLEN * -Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const char *const bits, +char * +Perl_new_warnings_bitfield(pTHX_ char *buffer, const char *const bits, STRLEN size) { - const MEM_SIZE len_wanted = - sizeof(STRLEN) + (size > WARNsize ? size : WARNsize); + const MEM_SIZE len_wanted = (size > WARNsize ? size : WARNsize); PERL_UNUSED_CONTEXT; PERL_ARGS_ASSERT_NEW_WARNINGS_BITFIELD; - buffer = (STRLEN*)rcpv_new(NULL, len_wanted, RCPVf_NO_COPY); - buffer[0] = size; - Copy(bits, (buffer + 1), size, char); + buffer = rcpv_new(buffer, len_wanted, RCPVf_NO_COPY); + Copy(bits, buffer, size, char); if (size < WARNsize) - Zero((char *)(buffer + 1) + size, WARNsize - size, char); + Zero(buffer + size, WARNsize - size, char); return buffer; } diff --git a/warnings.h b/warnings.h index 751f221a8d..f06f65911f 100644 --- a/warnings.h +++ b/warnings.h @@ -9,7 +9,6 @@ #define Perl_Warn_Bit_(x) (1 << ((x) % 8)) #define PerlWarnIsSet_(a, x) ((a)[Perl_Warn_Off_(x)] & Perl_Warn_Bit_(x)) - #define G_WARN_OFF 0 /* $^W == 0 */ #define G_WARN_ON 1 /* -w flag and $^W != 0 */ #define G_WARN_ALL_ON 2 /* -W flag */ @@ -18,8 +17,8 @@ #define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF) #define pWARN_STD NULL -#define pWARN_ALL (STRLEN *) &PL_WARN_ALL /* use warnings 'all' */ -#define pWARN_NONE (STRLEN *) &PL_WARN_NONE /* no warnings 'all' */ +#define pWARN_ALL &PL_WARN_ALL /* use warnings 'all' */ +#define pWARN_NONE &PL_WARN_NONE /* no warnings 'all' */ #define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL || \ (x) == pWARN_NONE) @@ -141,18 +140,18 @@ #define isLEXWARN_off \ cBOOL(!PL_curcop || PL_curcop->cop_warnings == pWARN_STD) #define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE)) -#define hasWARNBIT(c,x) ((c)[0] > (2*(x)/8)) +#define hasWARNBIT(c,x) (RCPV_LEN(c) > (2*(x)/8)) #define isWARN_on(c,x) (hasWARNBIT(c,x) \ - ? PerlWarnIsSet_((U8 *)((c) + 1), 2*(x)) \ + ? PerlWarnIsSet_((U8 *)(c), 2*(x)) \ : 0) #define isWARNf_on(c,x) (hasWARNBIT(c,x) \ - ? PerlWarnIsSet_((U8 *)((c) + 1), 2*(x)+1) \ + ? PerlWarnIsSet_((U8 *)(c), 2*(x)+1) \ : 0) #define DUP_WARNINGS(p) Perl_dup_warnings(aTHX_ p) #define free_and_set_cop_warnings(cmp,w) STMT_START { \ - if (!specialWARN((cmp)->cop_warnings)) rcpv_free((char*)((cmp)->cop_warnings)); \ + if (!specialWARN((cmp)->cop_warnings)) rcpv_free((cmp)->cop_warnings); \ (cmp)->cop_warnings = w; \ } STMT_END |