This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #118693] Remove PADTMP exemption from uninit warnings
authorFather Chrysostomos <sprout@cpan.org>
Mon, 19 Aug 2013 23:16:37 +0000 (16:16 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 20 Aug 2013 19:50:01 +0000 (12:50 -0700)
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
ext/XS-Typemap/Typemap.xs
ext/XS-Typemap/t/Typemap.t
op.c
pp.c
sv.c

index 7b83e1d..de1cc6d 100644 (file)
@@ -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
index dd34c39..a43c843 100644 (file)
@@ -571,6 +571,13 @@ T_PV( in )
  OUTPUT:
   RETVAL
 
+char *
+T_PV_null()
+ CODE:
+  RETVAL = NULL;
+ OUTPUT:
+  RETVAL
+
 
 ## T_PTR
 
index 0717801..ef22280 100644 (file)
@@ -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 c5964eb..c911b79 100644 (file)
--- 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 8e5ba2b..fd40453 100644 (file)
--- 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 7737eed..ea96a04 100644 (file)
--- 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)