#define FROMTOUPTO(src, dst, lim) do *dst++ = *src++; while(src<lim)
-/* Runs are identified by a pointer in the auxilliary list.
+/* Runs are identified by a pointer in the auxiliary list.
** The pointer is at the start of the list,
** and it points to the start of the next list.
** NEXT is used as an lvalue, too.
}
if (nmemb <= SMALLSORT) aux = small; /* use stack for aux array */
- else { Newx(aux,nmemb,gptr); } /* allocate auxilliary array */
+ else { Newx(aux,nmemb,gptr); } /* allocate auxiliary array */
level = 0;
stackp = stack;
stackp->runs = dynprep(aTHX_ base, aux, nmemb, cmp);
t = NEXT(t); /* where second run will end */
t = PINDEX(base, PNELEM(aux, t)); /* where it now ends */
FROMTOUPTO(f1, f2, t); /* copy both runs */
- NEXT(b) = p; /* paralled pointer for 1st */
+ NEXT(b) = p; /* paralleled pointer for 1st */
NEXT(p) = t; /* ... and for second */
}
}
return;
}
- /* Innoculate large partitions against quadratic behavior */
+ /* Inoculate large partitions against quadratic behavior */
if (num_elts > QSORT_PLAY_SAFE) {
register size_t n;
register SV ** const q = array;
q = list1;
for (n = nmemb; n--; ) {
/* Assert A: all elements of q with index > n are already
- * in place. This is vacuosly true at the start, and we
+ * in place. This is vacuously true at the start, and we
* put element n where it belongs below (if it wasn't
* already where it belonged). Assert B: we only move
* elements that aren't where they belong,
stash = CopSTASH(PL_curcop);
}
else {
- cv = sv_2cv(*++MARK, &stash, &gv, 0);
+ GV *autogv = NULL;
+ cv = sv_2cv(*++MARK, &stash, &gv, GV_ADD);
+ check_cv:
if (cv && SvPOK(cv)) {
const char * const proto = SvPV_nolen_const(MUTABLE_SV(cv));
if (proto && strEQ(proto, "$$")) {
hasargs = TRUE;
}
}
- if (!(cv && CvROOT(cv))) {
- if (cv && CvISXSUB(cv)) {
- is_xsub = 1;
+ if (cv && CvISXSUB(cv) && CvXSUB(cv)) {
+ is_xsub = 1;
+ }
+ else if (!(cv && CvROOT(cv))) {
+ if (gv) {
+ goto autoload;
}
- else if (gv) {
+ else if (!CvANON(cv) && (gv = CvGV(cv))) {
+ if (cv != GvCV(gv)) cv = GvCV(gv);
+ autoload:
+ if (!autogv && (
+ autogv = gv_autoload_pvn(
+ GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
+ GvNAMEUTF8(gv) ? SVf_UTF8 : 0
+ )
+ )) {
+ cv = GvCVu(autogv);
+ goto check_cv;
+ }
+ else {
SV *tmpstr = sv_newmortal();
gv_efullname3(tmpstr, gv, NULL);
DIE(aTHX_ "Undefined sort subroutine \"%"SVf"\" called",
SVfARG(tmpstr));
+ }
}
else {
DIE(aTHX_ "Undefined subroutine in sort");
const I32 oldsaveix = PL_savestack_ix;
const I32 oldscopeix = PL_scopestack_ix;
I32 result;
+ PMOP * const pm = PL_curpm;
+ OP * const sortop = PL_op;
+ COP * const cop = PL_curcop;
+ SV **pad;
PERL_ARGS_ASSERT_SORTCV;
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");
- result = SvIV(*PL_stack_sp);
+ 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;
while (PL_scopestack_ix > oldscopeix) {
LEAVE;
}
leave_scope(oldsaveix);
+ PL_curpm = pm;
return result;
}
const I32 oldscopeix = PL_scopestack_ix;
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;
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");
- result = SvIV(*PL_stack_sp);
+ 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;
while (PL_scopestack_ix > oldscopeix) {
LEAVE;
}
leave_scope(oldsaveix);
+ PL_curpm = pm;
return result;
}
const I32 oldscopeix = PL_scopestack_ix;
CV * const cv=MUTABLE_CV(PL_sortcop);
I32 result;
+ PMOP * const pm = PL_curpm;
PERL_ARGS_ASSERT_SORTCV_XSUB;
LEAVE;
}
leave_scope(oldsaveix);
+ PL_curpm = pm;
return result;
}
PERL_ARGS_ASSERT_SV_NCMP;
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+ if (Perl_isnan(nv1) || Perl_isnan(nv2)) {
+#else
+ if (nv1 != nv1 || nv2 != nv2) {
+#endif
+ if (ckWARN(WARN_UNINITIALIZED)) report_uninit(NULL);
+ return 0;
+ }
return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0;
}
#define tryCALL_AMAGICbin(left,right,meth) \
(SvAMAGIC(left)||SvAMAGIC(right)) \
- ? amagic_call(left, right, CAT2(meth,_amg), 0) \
+ ? amagic_call(left, right, meth, 0) \
: NULL;
#define SORT_NORMAL_RETURN_VALUE(val) (((val) > 0) ? 1 : ((val) ? -1 : 0))
S_amagic_ncmp(pTHX_ register SV *const a, register SV *const b)
{
dVAR;
- SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp);
+ SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
PERL_ARGS_ASSERT_AMAGIC_NCMP;
S_amagic_i_ncmp(pTHX_ register SV *const a, register SV *const b)
{
dVAR;
- SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp);
+ SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
PERL_ARGS_ASSERT_AMAGIC_I_NCMP;
S_amagic_cmp(pTHX_ register SV *const str1, register SV *const str2)
{
dVAR;
- SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp);
+ SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);
PERL_ARGS_ASSERT_AMAGIC_CMP;
S_amagic_cmp_locale(pTHX_ register SV *const str1, register SV *const str2)
{
dVAR;
- SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp);
+ SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);
PERL_ARGS_ASSERT_AMAGIC_CMP_LOCALE;