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_section Versioning
13 =for apidoc prescan_version
15 Validate that a given string can be parsed as a version object, but doesn't
16 actually perform the parsing. Can use either strict or lax validation rules.
17 Can optionally set a number of hint variables to save the parsing code
18 some time when tokenizing.
23 #ifdef VUTIL_REPLACE_CORE
24 Perl_prescan_version2(pTHX_ const char *s, bool strict,
26 Perl_prescan_version(pTHX_ const char *s, bool strict,
29 bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha) {
30 bool qv = (sqv ? *sqv : FALSE);
36 PERL_ARGS_ASSERT_PRESCAN_VERSION;
39 if (qv && isDIGIT(*d))
40 goto dotted_decimal_version;
42 if (*d == 'v') { /* explicit v-string */
47 else { /* degenerate v-string */
49 BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
52 dotted_decimal_version:
53 if (strict && d[0] == '0' && isDIGIT(d[1])) {
54 /* no leading zeros allowed */
55 BADVERSION(s,errstr,"Invalid version format (no leading zeros)");
58 while (isDIGIT(*d)) /* integer part */
64 d++; /* decimal point */
70 BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
73 goto version_prescan_finish;
80 while (isDIGIT(*d)) { /* just keep reading */
84 /* maximum 3 digits between decimal */
85 if (strict && j > 3) {
86 BADVERSION(s,errstr,"Invalid version format (maximum 3 digits between decimals)");
91 BADVERSION(s,errstr,"Invalid version format (no underscores)");
94 BADVERSION(s,errstr,"Invalid version format (multiple underscores)");
101 BADVERSION(s,errstr,"Invalid version format (underscores before decimal)");
106 else if (!isDIGIT(*d)) {
112 if (strict && i < 2) {
113 /* requires v1.2.3 */
114 BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
117 } /* end if dotted-decimal */
119 { /* decimal versions */
120 int j = 0; /* may need this later */
121 /* special strict case for leading '.' or '0' */
124 BADVERSION(s,errstr,"Invalid version format (0 before decimal required)");
126 if (*d == '0' && isDIGIT(d[1])) {
127 BADVERSION(s,errstr,"Invalid version format (no leading zeros)");
131 /* and we never support negative versions */
133 BADVERSION(s,errstr,"Invalid version format (negative version number)");
136 /* consume all of the integer part */
140 /* look for a fractional part */
142 /* we found it, so consume it */
146 else if (!*d || *d == ';' || isSPACE(*d) || *d == '{' || *d == '}') {
149 BADVERSION(s,errstr,"Invalid version format (version required)");
151 /* found just an integer */
152 goto version_prescan_finish;
155 /* didn't find either integer or period */
156 BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
158 else if (*d == '_') {
159 /* underscore can't come after integer part */
161 BADVERSION(s,errstr,"Invalid version format (no underscores)");
163 else if (isDIGIT(d[1])) {
164 BADVERSION(s,errstr,"Invalid version format (alpha without decimal)");
167 BADVERSION(s,errstr,"Invalid version format (misplaced underscore)");
171 /* anything else after integer part is just invalid data */
172 BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
175 /* scan the fractional part after the decimal point*/
177 if (!isDIGIT(*d) && (strict || ! (!*d || *d == ';' || isSPACE(*d) || *d == '{' || *d == '}') )) {
178 /* strict or lax-but-not-the-end */
179 BADVERSION(s,errstr,"Invalid version format (fractional part required)");
182 while (isDIGIT(*d)) {
184 if (*d == '.' && isDIGIT(d[-1])) {
186 BADVERSION(s,errstr,"Invalid version format (underscores before decimal)");
189 BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions must begin with 'v')");
191 d = (char *)s; /* start all over again */
193 goto dotted_decimal_version;
197 BADVERSION(s,errstr,"Invalid version format (no underscores)");
200 BADVERSION(s,errstr,"Invalid version format (multiple underscores)");
202 if ( ! isDIGIT(d[1]) ) {
203 BADVERSION(s,errstr,"Invalid version format (misplaced underscore)");
212 version_prescan_finish:
216 if (!isDIGIT(*d) && (! (!*d || *d == ';' || *d == '{' || *d == '}') )) {
217 /* trailing non-numeric data */
218 BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
220 if (saw_decimal > 1 && d[-1] == '.') {
221 /* no trailing period allowed */
222 BADVERSION(s,errstr,"Invalid version format (trailing decimal)");
231 *ssaw_decimal = saw_decimal;
238 =for apidoc scan_version
240 Returns a pointer to the next character after the parsed
241 version string, as well as upgrading the passed in SV to
244 Function must be called with an already existing SV like
247 s = scan_version(s, SV *sv, bool qv);
249 Performs some preprocessing to the string to ensure that
250 it has the correct characteristics of a version. Flags the
251 object if it contains an underscore (which denotes this
252 is an alpha version). The boolean qv denotes that the version
253 should be interpreted as if it had multiple decimals, even if
260 #ifdef VUTIL_REPLACE_CORE
261 Perl_scan_version2(pTHX_ const char *s, SV *rv, bool qv)
263 Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
266 const char *start = s;
269 const char *errstr = NULL;
277 PERL_ARGS_ASSERT_SCAN_VERSION;
279 while (isSPACE(*s)) /* leading whitespace is OK */
282 last = PRESCAN_VERSION(s, FALSE, &errstr, &qv, &saw_decimal, &width, &alpha);
284 /* "undef" is a special case and not an error */
285 if ( ! ( *s == 'u' && strEQ(s+1,"ndef")) ) {
286 Perl_croak(aTHX_ "%s", errstr);
295 /* Now that we are through the prescan, start creating the object */
297 hv = newSVrv(rv, "version"); /* create an SV and upgrade the RV */
298 (void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
300 #ifndef NODEFAULT_SHAREKEYS
301 HvSHAREKEYS_on(hv); /* key-sharing on by default */
305 (void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(qv));
307 (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(alpha));
308 if ( !qv && width < 3 )
309 (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
311 while (isDIGIT(*pos) || *pos == '_')
313 if (!isALPHA(*pos)) {
319 /* this is atoi() that delimits on underscores */
320 const char *end = pos;
324 /* the following if() will only be true after the decimal
325 * point of a version originally created with a bare
326 * floating point number, i.e. not quoted in any way
328 if ( !qv && s > start && saw_decimal == 1 ) {
334 rev += (*s - '0') * mult;
336 if ( (PERL_ABS(orev) > PERL_ABS(rev))
337 || (PERL_ABS(rev) > VERSION_MAX )) {
338 Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
339 "Integer overflow in version %d",VERSION_MAX);
355 if ( (mult == VERSION_MAX)
356 || (i > VERSION_MAX / mult)
357 || (i * mult > VERSION_MAX - rev))
359 Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
360 "Integer overflow in version");
368 if (mult > VERSION_MAX / 10)
376 /* Append revision */
377 av_push(av, newSViv(rev));
382 else if ( *pos == '.' ) {
390 else if ( *pos == '_' && isDIGIT(pos[1]) )
392 else if ( *pos == ',' && isDIGIT(pos[1]) )
394 else if ( isDIGIT(*pos) )
401 while ( isDIGIT(*pos) || *pos == '_')
406 while ( ( isDIGIT(*pos) || *pos == '_' ) && digits < 3 ) {
414 if ( qv ) { /* quoted versions always get at least three terms*/
415 SSize_t len = AvFILLp(av);
416 /* This for loop appears to trigger a compiler bug on OS X, as it
417 loops infinitely. Yes, len is negative. No, it makes no sense.
418 Compiler in question is:
419 gcc version 3.3 20030304 (Apple Computer, Inc. build 1640)
420 for ( len = 2 - len; len > 0; len-- )
421 av_push(MUTABLE_AV(sv), newSViv(0));
425 av_push(av, newSViv(0));
428 /* need to save off the current version string for later */
430 SV * orig = newSVpvn("v.Inf", sizeof("v.Inf")-1);
431 (void)hv_stores(MUTABLE_HV(hv), "original", orig);
432 (void)hv_stores(MUTABLE_HV(hv), "vinf", newSViv(1));
434 else if ( s > start ) {
435 SV * orig = newSVpvn(start,s-start);
436 if ( qv && saw_decimal == 1 && *start != 'v' ) {
437 /* need to insert a v to be consistent */
438 sv_insert(orig, 0, 0, "v", 1);
440 (void)hv_stores(MUTABLE_HV(hv), "original", orig);
443 (void)hv_stores(MUTABLE_HV(hv), "original", newSVpvs("0"));
444 av_push(av, newSViv(0));
447 /* And finally, store the AV in the hash */
448 (void)hv_stores(MUTABLE_HV(hv), "version", newRV_noinc(MUTABLE_SV(av)));
450 /* fix RT#19517 - special case 'undef' as string */
451 if ( *s == 'u' && strEQ(s+1,"ndef") ) {
459 =for apidoc new_version
461 Returns a new version object based on the passed in SV:
463 SV *sv = new_version(SV *ver);
465 Does not alter the passed in ver SV. See "upg_version" if you
466 want to upgrade the SV.
472 #ifdef VUTIL_REPLACE_CORE
473 Perl_new_version2(pTHX_ SV *ver)
475 Perl_new_version(pTHX_ SV *ver)
478 SV * const rv = newSV(0);
479 PERL_ARGS_ASSERT_NEW_VERSION;
480 if ( ISA_VERSION_OBJ(ver) ) /* can just copy directly */
483 AV * const av = newAV();
485 /* This will get reblessed later if a derived class*/
486 SV * const hv = newSVrv(rv, "version");
487 (void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
488 #ifndef NODEFAULT_SHAREKEYS
489 HvSHAREKEYS_on(hv); /* key-sharing on by default */
495 /* Begin copying all of the elements */
496 if ( hv_exists(MUTABLE_HV(ver), "qv", 2) )
497 (void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(1));
499 if ( hv_exists(MUTABLE_HV(ver), "alpha", 5) )
500 (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(1));
502 SV ** svp = hv_fetchs(MUTABLE_HV(ver), "width", FALSE);
504 const I32 width = SvIV(*svp);
505 (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
509 SV ** svp = hv_fetchs(MUTABLE_HV(ver), "original", FALSE);
511 (void)hv_stores(MUTABLE_HV(hv), "original", newSVsv(*svp));
513 sav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(ver), "version", FALSE)));
514 /* This will get reblessed later if a derived class*/
515 for ( key = 0; key <= av_len(sav); key++ )
517 SV * const sv = *av_fetch(sav, key, FALSE);
518 const I32 rev = SvIV(sv);
519 av_push(av, newSViv(rev));
522 (void)hv_stores(MUTABLE_HV(hv), "version", newRV_noinc(MUTABLE_SV(av)));
527 const MAGIC* const mg = SvVSTRING_mg(ver);
528 if ( mg ) { /* already a v-string */
529 const STRLEN len = mg->mg_len;
530 const char * const version = (const char*)mg->mg_ptr;
532 static const char underscore[] = "_";
533 sv_setpvn(rv,version,len);
534 raw = SvPV_nolen(rv);
535 under = ninstr(raw, raw+len, underscore, underscore + 1);
537 Move(under + 1, under, raw + len - under - 1, char);
538 SvCUR_set(rv, SvCUR(rv) - 1);
541 /* this is for consistency with the pure Perl class */
542 if ( isDIGIT(*version) )
543 sv_insert(rv, 0, 0, "v", 1);
547 SvSetSV_nosteal(rv, ver); /* make a duplicate */
552 sv_2mortal(rv); /* in case upg_version croaks before it returns */
553 return SvREFCNT_inc_NN(UPG_VERSION(rv, FALSE));
557 =for apidoc upg_version
559 In-place upgrade of the supplied SV to a version object.
561 SV *sv = upg_version(SV *sv, bool qv);
563 Returns a pointer to the upgraded SV. Set the boolean qv if you want
564 to force this SV to be interpreted as an "extended" version.
570 #ifdef VUTIL_REPLACE_CORE
571 Perl_upg_version2(pTHX_ SV *ver, bool qv)
573 Perl_upg_version(pTHX_ SV *ver, bool qv)
576 const char *version, *s;
581 #if PERL_VERSION_LT(5,19,8) && defined(USE_ITHREADS)
584 PERL_ARGS_ASSERT_UPG_VERSION;
586 if ( (SvUOK(ver) && SvUVX(ver) > VERSION_MAX)
587 || (SvIOK(ver) && SvIVX(ver) > VERSION_MAX) ) {
588 /* out of bounds [unsigned] integer */
591 len = my_snprintf(tbuf, sizeof(tbuf), "%d", VERSION_MAX);
592 version = savepvn(tbuf, len);
594 Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
595 "Integer overflow in version %d",VERSION_MAX);
597 else if ( SvUOK(ver) || SvIOK(ver))
598 #if PERL_VERSION_LT(5,17,2)
602 version = savesvpv(ver);
605 else if (SvNOK(ver) && !( SvPOK(ver) && SvCUR(ver) == 3 ) )
606 #if PERL_VERSION_LT(5,17,2)
612 /* may get too much accuracy */
614 SV *sv = SvNVX(ver) > 10e50 ? newSV(64) : 0;
617 #if PERL_VERSION_GE(5,19,0)
623 #ifdef USE_LOCALE_NUMERIC
626 /* This may or may not be called from code that has switched
627 * locales without letting perl know, therefore we have to find it
628 * from first principals. See [perl #121930]. */
630 /* In windows, or not threaded, or not thread-safe, if it isn't C,
633 # ifndef USE_POSIX_2008_LOCALE
635 const char * locale_name_on_entry;
637 LC_NUMERIC_LOCK(0); /* Start critical section */
639 locale_name_on_entry = setlocale(LC_NUMERIC, NULL);
640 if ( strNE(locale_name_on_entry, "C")
641 && strNE(locale_name_on_entry, "POSIX"))
643 /* the setlocale() call might free or overwrite the name */
644 locale_name_on_entry = savepv(locale_name_on_entry);
645 setlocale(LC_NUMERIC, "C");
647 else { /* This value indicates to the restore code that we didn't
649 locale_name_on_entry = NULL;
654 const locale_t locale_obj_on_entry = uselocale((locale_t) 0);
655 const char * locale_name_on_entry = NULL;
656 DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
658 if (locale_obj_on_entry == LC_GLOBAL_LOCALE) {
660 /* in the global locale, we can call system setlocale and if it
661 * isn't C, set it to C. */
664 locale_name_on_entry = setlocale(LC_NUMERIC, NULL);
665 if ( strNE(locale_name_on_entry, "C")
666 && strNE(locale_name_on_entry, "POSIX"))
668 /* the setlocale() call might free or overwrite the name */
669 locale_name_on_entry = savepv(locale_name_on_entry);
670 setlocale(LC_NUMERIC, "C");
672 else { /* This value indicates to the restore code that we
673 didn't change the locale */
674 locale_name_on_entry = NULL;
677 else if (locale_obj_on_entry == PL_underlying_numeric_obj) {
678 /* Here, the locale appears to have been changed to use the
679 * program's underlying locale. Just use our mechanisms to
680 * switch back to C. It might be possible for this pointer to
681 * actually refer to something else if it got released and
682 * reused somehow. But it doesn't matter, our mechanisms will
684 STORE_LC_NUMERIC_SET_STANDARD();
686 else if (locale_obj_on_entry != PL_C_locale_obj) {
687 /* The C object should be unchanged during a program's
688 * execution, so it should be safe to assume it means what it
689 * says, so if we are in it, no locale change is required.
690 * Otherwise, simply use the thread-safe operation. */
691 uselocale(PL_C_locale_obj);
696 /* Prevent recursed calls from trying to change back */
697 LOCK_LC_NUMERIC_STANDARD();
702 Perl_sv_setpvf(aTHX_ sv, "%.9" NVff, SvNVX(ver));
707 len = my_snprintf(tbuf, sizeof(tbuf), "%.9" NVff, SvNVX(ver));
711 #ifdef USE_LOCALE_NUMERIC
713 UNLOCK_LC_NUMERIC_STANDARD();
715 # ifndef USE_POSIX_2008_LOCALE
717 if (locale_name_on_entry) {
718 setlocale(LC_NUMERIC, locale_name_on_entry);
719 Safefree(locale_name_on_entry);
722 LC_NUMERIC_UNLOCK; /* End critical section */
726 if (locale_name_on_entry) {
727 setlocale(LC_NUMERIC, locale_name_on_entry);
728 Safefree(locale_name_on_entry);
731 else if (locale_obj_on_entry == PL_underlying_numeric_obj) {
732 RESTORE_LC_NUMERIC();
734 else if (locale_obj_on_entry != PL_C_locale_obj) {
735 uselocale(locale_obj_on_entry);
742 #endif /* USE_LOCALE_NUMERIC */
744 while (buf[len-1] == '0' && len > 0) len--;
745 if ( buf[len-1] == '.' ) len--; /* eat the trailing decimal */
746 version = savepvn(buf, len);
751 else if ( (mg = SvVSTRING_mg(ver)) ) { /* already a v-string */
752 version = savepvn( (const char*)mg->mg_ptr,mg->mg_len );
757 else if ( SvPOK(ver))/* must be a string or something like a string */
761 version = savepvn(SvPV(ver,len), SvCUR(ver));
764 /* This will only be executed for 5.6.0 - 5.8.0 inclusive */
765 if ( len >= 3 && !instr(version,".") && !instr(version,"_")) {
766 /* may be a v-string */
767 char *testv = (char *)version;
769 for (tlen=0; tlen < len; tlen++, testv++) {
770 /* if one of the characters is non-text assume v-string */
771 if (testv[0] < ' ') {
772 SV * const nsv = sv_newmortal();
776 sv_setpvf(nsv,"v%vd",ver);
777 pos = nver = savepv(SvPV_nolen(nsv));
780 /* scan the resulting formatted string */
781 pos++; /* skip the leading 'v' */
782 while ( *pos == '.' || isDIGIT(*pos) ) {
788 /* is definitely a v-string */
789 if ( saw_decimal >= 2 ) {
798 #if PERL_VERSION_LT(5,17,2)
799 else if (SvIOKp(ver)) {
802 else if (SvNOKp(ver)) {
805 else if (SvPOKp(ver)) {
811 /* no idea what this is */
812 Perl_croak(aTHX_ "Invalid version format (non-numeric data)");
815 s = SCAN_VERSION(version, ver, qv);
817 Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
818 "Version string '%s' contains invalid data; "
819 "ignoring: '%s'", version, s);
821 #if PERL_VERSION_LT(5,19,8) && defined(USE_ITHREADS)
831 Validates that the SV contains valid internal structure for a version object.
832 It may be passed either the version object (RV) or the hash itself (HV). If
833 the structure is valid, it returns the HV. If the structure is invalid,
836 SV *hv = vverify(sv);
838 Note that it only confirms the bare minimum structure (so as not to get
839 confused by derived classes which may contain additional hash entries):
843 =item * The SV is an HV or a reference to an HV
845 =item * The hash contains a "version" key
847 =item * The "version" key has a reference to an AV as its value
855 #ifdef VUTIL_REPLACE_CORE
856 Perl_vverify2(pTHX_ SV *vs)
858 Perl_vverify(pTHX_ SV *vs)
864 PERL_ARGS_ASSERT_VVERIFY;
869 /* see if the appropriate elements exist */
870 if ( SvTYPE(vs) == SVt_PVHV
871 && (svp = hv_fetchs(MUTABLE_HV(vs), "version", FALSE))
873 && SvTYPE(sv) == SVt_PVAV )
882 Accepts a version object and returns the normalized floating
883 point representation. Call like:
887 NOTE: you can pass either the object directly or the SV
888 contained within the RV.
890 The SV returned has a refcount of 1.
896 #ifdef VUTIL_REPLACE_CORE
897 Perl_vnumify2(pTHX_ SV *vs)
899 Perl_vnumify(pTHX_ SV *vs)
908 PERL_ARGS_ASSERT_VNUMIFY;
910 /* extract the HV from the object */
913 Perl_croak(aTHX_ "Invalid version object");
915 /* see if various flags exist */
916 if ( hv_exists(MUTABLE_HV(vs), "alpha", 5 ) )
920 Perl_ck_warner(aTHX_ packWARN(WARN_NUMERIC),
921 "alpha->numify() is lossy");
924 /* attempt to retrieve the version array */
925 if ( !(av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE))) ) ) {
926 return newSVpvs("0");
932 return newSVpvs("0");
936 SV * tsv = *av_fetch(av, 0, 0);
939 sv = Perl_newSVpvf(aTHX_ "%d.", (int)PERL_ABS(digit));
940 for ( i = 1 ; i <= len ; i++ )
942 SV * tsv = *av_fetch(av, i, 0);
944 Perl_sv_catpvf(aTHX_ sv, "%03d", (int)digit);
948 sv_catpvs(sv, "000");
956 Accepts a version object and returns the normalized string
957 representation. Call like:
961 NOTE: you can pass either the object directly or the SV
962 contained within the RV.
964 The SV returned has a refcount of 1.
970 #ifdef VUTIL_REPLACE_CORE
971 Perl_vnormal2(pTHX_ SV *vs)
973 Perl_vnormal(pTHX_ SV *vs)
980 PERL_ARGS_ASSERT_VNORMAL;
982 /* extract the HV from the object */
985 Perl_croak(aTHX_ "Invalid version object");
987 av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE)));
995 SV * tsv = *av_fetch(av, 0, 0);
998 sv = Perl_newSVpvf(aTHX_ "v%" IVdf, (IV)digit);
999 for ( i = 1 ; i <= len ; i++ ) {
1000 SV * tsv = *av_fetch(av, i, 0);
1002 Perl_sv_catpvf(aTHX_ sv, ".%" IVdf, (IV)digit);
1005 if ( len <= 2 ) { /* short version, must be at least three */
1006 for ( len = 2 - len; len != 0; len-- )
1013 =for apidoc vstringify
1015 In order to maintain maximum compatibility with earlier versions
1016 of Perl, this function will return either the floating point
1017 notation or the multiple dotted notation, depending on whether
1018 the original version contained 1 or more dots, respectively.
1020 The SV returned has a refcount of 1.
1026 #ifdef VUTIL_REPLACE_CORE
1027 Perl_vstringify2(pTHX_ SV *vs)
1029 Perl_vstringify(pTHX_ SV *vs)
1033 PERL_ARGS_ASSERT_VSTRINGIFY;
1035 /* extract the HV from the object */
1038 Perl_croak(aTHX_ "Invalid version object");
1040 svp = hv_fetchs(MUTABLE_HV(vs), "original", FALSE);
1045 #if PERL_VERSION_LT(5,17,2)
1051 return &PL_sv_undef;
1054 if ( hv_exists(MUTABLE_HV(vs), "qv", 2) )
1064 Version object aware cmp. Both operands must already have been
1065 converted into version objects.
1071 #ifdef VUTIL_REPLACE_CORE
1072 Perl_vcmp2(pTHX_ SV *lhv, SV *rhv)
1074 Perl_vcmp(pTHX_ SV *lhv, SV *rhv)
1083 PERL_ARGS_ASSERT_VCMP;
1085 /* extract the HVs from the objects */
1088 if ( ! ( lhv && rhv ) )
1089 Perl_croak(aTHX_ "Invalid version object");
1091 /* get the left hand term */
1092 lav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(lhv), "version", FALSE)));
1094 /* and the right hand term */
1095 rav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(rhv), "version", FALSE)));
1102 while ( i <= m && retval == 0 )
1104 SV * const lsv = *av_fetch(lav,i,0);
1107 rsv = *av_fetch(rav,i,0);
1116 if ( l != r && retval == 0 ) /* possible match except for trailing 0's */
1120 while ( i <= r && retval == 0 )
1122 SV * const rsv = *av_fetch(rav,i,0);
1123 if ( SvIV(rsv) != 0 )
1124 retval = -1; /* not a match after all */
1130 while ( i <= l && retval == 0 )
1132 SV * const lsv = *av_fetch(lav,i,0);
1133 if ( SvIV(lsv) != 0 )
1134 retval = +1; /* not a match after all */