* by the original comparison routine on the elements pointed to.
* Because we don't move the elements of list1 around through
* this phase, we can break ties on elements that compare equal
- * using their address in the list1 array, ensuring stabilty.
+ * using their address in the list1 array, ensuring stability.
* This leaves us with something looking like
*
* indir list1
}
else {
if (SvREADONLY(av))
- Perl_croak(aTHX_ "%s", PL_no_modify);
+ Perl_croak_no_modify(aTHX);
else
SvREADONLY_on(av);
p1 = p2 = AvARRAY(av);
if (!PL_sortcop) {
if (priv & OPpSORT_NUMERIC) {
if (priv & OPpSORT_INTEGER) {
- if (!SvIOK(*p1)) {
- if (SvAMAGIC(*p1))
- overloading = 1;
- else
- (void)sv_2iv(*p1);
- }
+ if (!SvIOK(*p1))
+ (void)sv_2iv_flags(*p1, SV_GMAGIC|SV_SKIP_OVERLOAD);
}
else {
- if (!SvNSIOK(*p1)) {
- if (SvAMAGIC(*p1))
- overloading = 1;
- else
- (void)sv_2nv(*p1);
- }
+ if (!SvNSIOK(*p1))
+ (void)sv_2nv_flags(*p1, SV_GMAGIC|SV_SKIP_OVERLOAD);
if (all_SIVs && !SvSIOK(*p1))
all_SIVs = 0;
}
}
else {
- if (!SvPOK(*p1)) {
- if (SvAMAGIC(*p1))
- overloading = 1;
- else
- (void)sv_2pv_flags(*p1, 0,
- SV_GMAGIC|SV_CONST_RETURN);
- }
+ if (!SvPOK(*p1))
+ (void)sv_2pv_flags(*p1, 0,
+ SV_GMAGIC|SV_CONST_RETURN|SV_SKIP_OVERLOAD);
}
+ if (SvAMAGIC(*p1))
+ overloading = 1;
}
p1++;
}
if (!(flags & OPf_SPECIAL)) {
cx->cx_type = CXt_SUB;
cx->blk_gimme = G_SCALAR;
+ /* If our comparison routine is already active (CvDEPTH is
+ * is not 0), then PUSHSUB does not increase the refcount,
+ * so we have to do it ourselves, because the LEAVESUB fur-
+ * ther down lowers it. */
+ if (CvDEPTH(cv)) SvREFCNT_inc_simple_void_NN(cv);
PUSHSUB(cx);
if (!is_xsub) {
AV* const padlist = CvPADLIST(cv);
sort_flags);
if (!(flags & OPf_SPECIAL)) {
- LEAVESUB(cv);
- if (!is_xsub)
- CvDEPTH(cv)--;
+ SV *sv;
+ POPSUB(cx, sv);
+ LEAVESUB(sv);
}
POPBLOCK(cx,PL_curpm);
PL_stack_sp = newsp;
CALLRUNOPS(aTHX);
if (PL_stack_sp != PL_stack_base + 1)
Perl_croak(aTHX_ "Sort subroutine didn't return single value");
- if (!SvNIOKp(*PL_stack_sp))
- Perl_croak(aTHX_ "Sort subroutine didn't return a numeric value");
result = SvIV(*PL_stack_sp);
while (PL_scopestack_ix > oldscopeix) {
LEAVE;
PERL_ARGS_ASSERT_SORTCV_STACKED;
+ if (AvREAL(av)) {
+ av_clear(av);
+ AvREAL_off(av);
+ AvREIFY_on(av);
+ }
if (AvMAX(av) < 1) {
- SV** ary = AvALLOC(av);
+ SV **ary = AvALLOC(av);
if (AvARRAY(av) != ary) {
AvMAX(av) += AvARRAY(av) - AvALLOC(av);
AvARRAY(av) = ary;
AvMAX(av) = 1;
Renew(ary,2,SV*);
AvARRAY(av) = ary;
+ AvALLOC(av) = ary;
}
}
AvFILLp(av) = 1;
CALLRUNOPS(aTHX);
if (PL_stack_sp != PL_stack_base + 1)
Perl_croak(aTHX_ "Sort subroutine didn't return single value");
- if (!SvNIOKp(*PL_stack_sp))
- Perl_croak(aTHX_ "Sort subroutine didn't return a numeric value");
result = SvIV(*PL_stack_sp);
while (PL_scopestack_ix > oldscopeix) {
LEAVE;
(void)(*CvXSUB(cv))(aTHX_ cv);
if (PL_stack_sp != PL_stack_base + 1)
Perl_croak(aTHX_ "Sort subroutine didn't return single value");
- if (!SvNIOKp(*PL_stack_sp))
- Perl_croak(aTHX_ "Sort subroutine didn't return a numeric value");
result = SvIV(*PL_stack_sp);
while (PL_scopestack_ix > oldscopeix) {
LEAVE;
}
#define tryCALL_AMAGICbin(left,right,meth) \
- (PL_amagic_generation && (SvAMAGIC(left)||SvAMAGIC(right))) \
+ (SvAMAGIC(left)||SvAMAGIC(right)) \
? amagic_call(left, right, CAT2(meth,_amg), 0) \
: NULL;