Make sort’s warnings dependent on the right hints

sort’s warnings about uninitialized (or non-numeric) values returned
from comparison routines are emitted in the scope of the compar-
ison routine, not the sort function itself.  So, not only does
‘use warnings; sort...’ not always warn, but the line numbers can be
off, too:

$ ./perl -Ilib -e '()=sort flobbp 1,2;' -e'use warnings;sub flobbp{"foo"}'
Argument "foo" isn't numeric in sort at -e line 2.

The solution is to restore PL_curcop to its previous value before get-
ting a number out of the comparison routine’s return value.

diff --git a/pp_sort.c b/pp_sort.c
index da014e8..6c2e301 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1765,6 +1765,7 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     I32 result;
     PMOP * const pm = PL_curpm;
     OP * const sortop = PL_op;
+    COP * const cop = PL_curcop;
     SV **pad;
  
     PERL_ARGS_ASSERT_SORTCV;
@@ -1777,6 +1778,7 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     if (PL_stack_sp != PL_stack_base + 1)
        Perl_croak(aTHX_ "Sort subroutine didn't return single value");
     PL_op = sortop;
+    PL_curcop = cop;
     pad = PL_curpad; PL_curpad = 0;
     result = SvIV(*PL_stack_sp);
     PL_curpad = pad;
@@ -1798,6 +1800,7 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
     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;
@@ -1830,6 +1833,7 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
     if (PL_stack_sp != PL_stack_base + 1)
        Perl_croak(aTHX_ "Sort subroutine didn't return single value");
     PL_op = sortop;
+    PL_curcop = cop;
     pad = PL_curpad; PL_curpad = 0;
     result = SvIV(*PL_stack_sp);
     PL_curpad = pad;

diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit
index 495f570..e0c7320 100644 (file)
--- a/t/lib/warnings/9uninit
+++ b/t/lib/warnings/9uninit
@@ -635,6 +635,11 @@ sub sortf {$a-1 <=> $b-1};
 @sort = sort { undef } 1, 2;
 sub frobnicate($$) { undef }
 @sort = sort frobnicate 1, 2;
+@sort = sort pyfg 1, 2;
+@sort = sort pyfgc 1, 2;
+no warnings;
+sub pyfg { undef }
+sub pyfgc($$) { undef }
 EXPECT
 Use of uninitialized value $m1 in sort at - line 6.
 Use of uninitialized value $g1 in sort at - line 6.
@@ -653,7 +658,9 @@ Use of uninitialized value $m1 in sort at - line 9.
 Use of uninitialized value $g1 in sort at - line 9.
 Use of uninitialized value $g1 in sort at - line 9.
 Use of uninitialized value in sort at - line 10.
-Use of uninitialized value in sort at - line 11.
+Use of uninitialized value in sort at - line 12.
+Use of uninitialized value in sort at - line 13.
+Use of uninitialized value in sort at - line 14.
 ########
 my $nan = sin 9**9**9;
 if ($nan == $nan) {