/* This file is part of the "version" CPAN distribution. Please avoid
editing it in the perl core. */
+#ifdef PERL_CORE
+# include "vutil.h"
+#endif
+
#define VERSION_MAX 0x7FFFFFFF
/*
=cut
*/
const char *
+#ifdef VUTIL_REPLACE_CORE
+Perl_prescan_version2(pTHX_ const char *s, bool strict,
+#else
Perl_prescan_version(pTHX_ const char *s, bool strict,
+#endif
const char **errstr,
bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha) {
bool qv = (sqv ? *sqv : FALSE);
const char *d = s;
PERL_ARGS_ASSERT_PRESCAN_VERSION;
+ PERL_UNUSED_CONTEXT;
if (qv && isDIGIT(*d))
goto dotted_decimal_version;
/* trailing non-numeric data */
BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
}
+ if (saw_decimal > 1 && d[-1] == '.') {
+ /* no trailing period allowed */
+ BADVERSION(s,errstr,"Invalid version format (trailing decimal)");
+ }
+
if (sqv)
*sqv = qv;
*/
const char *
+#ifdef VUTIL_REPLACE_CORE
+Perl_scan_version2(pTHX_ const char *s, SV *rv, bool qv)
+#else
Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
+#endif
{
const char *start = s;
const char *pos;
while (isSPACE(*s)) /* leading whitespace is OK */
s++;
- last = prescan_version(s, FALSE, &errstr, &qv, &saw_decimal, &width, &alpha);
+ last = PRESCAN_VERSION(s, FALSE, &errstr, &qv, &saw_decimal, &width, &alpha);
if (errstr) {
/* "undef" is a special case and not an error */
- if ( ! ( *s == 'u' && strEQ(s,"undef")) ) {
- Safefree(start);
+ if ( ! ( *s == 'u' && strEQ(s+1,"ndef")) ) {
Perl_croak(aTHX_ "%s", errstr);
}
}
if ( !qv && width < 3 )
(void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
- while (isDIGIT(*pos))
+ while (isDIGIT(*pos) || *pos == '_')
pos++;
if (!isALPHA(*pos)) {
I32 rev;
if ( !qv && s > start && saw_decimal == 1 ) {
mult *= 100;
while ( s < end ) {
+ if (*s == '_')
+ continue;
orev = rev;
rev += (*s - '0') * mult;
mult /= 10;
}
else {
while (--end >= s) {
- orev = rev;
- rev += (*end - '0') * mult;
- mult *= 10;
- if ( (PERL_ABS(orev) > PERL_ABS(rev))
- || (PERL_ABS(rev) > VERSION_MAX )) {
+ int i;
+ if (*end == '_')
+ continue;
+ i = (*end - '0');
+ if ( (mult == VERSION_MAX)
+ || (i > VERSION_MAX / mult)
+ || (i * mult > VERSION_MAX - rev))
+ {
Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
"Integer overflow in version");
end = s - 1;
rev = VERSION_MAX;
vinf = 1;
}
+ else
+ rev += i * mult;
+
+ if (mult > VERSION_MAX / 10)
+ mult = VERSION_MAX;
+ else
+ mult *= 10;
}
}
}
s = last;
break;
}
- else if ( *pos == '.' )
- s = ++pos;
+ else if ( *pos == '.' ) {
+ pos++;
+ if (qv) {
+ while (*pos == '0')
+ ++pos;
+ }
+ s = pos;
+ }
else if ( *pos == '_' && isDIGIT(pos[1]) )
s = ++pos;
else if ( *pos == ',' && isDIGIT(pos[1]) )
break;
}
if ( qv ) {
- while ( isDIGIT(*pos) )
+ while ( isDIGIT(*pos) || *pos == '_')
pos++;
}
else {
}
}
if ( qv ) { /* quoted versions always get at least three terms*/
- SSize_t len = av_len(av);
+ SSize_t len = AvFILLp(av);
/* This for loop appears to trigger a compiler bug on OS X, as it
loops infinitely. Yes, len is negative. No, it makes no sense.
Compiler in question is:
(void)hv_stores(MUTABLE_HV(hv), "version", newRV_noinc(MUTABLE_SV(av)));
/* fix RT#19517 - special case 'undef' as string */
- if ( *s == 'u' && strEQ(s,"undef") ) {
+ if ( *s == 'u' && strEQ(s+1,"ndef") ) {
s += 5;
}
*/
SV *
+#ifdef VUTIL_REPLACE_CORE
+Perl_new_version2(pTHX_ SV *ver)
+#else
Perl_new_version(pTHX_ SV *ver)
+#endif
{
- dVAR;
SV * const rv = newSV(0);
PERL_ARGS_ASSERT_NEW_VERSION;
- if ( sv_isobject(ver) && sv_derived_from(ver, "version") )
- /* can just copy directly */
+ if ( ISA_VERSION_OBJ(ver) ) /* can just copy directly */
{
SSize_t key;
AV * const av = newAV();
if ( hv_exists(MUTABLE_HV(ver), "alpha", 5) )
(void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(1));
-
- if ( hv_exists(MUTABLE_HV(ver), "width", 5 ) )
{
- const I32 width = SvIV(*hv_fetchs(MUTABLE_HV(ver), "width", FALSE));
- (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
+ SV ** svp = hv_fetchs(MUTABLE_HV(ver), "width", FALSE);
+ if(svp) {
+ const I32 width = SvIV(*svp);
+ (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
+ }
}
-
- if ( hv_exists(MUTABLE_HV(ver), "original", 8 ) )
{
- SV * pv = *hv_fetchs(MUTABLE_HV(ver), "original", FALSE);
- (void)hv_stores(MUTABLE_HV(hv), "original", newSVsv(pv));
+ SV ** svp = hv_fetchs(MUTABLE_HV(ver), "original", FALSE);
+ if(svp)
+ (void)hv_stores(MUTABLE_HV(hv), "original", newSVsv(*svp));
}
-
sav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(ver), "version", FALSE)));
/* This will get reblessed later if a derived class*/
for ( key = 0; key <= av_len(sav); key++ )
{
- const I32 rev = SvIV(*av_fetch(sav, key, FALSE));
+ SV * const sv = *av_fetch(sav, key, FALSE);
+ const I32 rev = SvIV(sv);
av_push(av, newSViv(rev));
}
const MAGIC* const mg = SvVSTRING_mg(ver);
if ( mg ) { /* already a v-string */
const STRLEN len = mg->mg_len;
- char * const version = savepvn( (const char*)mg->mg_ptr, len);
+ const char * const version = (const char*)mg->mg_ptr;
+ char *raw, *under;
+ static const char underscore[] = "_";
sv_setpvn(rv,version,len);
+ raw = SvPV_nolen(rv);
+ under = ninstr(raw, raw+len, underscore, underscore + 1);
+ if (under) {
+ Move(under + 1, under, raw + len - under - 1, char);
+ SvCUR(rv)--;
+ *SvEND(rv) = '\0';
+ }
/* this is for consistency with the pure Perl class */
if ( isDIGIT(*version) )
sv_insert(rv, 0, 0, "v", 1);
- Safefree(version);
}
else {
#endif
- sv_setsv(rv,ver); /* make a duplicate */
+ SvSetSV_nosteal(rv, ver); /* make a duplicate */
#ifdef SvVOK
}
}
#endif
- return upg_version(rv, FALSE);
+ sv_2mortal(rv); /* in case upg_version croaks before it returns */
+ return SvREFCNT_inc_NN(UPG_VERSION(rv, FALSE));
}
/*
*/
SV *
+#ifdef VUTIL_REPLACE_CORE
+Perl_upg_version2(pTHX_ SV *ver, bool qv)
+#else
Perl_upg_version(pTHX_ SV *ver, bool qv)
+#endif
{
const char *version, *s;
#ifdef SvVOK
const MAGIC *mg;
#endif
+#if PERL_VERSION_LT(5,19,8) && defined(USE_ITHREADS)
+ ENTER;
+#endif
PERL_ARGS_ASSERT_UPG_VERSION;
- if ( SvNOK(ver) && !( SvPOK(ver) && sv_len(ver) == 3 ) )
+ if ( (SvUOK(ver) && SvUVX(ver) > VERSION_MAX)
+ || (SvIOK(ver) && SvIVX(ver) > VERSION_MAX) ) {
+ /* out of bounds [unsigned] integer */
+ STRLEN len;
+ char tbuf[64];
+ len = my_snprintf(tbuf, sizeof(tbuf), "%d", VERSION_MAX);
+ version = savepvn(tbuf, len);
+ SAVEFREEPV(version);
+ Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+ "Integer overflow in version %d",VERSION_MAX);
+ }
+ else if ( SvUOK(ver) || SvIOK(ver))
+#if PERL_VERSION_LT(5,17,2)
+VER_IV:
+#endif
+ {
+ version = savesvpv(ver);
+ SAVEFREEPV(version);
+ }
+ else if (SvNOK(ver) && !( SvPOK(ver) && SvCUR(ver) == 3 ) )
+#if PERL_VERSION_LT(5,17,2)
+VER_NV:
+#endif
{
STRLEN len;
char tbuf[64];
SV *sv = SvNVX(ver) > 10e50 ? newSV(64) : 0;
char *buf;
+
+#if PERL_VERSION_GE(5,19,0)
+ if (SvPOK(ver)) {
+ /* dualvar? */
+ goto VER_PV;
+ }
+#endif
#ifdef USE_LOCALE_NUMERIC
- char *loc = NULL;
- if (! PL_numeric_standard) {
- loc = savepv(setlocale(LC_NUMERIC, NULL));
- setlocale(LC_NUMERIC, "C");
+
+ {
+ /* This may or may not be called from code that has switched
+ * locales without letting perl know, therefore we have to find it
+ * from first principals. See [perl #121930]. */
+
+ /* In windows, or not threaded, or not thread-safe, if it isn't C,
+ * set it to C. */
+
+# ifndef USE_POSIX_2008_LOCALE
+
+ const char * locale_name_on_entry;
+
+ LC_NUMERIC_LOCK(0); /* Start critical section */
+
+ locale_name_on_entry = setlocale(LC_NUMERIC, NULL);
+ if ( strNE(locale_name_on_entry, "C")
+ && strNE(locale_name_on_entry, "POSIX"))
+ {
+ setlocale(LC_NUMERIC, "C");
+ }
+ else { /* This value indicates to the restore code that we didn't
+ change the locale */
+ locale_name_on_entry = NULL;
+ }
+
+# else
+
+ const locale_t locale_obj_on_entry = uselocale((locale_t) 0);
+ const char * locale_name_on_entry = NULL;
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+
+ if (locale_obj_on_entry == LC_GLOBAL_LOCALE) {
+
+ /* in the global locale, we can call system setlocale and if it
+ * isn't C, set it to C. */
+ LC_NUMERIC_LOCK(0);
+
+ locale_name_on_entry = setlocale(LC_NUMERIC, NULL);
+ if ( strNE(locale_name_on_entry, "C")
+ && strNE(locale_name_on_entry, "POSIX"))
+ {
+ setlocale(LC_NUMERIC, "C");
+ }
+ else { /* This value indicates to the restore code that we
+ didn't change the locale */
+ locale_name_on_entry = NULL;
+ }
}
+ else if (locale_obj_on_entry == PL_underlying_numeric_obj) {
+ /* Here, the locale appears to have been changed to use the
+ * program's underlying locale. Just use our mechanisms to
+ * switch back to C. It might be possible for this pointer to
+ * actually refer to something else if it got released and
+ * reused somehow. But it doesn't matter, our mechanisms will
+ * work even so */
+ STORE_LC_NUMERIC_SET_STANDARD();
+ }
+ else if (locale_obj_on_entry != PL_C_locale_obj) {
+ /* The C object should be unchanged during a program's
+ * execution, so it should be safe to assume it means what it
+ * says, so if we are in it, no locale change is required.
+ * Otherwise, simply use the thread-safe operation. */
+ uselocale(PL_C_locale_obj);
+ }
+
+# endif
+
+ /* Prevent recursed calls from trying to change back */
+ LOCK_LC_NUMERIC_STANDARD();
+
#endif
+
if (sv) {
- Perl_sv_setpvf(aTHX_ sv, "%.9"NVff, SvNVX(ver));
- buf = SvPV(sv, len);
+ Perl_sv_catpvf(aTHX_ sv, "%.9" NVff, SvNVX(ver));
+ len = SvCUR(sv);
+ buf = SvPVX(sv);
}
else {
- len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVff, SvNVX(ver));
+ len = my_snprintf(tbuf, sizeof(tbuf), "%.9" NVff, SvNVX(ver));
buf = tbuf;
}
+
#ifdef USE_LOCALE_NUMERIC
- if (loc) {
- setlocale(LC_NUMERIC, loc);
- Safefree(loc);
- }
-#endif
+
+ UNLOCK_LC_NUMERIC_STANDARD();
+
+# ifndef USE_POSIX_2008_LOCALE
+
+ if (locale_name_on_entry) {
+ setlocale(LC_NUMERIC, locale_name_on_entry);
+ }
+
+ LC_NUMERIC_UNLOCK; /* End critical section */
+
+# else
+
+ if (locale_name_on_entry) {
+ setlocale(LC_NUMERIC, locale_name_on_entry);
+ LC_NUMERIC_UNLOCK;
+ }
+ else if (locale_obj_on_entry == PL_underlying_numeric_obj) {
+ RESTORE_LC_NUMERIC();
+ }
+ else if (locale_obj_on_entry != PL_C_locale_obj) {
+ uselocale(locale_obj_on_entry);
+ }
+
+# endif
+
+ }
+
+#endif /* USE_LOCALE_NUMERIC */
+
while (buf[len-1] == '0' && len > 0) len--;
if ( buf[len-1] == '.' ) len--; /* eat the trailing decimal */
version = savepvn(buf, len);
+ SAVEFREEPV(version);
SvREFCNT_dec(sv);
}
#ifdef SvVOK
else if ( (mg = SvVSTRING_mg(ver)) ) { /* already a v-string */
version = savepvn( (const char*)mg->mg_ptr,mg->mg_len );
+ SAVEFREEPV(version);
qv = TRUE;
}
#endif
- else /* must be a string or something like a string */
+ else if ( SvPOK(ver))/* must be a string or something like a string */
+VER_PV:
{
STRLEN len;
- version = savepv(SvPV(ver,len));
+ version = savepvn(SvPV(ver,len), SvCUR(ver));
+ SAVEFREEPV(version);
#ifndef SvVOK
# if PERL_VERSION > 5
/* This will only be executed for 5.6.0 - 5.8.0 inclusive */
int saw_decimal = 0;
sv_setpvf(nsv,"v%vd",ver);
pos = nver = savepv(SvPV_nolen(nsv));
+ SAVEFREEPV(pos);
/* scan the resulting formatted string */
pos++; /* skip the leading 'v' */
/* is definitely a v-string */
if ( saw_decimal >= 2 ) {
- Safefree(version);
version = nver;
}
break;
# endif
#endif
}
+#if PERL_VERSION_LT(5,17,2)
+ else if (SvIOKp(ver)) {
+ goto VER_IV;
+ }
+ else if (SvNOKp(ver)) {
+ goto VER_NV;
+ }
+ else if (SvPOKp(ver)) {
+ goto VER_PV;
+ }
+#endif
+ else
+ {
+ /* no idea what this is */
+ Perl_croak(aTHX_ "Invalid version format (non-numeric data)");
+ }
- s = scan_version(version, ver, qv);
+ s = SCAN_VERSION(version, ver, qv);
if ( *s != '\0' )
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
"Version string '%s' contains invalid data; "
"ignoring: '%s'", version, s);
- Safefree(version);
+
+#if PERL_VERSION_LT(5,19,8) && defined(USE_ITHREADS)
+ LEAVE;
+#endif
+
return ver;
}
*/
SV *
+#ifdef VUTIL_REPLACE_CORE
+Perl_vverify2(pTHX_ SV *vs)
+#else
Perl_vverify(pTHX_ SV *vs)
+#endif
{
SV *sv;
+ SV **svp;
PERL_ARGS_ASSERT_VVERIFY;
/* see if the appropriate elements exist */
if ( SvTYPE(vs) == SVt_PVHV
- && hv_exists(MUTABLE_HV(vs), "version", 7)
- && (sv = SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE)))
+ && (svp = hv_fetchs(MUTABLE_HV(vs), "version", FALSE))
+ && (sv = SvRV(*svp))
&& SvTYPE(sv) == SVt_PVAV )
return vs;
else
*/
SV *
+#ifdef VUTIL_REPLACE_CORE
+Perl_vnumify2(pTHX_ SV *vs)
+#else
Perl_vnumify(pTHX_ SV *vs)
+#endif
{
SSize_t i, len;
I32 digit;
- int width;
bool alpha = FALSE;
SV *sv;
AV *av;
PERL_ARGS_ASSERT_VNUMIFY;
/* extract the HV from the object */
- vs = vverify(vs);
+ vs = VVERIFY(vs);
if ( ! vs )
Perl_croak(aTHX_ "Invalid version object");
/* see if various flags exist */
if ( hv_exists(MUTABLE_HV(vs), "alpha", 5 ) )
alpha = TRUE;
- if ( hv_exists(MUTABLE_HV(vs), "width", 5 ) )
- width = SvIV(*hv_fetchs(MUTABLE_HV(vs), "width", FALSE));
- else
- width = 3;
+ if (alpha) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_NUMERIC),
+ "alpha->numify() is lossy");
+ }
/* attempt to retrieve the version array */
if ( !(av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE))) ) ) {
return newSVpvs("0");
}
- digit = SvIV(*av_fetch(av, 0, 0));
- sv = Perl_newSVpvf(aTHX_ "%d.", (int)PERL_ABS(digit));
- for ( i = 1 ; i < len ; i++ )
{
- digit = SvIV(*av_fetch(av, i, 0));
- if ( width < 3 ) {
- const int denom = (width == 2 ? 10 : 100);
- const div_t term = div((int)PERL_ABS(digit),denom);
- Perl_sv_catpvf(aTHX_ sv, "%0*d_%d", width, term.quot, term.rem);
- }
- else {
- Perl_sv_catpvf(aTHX_ sv, "%0*d", width, (int)digit);
- }
+ SV * tsv = *av_fetch(av, 0, 0);
+ digit = SvIV(tsv);
}
-
- if ( len > 0 )
+ sv = Perl_newSVpvf(aTHX_ "%d.", (int)PERL_ABS(digit));
+ for ( i = 1 ; i <= len ; i++ )
{
- digit = SvIV(*av_fetch(av, len, 0));
- if ( alpha && width == 3 ) /* alpha version */
- sv_catpvs(sv,"_");
- Perl_sv_catpvf(aTHX_ sv, "%0*d", width, (int)digit);
+ SV * tsv = *av_fetch(av, i, 0);
+ digit = SvIV(tsv);
+ Perl_sv_catpvf(aTHX_ sv, "%03d", (int)digit);
}
- else /* len == 0 */
- {
+
+ if ( len == 0 ) {
sv_catpvs(sv, "000");
}
return sv;
*/
SV *
+#ifdef VUTIL_REPLACE_CORE
+Perl_vnormal2(pTHX_ SV *vs)
+#else
Perl_vnormal(pTHX_ SV *vs)
+#endif
{
I32 i, len, digit;
- bool alpha = FALSE;
SV *sv;
AV *av;
PERL_ARGS_ASSERT_VNORMAL;
/* extract the HV from the object */
- vs = vverify(vs);
+ vs = VVERIFY(vs);
if ( ! vs )
Perl_croak(aTHX_ "Invalid version object");
- if ( hv_exists(MUTABLE_HV(vs), "alpha", 5 ) )
- alpha = TRUE;
av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE)));
len = av_len(av);
{
return newSVpvs("");
}
- digit = SvIV(*av_fetch(av, 0, 0));
- sv = Perl_newSVpvf(aTHX_ "v%"IVdf, (IV)digit);
- for ( i = 1 ; i < len ; i++ ) {
- digit = SvIV(*av_fetch(av, i, 0));
- Perl_sv_catpvf(aTHX_ sv, ".%"IVdf, (IV)digit);
- }
-
- if ( len > 0 )
{
- /* handle last digit specially */
- digit = SvIV(*av_fetch(av, len, 0));
- if ( alpha )
- Perl_sv_catpvf(aTHX_ sv, "_%"IVdf, (IV)digit);
- else
- Perl_sv_catpvf(aTHX_ sv, ".%"IVdf, (IV)digit);
+ SV * tsv = *av_fetch(av, 0, 0);
+ digit = SvIV(tsv);
+ }
+ sv = Perl_newSVpvf(aTHX_ "v%" IVdf, (IV)digit);
+ for ( i = 1 ; i <= len ; i++ ) {
+ SV * tsv = *av_fetch(av, i, 0);
+ digit = SvIV(tsv);
+ Perl_sv_catpvf(aTHX_ sv, ".%" IVdf, (IV)digit);
}
if ( len <= 2 ) { /* short version, must be at least three */
*/
SV *
+#ifdef VUTIL_REPLACE_CORE
+Perl_vstringify2(pTHX_ SV *vs)
+#else
Perl_vstringify(pTHX_ SV *vs)
+#endif
{
+ SV ** svp;
PERL_ARGS_ASSERT_VSTRINGIFY;
/* extract the HV from the object */
- vs = vverify(vs);
+ vs = VVERIFY(vs);
if ( ! vs )
Perl_croak(aTHX_ "Invalid version object");
- if (hv_exists(MUTABLE_HV(vs), "original", sizeof("original") - 1)) {
+ svp = hv_fetchs(MUTABLE_HV(vs), "original", FALSE);
+ if (svp) {
SV *pv;
- pv = *hv_fetchs(MUTABLE_HV(vs), "original", FALSE);
- if ( SvPOK(pv) )
+ pv = *svp;
+ if ( SvPOK(pv)
+#if PERL_VERSION_LT(5,17,2)
+ || SvPOKp(pv)
+#endif
+ )
return newSVsv(pv);
else
return &PL_sv_undef;
}
else {
if ( hv_exists(MUTABLE_HV(vs), "qv", 2) )
- return vnormal(vs);
+ return VNORMAL(vs);
else
- return vnumify(vs);
+ return VNUMIFY(vs);
}
}
*/
int
+#ifdef VUTIL_REPLACE_CORE
+Perl_vcmp2(pTHX_ SV *lhv, SV *rhv)
+#else
Perl_vcmp(pTHX_ SV *lhv, SV *rhv)
+#endif
{
SSize_t i,l,m,r;
I32 retval;
- bool lalpha = FALSE;
- bool ralpha = FALSE;
I32 left = 0;
I32 right = 0;
AV *lav, *rav;
PERL_ARGS_ASSERT_VCMP;
/* extract the HVs from the objects */
- lhv = vverify(lhv);
- rhv = vverify(rhv);
+ lhv = VVERIFY(lhv);
+ rhv = VVERIFY(rhv);
if ( ! ( lhv && rhv ) )
Perl_croak(aTHX_ "Invalid version object");
/* get the left hand term */
lav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(lhv), "version", FALSE)));
- if ( hv_exists(MUTABLE_HV(lhv), "alpha", 5 ) )
- lalpha = TRUE;
/* and the right hand term */
rav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(rhv), "version", FALSE)));
- if ( hv_exists(MUTABLE_HV(rhv), "alpha", 5 ) )
- ralpha = TRUE;
l = av_len(lav);
r = av_len(rav);
i = 0;
while ( i <= m && retval == 0 )
{
- left = SvIV(*av_fetch(lav,i,0));
- right = SvIV(*av_fetch(rav,i,0));
+ SV * const lsv = *av_fetch(lav,i,0);
+ SV * rsv;
+ left = SvIV(lsv);
+ rsv = *av_fetch(rav,i,0);
+ right = SvIV(rsv);
if ( left < right )
retval = -1;
if ( left > right )
i++;
}
- /* tiebreaker for alpha with identical terms */
- if ( retval == 0 && l == r && left == right && ( lalpha || ralpha ) )
- {
- if ( lalpha && !ralpha )
- {
- retval = -1;
- }
- else if ( ralpha && !lalpha)
- {
- retval = +1;
- }
- }
-
if ( l != r && retval == 0 ) /* possible match except for trailing 0's */
{
if ( l < r )
{
while ( i <= r && retval == 0 )
{
- if ( SvIV(*av_fetch(rav,i,0)) != 0 )
+ SV * const rsv = *av_fetch(rav,i,0);
+ if ( SvIV(rsv) != 0 )
retval = -1; /* not a match after all */
i++;
}
{
while ( i <= l && retval == 0 )
{
- if ( SvIV(*av_fetch(lav,i,0)) != 0 )
+ SV * const lsv = *av_fetch(lav,i,0);
+ if ( SvIV(lsv) != 0 )
retval = +1; /* not a match after all */
i++;
}
}
return retval;
}
+
+/* ex: set ro: */
https://perl5.git.perl.org / perl5.git / blobdiff