This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
sort fns: simplify handing uninit warnings
authorDavid Mitchell <davem@iabyn.com>
Tue, 2 Jun 2015 13:59:46 +0000 (14:59 +0100)
committerDavid Mitchell <davem@iabyn.com>
Fri, 19 Jun 2015 07:44:17 +0000 (08:44 +0100)
When a sort function or code block returns an undef value (rather than the
typical -1,0,-1), you get the usual "Use of uninitialized value" warning.

Originally the message didn't say " ... in sort" because at the end of
running a sort sub, PL_op is NULL rather rather than pointing at the sort
op.

v5.15.3-364-gd4c6760 changed the sort sub return code in S_sortcv() et al
to temporarily set PL_op to point to the sort OP, which made
Perl_report_uninit() emit the desired " in sort" suffix.

However, this meant that PL_op and PL_curpad briefly referenced two
different CVs; since Perl_report_uninit() rummages around in pads looking
for lexicals, consts etc, this could lead to SEGVs.

v5.15.3-372-g1aa032b fixed that by temporarily setting PL_curpad to NULL
at the same time. However that then caused problems if the code dies
(e.g. if warnings are upgraded to errors) since the old PL_curpad value
wasn't being restored.

v5.17.6-7-g2f43ddf fixed that by wrapping the PL_curpad=NULL with
appropriate ENTER/SAVEVPTR(PL_curpad)/..../LEAVE where necessary.

However, this is starting to get quite complex, and in a hot piece of
code, and the 3 sort functions S_sortcv/S_sortcv_stacked/S_sortcv_xsub
are all diverging from each other in subtle and confusing ways.

This commit takes a different approach. It effectively reverts those three
commits (apart from the tests) and instead updates Perl_report_uninit()
to say "if PL_op is NULL, but the context stack indicates that we're
currently in a sort, then append " in sort" to the warning.

This is a lot less messy, and moves all the clutter from the two hot
functions S_sortcv/S_sortcv_stacked into a function that is only called
when we're emitting warnings.

pp_sort.c
sv.c

index d21a4ea..3203f4c 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1771,9 +1771,7 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     const I32 oldsaveix = PL_savestack_ix;
     const I32 oldscopeix = PL_scopestack_ix;
     I32 result;
-    SV *resultsv;
     PMOP * const pm = PL_curpm;
-    OP * const sortop = PL_op;
     COP * const cop = PL_curcop;
  
     PERL_ARGS_ASSERT_SORTCV;
@@ -1783,21 +1781,14 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     PL_stack_sp = PL_stack_base;
     PL_op = PL_sortcop;
     CALLRUNOPS(aTHX);
-    PL_op = sortop;
     PL_curcop = cop;
     if (PL_stack_sp != PL_stack_base + 1) {
        assert(PL_stack_sp == PL_stack_base);
-       resultsv = &PL_sv_undef;
-    }
-    else resultsv = *PL_stack_sp;
-    if (SvNIOK_nog(resultsv)) result = SvIV(resultsv);
-    else {
-       ENTER;
-       SAVEVPTR(PL_curpad);
-       PL_curpad = 0;
-       result = SvIV(resultsv);
-       LEAVE;
+       result = SvIV(&PL_sv_undef);
     }
+    else
+        result = SvIV(*PL_stack_sp);
+
     while (PL_scopestack_ix > oldscopeix) {
        LEAVE;
     }
@@ -1814,9 +1805,7 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
     I32 result;
     AV * const av = GvAV(PL_defgv);
     PMOP * const pm = PL_curpm;
-    OP * const sortop = PL_op;
     COP * const cop = PL_curcop;
-    SV **pad;
 
     PERL_ARGS_ASSERT_SORTCV_STACKED;
 
@@ -1845,15 +1834,14 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
     PL_stack_sp = PL_stack_base;
     PL_op = PL_sortcop;
     CALLRUNOPS(aTHX);
-    PL_op = sortop;
     PL_curcop = cop;
-    pad = PL_curpad; PL_curpad = 0;
     if (PL_stack_sp != PL_stack_base + 1) {
        assert(PL_stack_sp == PL_stack_base);
        result = SvIV(&PL_sv_undef);
     }
-    else result = SvIV(*PL_stack_sp);
-    PL_curpad = pad;
+    else
+        result = SvIV(*PL_stack_sp);
+
     while (PL_scopestack_ix > oldscopeix) {
        LEAVE;
     }
diff --git a/sv.c b/sv.c
index 500c233..0990be2 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -16213,6 +16213,14 @@ Perl_report_uninit(pTHX_ const SV *uninit_sv)
                sv_insert(varname, 0, 0, " ", 1);
        }
     }
+    else if (PL_curstackinfo->si_type == PERLSI_SORT
+             &&  CxMULTICALL(&cxstack[cxstack_ix]))
+    {
+        /* we've reached the end of a sort block or sub,
+         * and the uninit value is probably what that code returned */
+        desc = "sort";
+    }
+
     /* PL_warn_uninit_sv is constant */
     GCC_DIAG_IGNORE(-Wformat-nonliteral);
     if (desc)