1 /* This file is part of the "version" CPAN distribution. Please avoid
2 editing it in the perl core. */
8 #define VERSION_MAX 0x7FFFFFFF
11 =for apidoc prescan_version
13 Validate that a given string can be parsed as a version object, but doesn't
14 actually perform the parsing. Can use either strict or lax validation rules.
15 Can optionally set a number of hint variables to save the parsing code
16 some time when tokenizing.
21 #ifdef VUTIL_REPLACE_CORE
22 Perl_prescan_version2(pTHX_ const char *s, bool strict,
24 Perl_prescan_version(pTHX_ const char *s, bool strict,
27 bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha) {
28 bool qv = (sqv ? *sqv : FALSE);
34 PERL_ARGS_ASSERT_PRESCAN_VERSION;
37 if (qv && isDIGIT(*d))
38 goto dotted_decimal_version;
40 if (*d == 'v') { /* explicit v-string */
45 else { /* degenerate v-string */
47 BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
50 dotted_decimal_version:
51 if (strict && d[0] == '0' && isDIGIT(d[1])) {
52 /* no leading zeros allowed */
53 BADVERSION(s,errstr,"Invalid version format (no leading zeros)");
56 while (isDIGIT(*d)) /* integer part */
62 d++; /* decimal point */
68 BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
71 goto version_prescan_finish;
78 while (isDIGIT(*d)) { /* just keep reading */
82 /* maximum 3 digits between decimal */
83 if (strict && j > 3) {
84 BADVERSION(s,errstr,"Invalid version format (maximum 3 digits between decimals)");
89 BADVERSION(s,errstr,"Invalid version format (no underscores)");
92 BADVERSION(s,errstr,"Invalid version format (multiple underscores)");
99 BADVERSION(s,errstr,"Invalid version format (underscores before decimal)");
104 else if (!isDIGIT(*d)) {
110 if (strict && i < 2) {
111 /* requires v1.2.3 */
112 BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
115 } /* end if dotted-decimal */
117 { /* decimal versions */
118 int j = 0; /* may need this later */
119 /* special strict case for leading '.' or '0' */
122 BADVERSION(s,errstr,"Invalid version format (0 before decimal required)");
124 if (*d == '0' && isDIGIT(d[1])) {
125 BADVERSION(s,errstr,"Invalid version format (no leading zeros)");
129 /* and we never support negative versions */
131 BADVERSION(s,errstr,"Invalid version format (negative version number)");
134 /* consume all of the integer part */
138 /* look for a fractional part */
140 /* we found it, so consume it */
144 else if (!*d || *d == ';' || isSPACE(*d) || *d == '{' || *d == '}') {
147 BADVERSION(s,errstr,"Invalid version format (version required)");
149 /* found just an integer */
150 goto version_prescan_finish;
153 /* didn't find either integer or period */
154 BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
156 else if (*d == '_') {
157 /* underscore can't come after integer part */
159 BADVERSION(s,errstr,"Invalid version format (no underscores)");
161 else if (isDIGIT(d[1])) {
162 BADVERSION(s,errstr,"Invalid version format (alpha without decimal)");
165 BADVERSION(s,errstr,"Invalid version format (misplaced underscore)");
169 /* anything else after integer part is just invalid data */
170 BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
173 /* scan the fractional part after the decimal point*/
175 if (!isDIGIT(*d) && (strict || ! (!*d || *d == ';' || isSPACE(*d) || *d == '{' || *d == '}') )) {
176 /* strict or lax-but-not-the-end */
177 BADVERSION(s,errstr,"Invalid version format (fractional part required)");
180 while (isDIGIT(*d)) {
182 if (*d == '.' && isDIGIT(d[-1])) {
184 BADVERSION(s,errstr,"Invalid version format (underscores before decimal)");
187 BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions must begin with 'v')");
189 d = (char *)s; /* start all over again */
191 goto dotted_decimal_version;
195 BADVERSION(s,errstr,"Invalid version format (no underscores)");
198 BADVERSION(s,errstr,"Invalid version format (multiple underscores)");
200 if ( ! isDIGIT(d[1]) ) {
201 BADVERSION(s,errstr,"Invalid version format (misplaced underscore)");
210 version_prescan_finish:
214 if (!isDIGIT(*d) && (! (!*d || *d == ';' || *d == '{' || *d == '}') )) {
215 /* trailing non-numeric data */
216 BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
218 if (saw_decimal > 1 && d[-1] == '.') {
219 /* no trailing period allowed */
220 BADVERSION(s,errstr,"Invalid version format (trailing decimal)");
229 *ssaw_decimal = saw_decimal;
236 =for apidoc scan_version
238 Returns a pointer to the next character after the parsed
239 version string, as well as upgrading the passed in SV to
242 Function must be called with an already existing SV like
245 s = scan_version(s, SV *sv, bool qv);
247 Performs some preprocessing to the string to ensure that
248 it has the correct characteristics of a version. Flags the
249 object if it contains an underscore (which denotes this
250 is an alpha version). The boolean qv denotes that the version
251 should be interpreted as if it had multiple decimals, even if
258 #ifdef VUTIL_REPLACE_CORE
259 Perl_scan_version2(pTHX_ const char *s, SV *rv, bool qv)
261 Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
264 const char *start = s;
267 const char *errstr = NULL;
275 PERL_ARGS_ASSERT_SCAN_VERSION;
277 while (isSPACE(*s)) /* leading whitespace is OK */
280 last = PRESCAN_VERSION(s, FALSE, &errstr, &qv, &saw_decimal, &width, &alpha);
282 /* "undef" is a special case and not an error */
283 if ( ! ( *s == 'u' && strEQ(s+1,"ndef")) ) {
284 Perl_croak(aTHX_ "%s", errstr);
293 /* Now that we are through the prescan, start creating the object */
295 hv = newSVrv(rv, "version"); /* create an SV and upgrade the RV */
296 (void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
298 #ifndef NODEFAULT_SHAREKEYS
299 HvSHAREKEYS_on(hv); /* key-sharing on by default */
303 (void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(qv));
305 (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(alpha));
306 if ( !qv && width < 3 )
307 (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
309 while (isDIGIT(*pos) || *pos == '_')
311 if (!isALPHA(*pos)) {
317 /* this is atoi() that delimits on underscores */
318 const char *end = pos;
322 /* the following if() will only be true after the decimal
323 * point of a version originally created with a bare
324 * floating point number, i.e. not quoted in any way
326 if ( !qv && s > start && saw_decimal == 1 ) {
332 rev += (*s - '0') * mult;
334 if ( (PERL_ABS(orev) > PERL_ABS(rev))
335 || (PERL_ABS(rev) > VERSION_MAX )) {
336 Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
337 "Integer overflow in version %d",VERSION_MAX);
353 if ( (mult == VERSION_MAX)
354 || (i > VERSION_MAX / mult)
355 || (i * mult > VERSION_MAX - rev))
357 Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
358 "Integer overflow in version");
366 if (mult > VERSION_MAX / 10)
374 /* Append revision */
375 av_push(av, newSViv(rev));
380 else if ( *pos == '.' ) {
388 else if ( *pos == '_' && isDIGIT(pos[1]) )
390 else if ( *pos == ',' && isDIGIT(pos[1]) )
392 else if ( isDIGIT(*pos) )
399 while ( isDIGIT(*pos) || *pos == '_')
404 while ( ( isDIGIT(*pos) || *pos == '_' ) && digits < 3 ) {
412 if ( qv ) { /* quoted versions always get at least three terms*/
413 SSize_t len = AvFILLp(av);
414 /* This for loop appears to trigger a compiler bug on OS X, as it
415 loops infinitely. Yes, len is negative. No, it makes no sense.
416 Compiler in question is:
417 gcc version 3.3 20030304 (Apple Computer, Inc. build 1640)
418 for ( len = 2 - len; len > 0; len-- )
419 av_push(MUTABLE_AV(sv), newSViv(0));
423 av_push(av, newSViv(0));
426 /* need to save off the current version string for later */
428 SV * orig = newSVpvn("v.Inf", sizeof("v.Inf")-1);
429 (void)hv_stores(MUTABLE_HV(hv), "original", orig);
430 (void)hv_stores(MUTABLE_HV(hv), "vinf", newSViv(1));
432 else if ( s > start ) {
433 SV * orig = newSVpvn(start,s-start);
434 if ( qv && saw_decimal == 1 && *start != 'v' ) {
435 /* need to insert a v to be consistent */
436 sv_insert(orig, 0, 0, "v", 1);
438 (void)hv_stores(MUTABLE_HV(hv), "original", orig);
441 (void)hv_stores(MUTABLE_HV(hv), "original", newSVpvs("0"));
442 av_push(av, newSViv(0));
445 /* And finally, store the AV in the hash */
446 (void)hv_stores(MUTABLE_HV(hv), "version", newRV_noinc(MUTABLE_SV(av)));
448 /* fix RT#19517 - special case 'undef' as string */
449 if ( *s == 'u' && strEQ(s+1,"ndef") ) {
457 =for apidoc new_version
459 Returns a new version object based on the passed in SV:
461 SV *sv = new_version(SV *ver);
463 Does not alter the passed in ver SV. See "upg_version" if you
464 want to upgrade the SV.
470 #ifdef VUTIL_REPLACE_CORE
471 Perl_new_version2(pTHX_ SV *ver)
473 Perl_new_version(pTHX_ SV *ver)
476 SV * const rv = newSV(0);
477 PERL_ARGS_ASSERT_NEW_VERSION;
478 if ( ISA_VERSION_OBJ(ver) ) /* can just copy directly */
481 AV * const av = newAV();
483 /* This will get reblessed later if a derived class*/
484 SV * const hv = newSVrv(rv, "version");
485 (void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
486 #ifndef NODEFAULT_SHAREKEYS
487 HvSHAREKEYS_on(hv); /* key-sharing on by default */
493 /* Begin copying all of the elements */
494 if ( hv_exists(MUTABLE_HV(ver), "qv", 2) )
495 (void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(1));
497 if ( hv_exists(MUTABLE_HV(ver), "alpha", 5) )
498 (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(1));
500 SV ** svp = hv_fetchs(MUTABLE_HV(ver), "width", FALSE);
502 const I32 width = SvIV(*svp);
503 (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
507 SV ** svp = hv_fetchs(MUTABLE_HV(ver), "original", FALSE);
509 (void)hv_stores(MUTABLE_HV(hv), "original", newSVsv(*svp));
511 sav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(ver), "version", FALSE)));
512 /* This will get reblessed later if a derived class*/
513 for ( key = 0; key <= av_len(sav); key++ )
515 SV * const sv = *av_fetch(sav, key, FALSE);
516 const I32 rev = SvIV(sv);
517 av_push(av, newSViv(rev));
520 (void)hv_stores(MUTABLE_HV(hv), "version", newRV_noinc(MUTABLE_SV(av)));
525 const MAGIC* const mg = SvVSTRING_mg(ver);
526 if ( mg ) { /* already a v-string */
527 const STRLEN len = mg->mg_len;
528 const char * const version = (const char*)mg->mg_ptr;
530 static const char underscore[] = "_";
531 sv_setpvn(rv,version,len);
532 raw = SvPV_nolen(rv);
533 under = ninstr(raw, raw+len, underscore, underscore + 1);
535 Move(under + 1, under, raw + len - under - 1, char);
536 SvCUR_set(rv, SvCUR(rv) - 1);
539 /* this is for consistency with the pure Perl class */
540 if ( isDIGIT(*version) )
541 sv_insert(rv, 0, 0, "v", 1);
545 SvSetSV_nosteal(rv, ver); /* make a duplicate */
550 sv_2mortal(rv); /* in case upg_version croaks before it returns */
551 return SvREFCNT_inc_NN(UPG_VERSION(rv, FALSE));
555 =for apidoc upg_version
557 In-place upgrade of the supplied SV to a version object.
559 SV *sv = upg_version(SV *sv, bool qv);
561 Returns a pointer to the upgraded SV. Set the boolean qv if you want
562 to force this SV to be interpreted as an "extended" version.
568 #ifdef VUTIL_REPLACE_CORE
569 Perl_upg_version2(pTHX_ SV *ver, bool qv)
571 Perl_upg_version(pTHX_ SV *ver, bool qv)
579 const char *version, *s;
584 #if PERL_VERSION_LT(5,19,8) && defined(USE_ITHREADS)
587 PERL_ARGS_ASSERT_UPG_VERSION;
589 if ( (SvUOK(ver) && SvUVX(ver) > VERSION_MAX)
590 || (SvIOK(ver) && SvIVX(ver) > VERSION_MAX) ) {
591 /* out of bounds [unsigned] integer */
594 len = my_snprintf(tbuf, sizeof(tbuf), "%d", VERSION_MAX);
595 version = savepvn(tbuf, len);
597 Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
598 "Integer overflow in version %d",VERSION_MAX);
600 else if ( SvUOK(ver) || SvIOK(ver))
601 #if PERL_VERSION_LT(5,17,2)
605 version = savesvpv(ver);
608 else if (SvNOK(ver) && !( SvPOK(ver) && SvCUR(ver) == 3 ) )
609 #if PERL_VERSION_LT(5,17,2)
615 /* may get too much accuracy */
617 SV *sv = SvNVX(ver) > 10e50 ? newSV(64) : 0;
620 #if PERL_VERSION_GE(5,19,0)
626 #ifdef USE_LOCALE_NUMERIC
629 /* This may or may not be called from code that has switched
630 * locales without letting perl know, therefore we have to find it
631 * from first principals. See [perl #121930]. */
633 /* In windows, or not threaded, or not thread-safe, if it isn't C,
636 # ifndef USE_POSIX_2008_LOCALE
638 const char * locale_name_on_entry;
640 LC_NUMERIC_LOCK(0); /* Start critical section */
642 locale_name_on_entry = setlocale(LC_NUMERIC, NULL);
643 if ( strNE(locale_name_on_entry, "C")
644 && strNE(locale_name_on_entry, "POSIX"))
646 /* the setlocale() call might free or overwrite the name */
647 locale_name_on_entry = savepv(locale_name_on_entry);
648 setlocale(LC_NUMERIC, "C");
650 else { /* This value indicates to the restore code that we didn't
652 locale_name_on_entry = NULL;
657 const locale_t locale_obj_on_entry = uselocale((locale_t) 0);
658 const char * locale_name_on_entry = NULL;
659 DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
661 if (locale_obj_on_entry == LC_GLOBAL_LOCALE) {
663 /* in the global locale, we can call system setlocale and if it
664 * isn't C, set it to C. */
667 locale_name_on_entry = setlocale(LC_NUMERIC, NULL);
668 if ( strNE(locale_name_on_entry, "C")
669 && strNE(locale_name_on_entry, "POSIX"))
671 /* the setlocale() call might free or overwrite the name */
672 locale_name_on_entry = savepv(locale_name_on_entry);
673 setlocale(LC_NUMERIC, "C");
675 else { /* This value indicates to the restore code that we
676 didn't change the locale */
677 locale_name_on_entry = NULL;
680 else if (locale_obj_on_entry == PL_underlying_numeric_obj) {
681 /* Here, the locale appears to have been changed to use the
682 * program's underlying locale. Just use our mechanisms to
683 * switch back to C. It might be possible for this pointer to
684 * actually refer to something else if it got released and
685 * reused somehow. But it doesn't matter, our mechanisms will
687 STORE_LC_NUMERIC_SET_STANDARD();
689 else if (locale_obj_on_entry != PL_C_locale_obj) {
690 /* The C object should be unchanged during a program's
691 * execution, so it should be safe to assume it means what it
692 * says, so if we are in it, no locale change is required.
693 * Otherwise, simply use the thread-safe operation. */
694 uselocale(PL_C_locale_obj);
699 /* Prevent recursed calls from trying to change back */
700 LOCK_LC_NUMERIC_STANDARD();
705 Perl_sv_catpvf(aTHX_ sv, "%.9" NVff, SvNVX(ver));
710 len = my_snprintf(tbuf, sizeof(tbuf), "%.9" NVff, SvNVX(ver));
714 #ifdef USE_LOCALE_NUMERIC
716 UNLOCK_LC_NUMERIC_STANDARD();
718 # ifndef USE_POSIX_2008_LOCALE
720 if (locale_name_on_entry) {
721 setlocale(LC_NUMERIC, locale_name_on_entry);
722 Safefree(locale_name_on_entry);
725 LC_NUMERIC_UNLOCK; /* End critical section */
729 if (locale_name_on_entry) {
730 setlocale(LC_NUMERIC, locale_name_on_entry);
731 Safefree(locale_name_on_entry);
734 else if (locale_obj_on_entry == PL_underlying_numeric_obj) {
735 RESTORE_LC_NUMERIC();
737 else if (locale_obj_on_entry != PL_C_locale_obj) {
738 uselocale(locale_obj_on_entry);
745 #endif /* USE_LOCALE_NUMERIC */
747 while (buf[len-1] == '0' && len > 0) len--;
748 if ( buf[len-1] == '.' ) len--; /* eat the trailing decimal */
749 version = savepvn(buf, len);
754 else if ( (mg = SvVSTRING_mg(ver)) ) { /* already a v-string */
755 version = savepvn( (const char*)mg->mg_ptr,mg->mg_len );
760 else if ( SvPOK(ver))/* must be a string or something like a string */
764 version = savepvn(SvPV(ver,len), SvCUR(ver));
767 # if PERL_VERSION > 5
768 /* This will only be executed for 5.6.0 - 5.8.0 inclusive */
769 if ( len >= 3 && !instr(version,".") && !instr(version,"_")) {
770 /* may be a v-string */
771 char *testv = (char *)version;
773 for (tlen=0; tlen < len; tlen++, testv++) {
774 /* if one of the characters is non-text assume v-string */
775 if (testv[0] < ' ') {
776 SV * const nsv = sv_newmortal();
780 sv_setpvf(nsv,"v%vd",ver);
781 pos = nver = savepv(SvPV_nolen(nsv));
784 /* scan the resulting formatted string */
785 pos++; /* skip the leading 'v' */
786 while ( *pos == '.' || isDIGIT(*pos) ) {
792 /* is definitely a v-string */
793 if ( saw_decimal >= 2 ) {
803 #if PERL_VERSION_LT(5,17,2)
804 else if (SvIOKp(ver)) {
807 else if (SvNOKp(ver)) {
810 else if (SvPOKp(ver)) {
816 /* no idea what this is */
817 Perl_croak(aTHX_ "Invalid version format (non-numeric data)");
820 s = SCAN_VERSION(version, ver, qv);
822 Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
823 "Version string '%s' contains invalid data; "
824 "ignoring: '%s'", version, s);
826 #if PERL_VERSION_LT(5,19,8) && defined(USE_ITHREADS)
836 Validates that the SV contains valid internal structure for a version object.
837 It may be passed either the version object (RV) or the hash itself (HV). If
838 the structure is valid, it returns the HV. If the structure is invalid,
841 SV *hv = vverify(sv);
843 Note that it only confirms the bare minimum structure (so as not to get
844 confused by derived classes which may contain additional hash entries):
848 =item * The SV is an HV or a reference to an HV
850 =item * The hash contains a "version" key
852 =item * The "version" key has a reference to an AV as its value
860 #ifdef VUTIL_REPLACE_CORE
861 Perl_vverify2(pTHX_ SV *vs)
863 Perl_vverify(pTHX_ SV *vs)
869 PERL_ARGS_ASSERT_VVERIFY;
874 /* see if the appropriate elements exist */
875 if ( SvTYPE(vs) == SVt_PVHV
876 && (svp = hv_fetchs(MUTABLE_HV(vs), "version", FALSE))
878 && SvTYPE(sv) == SVt_PVAV )
887 Accepts a version object and returns the normalized floating
888 point representation. Call like:
892 NOTE: you can pass either the object directly or the SV
893 contained within the RV.
895 The SV returned has a refcount of 1.
901 #ifdef VUTIL_REPLACE_CORE
902 Perl_vnumify2(pTHX_ SV *vs)
904 Perl_vnumify(pTHX_ SV *vs)
913 PERL_ARGS_ASSERT_VNUMIFY;
915 /* extract the HV from the object */
918 Perl_croak(aTHX_ "Invalid version object");
920 /* see if various flags exist */
921 if ( hv_exists(MUTABLE_HV(vs), "alpha", 5 ) )
925 Perl_ck_warner(aTHX_ packWARN(WARN_NUMERIC),
926 "alpha->numify() is lossy");
929 /* attempt to retrieve the version array */
930 if ( !(av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE))) ) ) {
931 return newSVpvs("0");
937 return newSVpvs("0");
941 SV * tsv = *av_fetch(av, 0, 0);
944 sv = Perl_newSVpvf(aTHX_ "%d.", (int)PERL_ABS(digit));
945 for ( i = 1 ; i <= len ; i++ )
947 SV * tsv = *av_fetch(av, i, 0);
949 Perl_sv_catpvf(aTHX_ sv, "%03d", (int)digit);
953 sv_catpvs(sv, "000");
961 Accepts a version object and returns the normalized string
962 representation. Call like:
966 NOTE: you can pass either the object directly or the SV
967 contained within the RV.
969 The SV returned has a refcount of 1.
975 #ifdef VUTIL_REPLACE_CORE
976 Perl_vnormal2(pTHX_ SV *vs)
978 Perl_vnormal(pTHX_ SV *vs)
985 PERL_ARGS_ASSERT_VNORMAL;
987 /* extract the HV from the object */
990 Perl_croak(aTHX_ "Invalid version object");
992 av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE)));
1000 SV * tsv = *av_fetch(av, 0, 0);
1003 sv = Perl_newSVpvf(aTHX_ "v%" IVdf, (IV)digit);
1004 for ( i = 1 ; i <= len ; i++ ) {
1005 SV * tsv = *av_fetch(av, i, 0);
1007 Perl_sv_catpvf(aTHX_ sv, ".%" IVdf, (IV)digit);
1010 if ( len <= 2 ) { /* short version, must be at least three */
1011 for ( len = 2 - len; len != 0; len-- )
1018 =for apidoc vstringify
1020 In order to maintain maximum compatibility with earlier versions
1021 of Perl, this function will return either the floating point
1022 notation or the multiple dotted notation, depending on whether
1023 the original version contained 1 or more dots, respectively.
1025 The SV returned has a refcount of 1.
1031 #ifdef VUTIL_REPLACE_CORE
1032 Perl_vstringify2(pTHX_ SV *vs)
1034 Perl_vstringify(pTHX_ SV *vs)
1038 PERL_ARGS_ASSERT_VSTRINGIFY;
1040 /* extract the HV from the object */
1043 Perl_croak(aTHX_ "Invalid version object");
1045 svp = hv_fetchs(MUTABLE_HV(vs), "original", FALSE);
1050 #if PERL_VERSION_LT(5,17,2)
1056 return &PL_sv_undef;
1059 if ( hv_exists(MUTABLE_HV(vs), "qv", 2) )
1069 Version object aware cmp. Both operands must already have been
1070 converted into version objects.
1076 #ifdef VUTIL_REPLACE_CORE
1077 Perl_vcmp2(pTHX_ SV *lhv, SV *rhv)
1079 Perl_vcmp(pTHX_ SV *lhv, SV *rhv)
1088 PERL_ARGS_ASSERT_VCMP;
1090 /* extract the HVs from the objects */
1093 if ( ! ( lhv && rhv ) )
1094 Perl_croak(aTHX_ "Invalid version object");
1096 /* get the left hand term */
1097 lav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(lhv), "version", FALSE)));
1099 /* and the right hand term */
1100 rav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(rhv), "version", FALSE)));
1107 while ( i <= m && retval == 0 )
1109 SV * const lsv = *av_fetch(lav,i,0);
1112 rsv = *av_fetch(rav,i,0);
1121 if ( l != r && retval == 0 ) /* possible match except for trailing 0's */
1125 while ( i <= r && retval == 0 )
1127 SV * const rsv = *av_fetch(rav,i,0);
1128 if ( SvIV(rsv) != 0 )
1129 retval = -1; /* not a match after all */
1135 while ( i <= l && retval == 0 )
1137 SV * const lsv = *av_fetch(lav,i,0);
1138 if ( SvIV(lsv) != 0 )
1139 retval = +1; /* not a match after all */