#define SORTf_DESC 1
#define SORTf_STABLE 2
#define SORTf_QSORT 4
+#define SORTf_UNSTABLE 8
/*
* The mergesort implementation is by Peter M. Mcilroy <pmcilroy@lucent.com>.
}
done:
if (aux != small) Safefree(aux); /* free iff allocated */
- if (flags) {
+ if (savecmp != NULL) {
PL_sort_RealCmp = savecmp; /* Restore current comparison routine, if any */
}
return;
size_t n;
SV ** const q = array;
for (n = num_elts; n > 1; ) {
- const size_t j = (size_t)(n-- * Drand01());
+ const size_t j = (size_t)(n-- * Perl_internal_drand48());
temp = q[j];
q[j] = q[n];
q[n] = temp;
=for apidoc sortsv
-Sort an array. Here is an example:
-
- sortsv(AvARRAY(av), av_top_index(av)+1, Perl_sv_cmp_locale);
+In-place sort an array of SV pointers with the given comparison routine.
Currently this always uses mergesort. See C<L</sortsv_flags>> for a more
flexible routine.
/*
=for apidoc sortsv_flags
-Sort an array, with various options.
+In-place sort an array of SV pointers with the given comparison routine,
+with various SORTf_* flag options.
=cut
*/
sort_flags |= SORTf_QSORT;
if ((priv & OPpSORT_STABLE) != 0)
sort_flags |= SORTf_STABLE;
+ if ((priv & OPpSORT_UNSTABLE) != 0)
+ sort_flags |= SORTf_UNSTABLE;
if (gimme != G_ARRAY) {
SP = MARK;
else {
SV *tmpstr = sv_newmortal();
gv_efullname3(tmpstr, gv, NULL);
- DIE(aTHX_ "Undefined sort subroutine \"%"SVf"\" called",
+ DIE(aTHX_ "Undefined sort subroutine \"%" SVf "\" called",
SVfARG(tmpstr));
}
}
/* shuffle stack down, removing optional initial cv (p1!=p2), plus
* any nulls; also stringify or converting to integer or number as
* required any args */
- copytmps = PL_sortcop;
+ copytmps = cBOOL(PL_sortcop);
for (i=max; i > 0 ; i--) {
if ((*p1 = *p2++)) { /* Weed out nulls. */
if (copytmps && SvPADTMP(*p1)) {
base[i] = newSVsv(sv);
else
SvREFCNT_inc_simple_void_NN(sv);
+
+ if (SvWEAKREF(sv))
+ sv_rvunweaken(sv);
}
av_clear(av);
if (max > 0) {
AvARRAY(av) = ary;
}
if (AvMAX(av) < 1) {
- AvMAX(av) = 1;
Renew(ary,2,SV*);
+ AvMAX(av) = 1;
AvARRAY(av) = ary;
AvALLOC(av) = ary;
}
static I32
S_sv_ncmp(pTHX_ SV *const a, SV *const b)
{
- const NV nv1 = SvNSIV(a);
- const NV nv2 = SvNSIV(b);
+ I32 cmp = do_ncmp(a, b);
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 (cmp == 2) {
if (ckWARN(WARN_UNINITIALIZED)) report_uninit(NULL);
return 0;
}
- return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0;
+
+ return cmp;
}
static I32