From 4f62cd62aef0fcb9cc527c8aea4d04423189cfd5 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Mon, 19 Aug 2013 16:16:37 -0700 Subject: [PATCH] [perl #118693] Remove PADTMP exemption from uninit warnings MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This fixes a problem with undefined values return from XSUBs not pro- ducing such warnings. The default typemap for XSUBs uses the target of the entersub call (in the caller’s pad) to return the converted value, instead of having to allocate a new SV for that. So, for example, a function returning char* will cause that char* to be assigned to the target via sv_setpv. Then the target is returned. As a special case, NULL return from a char*-returning function will produce an undef return value. This undef return value was not trig- gering an uninitialized warning. All targets are marked PADTMP, and anything marked PADTMP is exempt from uninitialized warnings in some code paths, but not others. This goes all the way back to 91bba347, which suppressed the warning with only a hit at why (something to do with bitwise ops warning inap- propriately). I think it was to make ~undef exempt. But a1afd104 stopped it from being exempt. Only a few pieces of code were relying on this exemption, and it was hiding bugs, too. The last few commits have addressed those, so kiss this exemption good-bye! pp_reverse had a workaround to force an uninit warning (since 1e21d011c), so remove the workaround to avoid a double uninit warning. --- ext/XS-Typemap/Typemap.pm | 2 +- ext/XS-Typemap/Typemap.xs | 7 +++++++ ext/XS-Typemap/t/Typemap.t | 9 ++++++++- op.c | 3 ++- pp.c | 2 -- sv.c | 8 +++----- 6 files changed, 21 insertions(+), 10 deletions(-) diff --git a/ext/XS-Typemap/Typemap.pm b/ext/XS-Typemap/Typemap.pm index 7b83e1d04a21..de1cc6dff50b 100644 --- a/ext/XS-Typemap/Typemap.pm +++ b/ext/XS-Typemap/Typemap.pm @@ -66,7 +66,7 @@ $VERSION = '0.10'; T_FLOAT T_NV T_DOUBLE - T_PV + T_PV T_PV_null T_PTR_IN T_PTR_OUT T_PTRREF_IN T_PTRREF_OUT T_REF_IV_REF diff --git a/ext/XS-Typemap/Typemap.xs b/ext/XS-Typemap/Typemap.xs index dd34c39bd664..a43c843838aa 100644 --- a/ext/XS-Typemap/Typemap.xs +++ b/ext/XS-Typemap/Typemap.xs @@ -571,6 +571,13 @@ T_PV( in ) OUTPUT: RETVAL +char * +T_PV_null() + CODE: + RETVAL = NULL; + OUTPUT: + RETVAL + ## T_PTR diff --git a/ext/XS-Typemap/t/Typemap.t b/ext/XS-Typemap/t/Typemap.t index 07178011503e..ef22280b70ed 100644 --- a/ext/XS-Typemap/t/Typemap.t +++ b/ext/XS-Typemap/t/Typemap.t @@ -6,7 +6,7 @@ BEGIN { } } -use Test::More tests => 146; +use Test::More tests => 148; use strict; use warnings; @@ -211,6 +211,13 @@ is( sprintf("%6.3f",T_DOUBLE(52.345)), sprintf("%6.3f",52.345), "T_DOUBLE" ); note("T_PV"); is( T_PV("a string"), "a string"); is( T_PV(52), 52); +ok !defined T_PV_null, 'RETVAL = NULL returns undef for char*'; +{ + my $uninit; + local $SIG{__WARN__} = sub { ++$uninit if shift =~ /uninit/ }; + () = ''.T_PV_null; + is $uninit, 1, 'uninit warning from NULL returned from char* func'; +} # T_PTR my $t = 5; diff --git a/op.c b/op.c index c5964eb88f7d..c911b79f07a3 100644 --- a/op.c +++ b/op.c @@ -8903,9 +8903,10 @@ Perl_ck_fun(pTHX_ OP *o) SV *namesv; targ = pad_alloc(OP_RV2GV, SVf_READONLY); namesv = PAD_SVl(targ); - SvUPGRADE(namesv, SVt_PV); if (want_dollar && *name != '$') sv_setpvs(namesv, "$"); + else + sv_setpvs(namesv, ""); sv_catpvn(namesv, name, len); if ( name_utf8 ) SvUTF8_on(namesv); } diff --git a/pp.c b/pp.c index 8e5ba2be22e9..fd404536577c 100644 --- a/pp.c +++ b/pp.c @@ -5267,8 +5267,6 @@ PP(pp_reverse) do_join(TARG, &PL_sv_no, MARK, SP); else { sv_setsv(TARG, SP > MARK ? *SP : find_rundefsv()); - if (! SvOK(TARG) && ckWARN(WARN_UNINITIALIZED)) - report_uninit(TARG); } up = SvPV_force(TARG, len); diff --git a/sv.c b/sv.c index 7737eedcd62a..ea96a049f8fb 100644 --- a/sv.c +++ b/sv.c @@ -2274,10 +2274,8 @@ S_sv_2iuv_common(pTHX_ SV *const sv) if (isGV_with_GP(sv)) return glob_2number(MUTABLE_GV(sv)); - if (!SvPADTMP(sv)) { - if (!PL_localizing && ckWARN(WARN_UNINITIALIZED)) + if (!PL_localizing && ckWARN(WARN_UNINITIALIZED)) report_uninit(sv); - } if (SvTYPE(sv) < SVt_IV) /* Typically the caller expects that sv_any is not NULL now. */ sv_upgrade(sv, SVt_IV); @@ -2681,7 +2679,7 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags) return 0.0; } - if (!PL_localizing && !SvPADTMP(sv) && ckWARN(WARN_UNINITIALIZED)) + if (!PL_localizing && ckWARN(WARN_UNINITIALIZED)) report_uninit(sv); assert (SvTYPE(sv) >= SVt_NV); /* Typically the caller expects that sv_any is not NULL now. */ @@ -3025,7 +3023,7 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags) *lp = 0; if (flags & SV_UNDEF_RETURNS_NULL) return NULL; - if (!PL_localizing && !SvPADTMP(sv) && ckWARN(WARN_UNINITIALIZED)) + if (!PL_localizing && ckWARN(WARN_UNINITIALIZED)) report_uninit(sv); /* Typically the caller expects that sv_any is not NULL now. */ if (!SvREADONLY(sv) && SvTYPE(sv) < SVt_PV)