This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Implement the fc keyword and the \F string escape.
[perl5.git]
/
pp_sort.c
diff --git
a/pp_sort.c
b/pp_sort.c
index
d527d1e
..
364a6a0
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;
I32 result;
PMOP * const pm = PL_curpm;
OP * const sortop = PL_op;
+ COP * const cop = PL_curcop;
SV **pad;
PERL_ARGS_ASSERT_SORTCV;
SV **pad;
PERL_ARGS_ASSERT_SORTCV;
@@
-1774,11
+1775,14
@@
S_sortcv(pTHX_ SV *const a, SV *const b)
PL_stack_sp = PL_stack_base;
PL_op = PL_sortcop;
CALLRUNOPS(aTHX);
PL_stack_sp = PL_stack_base;
PL_op = PL_sortcop;
CALLRUNOPS(aTHX);
- if (PL_stack_sp != PL_stack_base + 1)
- Perl_croak(aTHX_ "Sort subroutine didn't return single value");
PL_op = sortop;
PL_op = sortop;
+ PL_curcop = cop;
pad = PL_curpad; PL_curpad = 0;
pad = PL_curpad; PL_curpad = 0;
- result = SvIV(*PL_stack_sp);
+ 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;
while (PL_scopestack_ix > oldscopeix) {
LEAVE;
PL_curpad = pad;
while (PL_scopestack_ix > oldscopeix) {
LEAVE;
@@
-1798,6
+1802,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;
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;
SV **pad;
PERL_ARGS_ASSERT_SORTCV_STACKED;
@@
-1827,11
+1832,14
@@
S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
PL_stack_sp = PL_stack_base;
PL_op = PL_sortcop;
CALLRUNOPS(aTHX);
PL_stack_sp = PL_stack_base;
PL_op = PL_sortcop;
CALLRUNOPS(aTHX);
- if (PL_stack_sp != PL_stack_base + 1)
- Perl_croak(aTHX_ "Sort subroutine didn't return single value");
PL_op = sortop;
PL_op = sortop;
+ PL_curcop = cop;
pad = PL_curpad; PL_curpad = 0;
pad = PL_curpad; PL_curpad = 0;
- result = SvIV(*PL_stack_sp);
+ 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;
while (PL_scopestack_ix > oldscopeix) {
LEAVE;
PL_curpad = pad;
while (PL_scopestack_ix > oldscopeix) {
LEAVE;
@@
-1881,7
+1889,7
@@
S_sv_ncmp(pTHX_ SV *const a, SV *const b)
PERL_ARGS_ASSERT_SV_NCMP;
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
PERL_ARGS_ASSERT_SV_NCMP;
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
- if (Perl_isnan(
right) || Perl_isnan(left
)) {
+ if (Perl_isnan(
nv1) || Perl_isnan(nv2
)) {
#else
if (nv1 != nv1 || nv2 != nv2) {
#endif
#else
if (nv1 != nv1 || nv2 != nv2) {
#endif