1 /* This file is part of the "version" CPAN distribution. Please avoid
2 editing it in the perl core. */
5 # define PERL_NO_GET_CONTEXT
9 # define NEED_my_snprintf
10 # define NEED_newRV_noinc
11 # define NEED_vnewSVpvf
12 # define NEED_newSVpvn_flags_GLOBAL
18 #define VERSION_MAX 0x7FFFFFFF
23 =for apidoc prescan_version
25 Validate that a given string can be parsed as a version object, but doesn't
26 actually perform the parsing. Can use either strict or lax validation rules.
27 Can optionally set a number of hint variables to save the parsing code
28 some time when tokenizing.
33 #ifdef VUTIL_REPLACE_CORE
34 Perl_prescan_version2(pTHX_ const char *s, bool strict,
36 Perl_prescan_version(pTHX_ const char *s, bool strict,
39 bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha) {
40 bool qv = (sqv ? *sqv : FALSE);
46 PERL_ARGS_ASSERT_PRESCAN_VERSION;
48 if (qv && isDIGIT(*d))
49 goto dotted_decimal_version;
51 if (*d == 'v') { /* explicit v-string */
56 else { /* degenerate v-string */
58 BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
61 dotted_decimal_version:
62 if (strict && d[0] == '0' && isDIGIT(d[1])) {
63 /* no leading zeros allowed */
64 BADVERSION(s,errstr,"Invalid version format (no leading zeros)");
67 while (isDIGIT(*d)) /* integer part */
73 d++; /* decimal point */
79 BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
82 goto version_prescan_finish;
89 while (isDIGIT(*d)) { /* just keep reading */
93 /* maximum 3 digits between decimal */
94 if (strict && j > 3) {
95 BADVERSION(s,errstr,"Invalid version format (maximum 3 digits between decimals)");
100 BADVERSION(s,errstr,"Invalid version format (no underscores)");
103 BADVERSION(s,errstr,"Invalid version format (multiple underscores)");
108 else if (*d == '.') {
110 BADVERSION(s,errstr,"Invalid version format (underscores before decimal)");
115 else if (!isDIGIT(*d)) {
121 if (strict && i < 2) {
122 /* requires v1.2.3 */
123 BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
126 } /* end if dotted-decimal */
128 { /* decimal versions */
129 int j = 0; /* may need this later */
130 /* special strict case for leading '.' or '0' */
133 BADVERSION(s,errstr,"Invalid version format (0 before decimal required)");
135 if (*d == '0' && isDIGIT(d[1])) {
136 BADVERSION(s,errstr,"Invalid version format (no leading zeros)");
140 /* and we never support negative versions */
142 BADVERSION(s,errstr,"Invalid version format (negative version number)");
145 /* consume all of the integer part */
149 /* look for a fractional part */
151 /* we found it, so consume it */
155 else if (!*d || *d == ';' || isSPACE(*d) || *d == '{' || *d == '}') {
158 BADVERSION(s,errstr,"Invalid version format (version required)");
160 /* found just an integer */
161 goto version_prescan_finish;
164 /* didn't find either integer or period */
165 BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
167 else if (*d == '_') {
168 /* underscore can't come after integer part */
170 BADVERSION(s,errstr,"Invalid version format (no underscores)");
172 else if (isDIGIT(d[1])) {
173 BADVERSION(s,errstr,"Invalid version format (alpha without decimal)");
176 BADVERSION(s,errstr,"Invalid version format (misplaced underscore)");
180 /* anything else after integer part is just invalid data */
181 BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
184 /* scan the fractional part after the decimal point*/
186 if (!isDIGIT(*d) && (strict || ! (!*d || *d == ';' || isSPACE(*d) || *d == '{' || *d == '}') )) {
187 /* strict or lax-but-not-the-end */
188 BADVERSION(s,errstr,"Invalid version format (fractional part required)");
191 while (isDIGIT(*d)) {
193 if (*d == '.' && isDIGIT(d[-1])) {
195 BADVERSION(s,errstr,"Invalid version format (underscores before decimal)");
198 BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions must begin with 'v')");
200 d = (char *)s; /* start all over again */
202 goto dotted_decimal_version;
206 BADVERSION(s,errstr,"Invalid version format (no underscores)");
209 BADVERSION(s,errstr,"Invalid version format (multiple underscores)");
211 if ( ! isDIGIT(d[1]) ) {
212 BADVERSION(s,errstr,"Invalid version format (misplaced underscore)");
221 version_prescan_finish:
225 if (!isDIGIT(*d) && (! (!*d || *d == ';' || *d == '{' || *d == '}') )) {
226 /* trailing non-numeric data */
227 BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
235 *ssaw_decimal = saw_decimal;
242 =for apidoc scan_version
244 Returns a pointer to the next character after the parsed
245 version string, as well as upgrading the passed in SV to
248 Function must be called with an already existing SV like
251 s = scan_version(s, SV *sv, bool qv);
253 Performs some preprocessing to the string to ensure that
254 it has the correct characteristics of a version. Flags the
255 object if it contains an underscore (which denotes this
256 is an alpha version). The boolean qv denotes that the version
257 should be interpreted as if it had multiple decimals, even if
264 #ifdef VUTIL_REPLACE_CORE
265 Perl_scan_version2(pTHX_ const char *s, SV *rv, bool qv)
267 Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
270 const char *start = s;
273 const char *errstr = NULL;
281 PERL_ARGS_ASSERT_SCAN_VERSION;
283 while (isSPACE(*s)) /* leading whitespace is OK */
286 last = PRESCAN_VERSION(s, FALSE, &errstr, &qv, &saw_decimal, &width, &alpha);
288 /* "undef" is a special case and not an error */
289 if ( ! ( *s == 'u' && strEQ(s+1,"ndef")) ) {
290 Perl_croak(aTHX_ "%s", errstr);
299 /* Now that we are through the prescan, start creating the object */
301 hv = newSVrv(rv, "version"); /* create an SV and upgrade the RV */
302 (void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
304 #ifndef NODEFAULT_SHAREKEYS
305 HvSHAREKEYS_on(hv); /* key-sharing on by default */
309 (void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(qv));
311 (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(alpha));
312 if ( !qv && width < 3 )
313 (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
315 while (isDIGIT(*pos))
317 if (!isALPHA(*pos)) {
323 /* this is atoi() that delimits on underscores */
324 const char *end = pos;
328 /* the following if() will only be true after the decimal
329 * point of a version originally created with a bare
330 * floating point number, i.e. not quoted in any way
332 if ( !qv && s > start && saw_decimal == 1 ) {
336 rev += (*s - '0') * mult;
338 if ( (PERL_ABS(orev) > PERL_ABS(rev))
339 || (PERL_ABS(rev) > VERSION_MAX )) {
340 Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
341 "Integer overflow in version %d",VERSION_MAX);
354 rev += (*end - '0') * mult;
356 if ( (PERL_ABS(orev) > PERL_ABS(rev))
357 || (PERL_ABS(rev) > VERSION_MAX )) {
358 Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
359 "Integer overflow in version");
368 /* Append revision */
369 av_push(av, newSViv(rev));
374 else if ( *pos == '.' )
376 else if ( *pos == '_' && isDIGIT(pos[1]) )
378 else if ( *pos == ',' && isDIGIT(pos[1]) )
380 else if ( isDIGIT(*pos) )
387 while ( isDIGIT(*pos) )
392 while ( ( isDIGIT(*pos) || *pos == '_' ) && digits < 3 ) {
400 if ( qv ) { /* quoted versions always get at least three terms*/
401 SSize_t len = AvFILLp(av);
402 /* This for loop appears to trigger a compiler bug on OS X, as it
403 loops infinitely. Yes, len is negative. No, it makes no sense.
404 Compiler in question is:
405 gcc version 3.3 20030304 (Apple Computer, Inc. build 1640)
406 for ( len = 2 - len; len > 0; len-- )
407 av_push(MUTABLE_AV(sv), newSViv(0));
411 av_push(av, newSViv(0));
414 /* need to save off the current version string for later */
416 SV * orig = newSVpvn("v.Inf", sizeof("v.Inf")-1);
417 (void)hv_stores(MUTABLE_HV(hv), "original", orig);
418 (void)hv_stores(MUTABLE_HV(hv), "vinf", newSViv(1));
420 else if ( s > start ) {
421 SV * orig = newSVpvn(start,s-start);
422 if ( qv && saw_decimal == 1 && *start != 'v' ) {
423 /* need to insert a v to be consistent */
424 sv_insert(orig, 0, 0, "v", 1);
426 (void)hv_stores(MUTABLE_HV(hv), "original", orig);
429 (void)hv_stores(MUTABLE_HV(hv), "original", newSVpvs("0"));
430 av_push(av, newSViv(0));
433 /* And finally, store the AV in the hash */
434 (void)hv_stores(MUTABLE_HV(hv), "version", newRV_noinc(MUTABLE_SV(av)));
436 /* fix RT#19517 - special case 'undef' as string */
437 if ( *s == 'u' && strEQ(s+1,"ndef") ) {
445 =for apidoc new_version
447 Returns a new version object based on the passed in SV:
449 SV *sv = new_version(SV *ver);
451 Does not alter the passed in ver SV. See "upg_version" if you
452 want to upgrade the SV.
458 #ifdef VUTIL_REPLACE_CORE
459 Perl_new_version2(pTHX_ SV *ver)
461 Perl_new_version(pTHX_ SV *ver)
465 SV * const rv = newSV(0);
466 PERL_ARGS_ASSERT_NEW_VERSION;
467 if ( ISA_VERSION_OBJ(ver) ) /* can just copy directly */
470 AV * const av = newAV();
472 /* This will get reblessed later if a derived class*/
473 SV * const hv = newSVrv(rv, "version");
474 (void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */
475 #ifndef NODEFAULT_SHAREKEYS
476 HvSHAREKEYS_on(hv); /* key-sharing on by default */
482 /* Begin copying all of the elements */
483 if ( hv_exists(MUTABLE_HV(ver), "qv", 2) )
484 (void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(1));
486 if ( hv_exists(MUTABLE_HV(ver), "alpha", 5) )
487 (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(1));
489 SV ** svp = hv_fetchs(MUTABLE_HV(ver), "width", FALSE);
491 const I32 width = SvIV(*svp);
492 (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width));
496 SV ** svp = hv_fetchs(MUTABLE_HV(ver), "original", FALSE);
498 (void)hv_stores(MUTABLE_HV(hv), "original", newSVsv(*svp));
500 sav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(ver), "version", FALSE)));
501 /* This will get reblessed later if a derived class*/
502 for ( key = 0; key <= av_len(sav); key++ )
504 SV * const sv = *av_fetch(sav, key, FALSE);
505 const I32 rev = SvIV(sv);
506 av_push(av, newSViv(rev));
509 (void)hv_stores(MUTABLE_HV(hv), "version", newRV_noinc(MUTABLE_SV(av)));
514 const MAGIC* const mg = SvVSTRING_mg(ver);
515 if ( mg ) { /* already a v-string */
516 const STRLEN len = mg->mg_len;
517 const char * const version = (const char*)mg->mg_ptr;
518 sv_setpvn(rv,version,len);
519 /* this is for consistency with the pure Perl class */
520 if ( isDIGIT(*version) )
521 sv_insert(rv, 0, 0, "v", 1);
525 SvSetSV_nosteal(rv, ver); /* make a duplicate */
530 sv_2mortal(rv); /* in case upg_version croaks before it returns */
531 return SvREFCNT_inc_NN(UPG_VERSION(rv, FALSE));
535 =for apidoc upg_version
537 In-place upgrade of the supplied SV to a version object.
539 SV *sv = upg_version(SV *sv, bool qv);
541 Returns a pointer to the upgraded SV. Set the boolean qv if you want
542 to force this SV to be interpreted as an "extended" version.
548 #ifdef VUTIL_REPLACE_CORE
549 Perl_upg_version2(pTHX_ SV *ver, bool qv)
551 Perl_upg_version(pTHX_ SV *ver, bool qv)
554 const char *version, *s;
559 #if PERL_VERSION_LT(5,19,8) && defined(USE_ITHREADS)
562 PERL_ARGS_ASSERT_UPG_VERSION;
564 if ( (SvUOK(ver) && SvUVX(ver) > VERSION_MAX)
565 || (SvIOK(ver) && SvIVX(ver) > VERSION_MAX) ) {
566 /* out of bounds [unsigned] integer */
569 len = my_snprintf(tbuf, sizeof(tbuf), "%d", VERSION_MAX);
570 version = savepvn(tbuf, len);
572 Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
573 "Integer overflow in version %d",VERSION_MAX);
575 else if ( SvUOK(ver) || SvIOK(ver))
576 #if PERL_VERSION_LT(5,17,2)
580 version = savesvpv(ver);
583 else if (SvNOK(ver) && !( SvPOK(ver) && SvCUR(ver) == 3 ) )
584 #if PERL_VERSION_LT(5,17,2)
590 /* may get too much accuracy */
592 SV *sv = SvNVX(ver) > 10e50 ? newSV(64) : 0;
594 #ifdef USE_LOCALE_NUMERIC
595 const char * const cur_numeric = setlocale(LC_NUMERIC, NULL);
598 /* XS code can set the locale without us knowing. To protect the
599 * version number parsing, which requires the radix character to be a
600 * dot, update our records as to what the locale is, so that our
601 * existing macro mechanism can correctly change it to a dot and back
602 * if necessary. This code is extremely unlikely to be in a loop, so
603 * the extra work will have a negligible performance impact. See [perl
606 * If the current locale is a standard one, but we are expecting it to
607 * be a different, underlying locale, update our records to make the
608 * underlying locale this (standard) one. If the current locale is not
609 * a standard one, we should be expecting a non-standard one, the same
610 * one that we have recorded as the underlying locale. If not, update
612 if (strEQ(cur_numeric, "C") || strEQ(cur_numeric, "POSIX")) {
613 if (! PL_numeric_standard) {
614 new_numeric(cur_numeric);
617 else if (PL_numeric_standard
619 || strNE(PL_numeric_name, cur_numeric))
621 new_numeric(cur_numeric);
624 { /* Braces needed because macro just below declares a variable */
625 STORE_NUMERIC_LOCAL_SET_STANDARD();
626 LOCK_NUMERIC_STANDARD();
628 Perl_sv_catpvf(aTHX_ sv, "%.9"NVff, SvNVX(ver));
633 len = my_snprintf(tbuf, sizeof(tbuf), "%.9"NVff, SvNVX(ver));
636 UNLOCK_NUMERIC_STANDARD();
637 RESTORE_NUMERIC_LOCAL();
639 while (buf[len-1] == '0' && len > 0) len--;
640 if ( buf[len-1] == '.' ) len--; /* eat the trailing decimal */
641 version = savepvn(buf, len);
646 else if ( (mg = SvVSTRING_mg(ver)) ) { /* already a v-string */
647 version = savepvn( (const char*)mg->mg_ptr,mg->mg_len );
652 else if ( SvPOK(ver))/* must be a string or something like a string */
653 #if PERL_VERSION_LT(5,17,2)
658 version = savepvn(SvPV(ver,len), SvCUR(ver));
661 # if PERL_VERSION > 5
662 /* This will only be executed for 5.6.0 - 5.8.0 inclusive */
663 if ( len >= 3 && !instr(version,".") && !instr(version,"_")) {
664 /* may be a v-string */
665 char *testv = (char *)version;
667 for (tlen=0; tlen < len; tlen++, testv++) {
668 /* if one of the characters is non-text assume v-string */
669 if (testv[0] < ' ') {
670 SV * const nsv = sv_newmortal();
674 sv_setpvf(nsv,"v%vd",ver);
675 pos = nver = savepv(SvPV_nolen(nsv));
678 /* scan the resulting formatted string */
679 pos++; /* skip the leading 'v' */
680 while ( *pos == '.' || isDIGIT(*pos) ) {
686 /* is definitely a v-string */
687 if ( saw_decimal >= 2 ) {
697 #if PERL_VERSION_LT(5,17,2)
698 else if (SvIOKp(ver)) {
701 else if (SvNOKp(ver)) {
704 else if (SvPOKp(ver)) {
710 /* no idea what this is */
711 Perl_croak(aTHX_ "Invalid version format (non-numeric data)");
714 s = SCAN_VERSION(version, ver, qv);
716 Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
717 "Version string '%s' contains invalid data; "
718 "ignoring: '%s'", version, s);
720 #if PERL_VERSION_LT(5,19,8) && defined(USE_ITHREADS)
730 Validates that the SV contains valid internal structure for a version object.
731 It may be passed either the version object (RV) or the hash itself (HV). If
732 the structure is valid, it returns the HV. If the structure is invalid,
735 SV *hv = vverify(sv);
737 Note that it only confirms the bare minimum structure (so as not to get
738 confused by derived classes which may contain additional hash entries):
742 =item * The SV is an HV or a reference to an HV
744 =item * The hash contains a "version" key
746 =item * The "version" key has a reference to an AV as its value
754 #ifdef VUTIL_REPLACE_CORE
755 Perl_vverify2(pTHX_ SV *vs)
757 Perl_vverify(pTHX_ SV *vs)
763 PERL_ARGS_ASSERT_VVERIFY;
768 /* see if the appropriate elements exist */
769 if ( SvTYPE(vs) == SVt_PVHV
770 && (svp = hv_fetchs(MUTABLE_HV(vs), "version", FALSE))
772 && SvTYPE(sv) == SVt_PVAV )
781 Accepts a version object and returns the normalized floating
782 point representation. Call like:
786 NOTE: you can pass either the object directly or the SV
787 contained within the RV.
789 The SV returned has a refcount of 1.
795 #ifdef VUTIL_REPLACE_CORE
796 Perl_vnumify2(pTHX_ SV *vs)
798 Perl_vnumify(pTHX_ SV *vs)
808 PERL_ARGS_ASSERT_VNUMIFY;
810 /* extract the HV from the object */
813 Perl_croak(aTHX_ "Invalid version object");
815 /* see if various flags exist */
816 if ( hv_exists(MUTABLE_HV(vs), "alpha", 5 ) )
819 SV ** svp = hv_fetchs(MUTABLE_HV(vs), "width", FALSE);
827 /* attempt to retrieve the version array */
828 if ( !(av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE))) ) ) {
829 return newSVpvs("0");
835 return newSVpvs("0");
839 SV * tsv = *av_fetch(av, 0, 0);
842 sv = Perl_newSVpvf(aTHX_ "%d.", (int)PERL_ABS(digit));
843 for ( i = 1 ; i < len ; i++ )
845 SV * tsv = *av_fetch(av, i, 0);
848 const int denom = (width == 2 ? 10 : 100);
849 const div_t term = div((int)PERL_ABS(digit),denom);
850 Perl_sv_catpvf(aTHX_ sv, "%0*d_%d", width, term.quot, term.rem);
853 Perl_sv_catpvf(aTHX_ sv, "%0*d", width, (int)digit);
859 SV * tsv = *av_fetch(av, len, 0);
861 if ( alpha && width == 3 ) /* alpha version */
863 Perl_sv_catpvf(aTHX_ sv, "%0*d", width, (int)digit);
867 sv_catpvs(sv, "000");
875 Accepts a version object and returns the normalized string
876 representation. Call like:
880 NOTE: you can pass either the object directly or the SV
881 contained within the RV.
883 The SV returned has a refcount of 1.
889 #ifdef VUTIL_REPLACE_CORE
890 Perl_vnormal2(pTHX_ SV *vs)
892 Perl_vnormal(pTHX_ SV *vs)
900 PERL_ARGS_ASSERT_VNORMAL;
902 /* extract the HV from the object */
905 Perl_croak(aTHX_ "Invalid version object");
907 if ( hv_exists(MUTABLE_HV(vs), "alpha", 5 ) )
909 av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE)));
917 SV * tsv = *av_fetch(av, 0, 0);
920 sv = Perl_newSVpvf(aTHX_ "v%"IVdf, (IV)digit);
921 for ( i = 1 ; i < len ; i++ ) {
922 SV * tsv = *av_fetch(av, i, 0);
924 Perl_sv_catpvf(aTHX_ sv, ".%"IVdf, (IV)digit);
929 /* handle last digit specially */
930 SV * tsv = *av_fetch(av, len, 0);
933 Perl_sv_catpvf(aTHX_ sv, "_%"IVdf, (IV)digit);
935 Perl_sv_catpvf(aTHX_ sv, ".%"IVdf, (IV)digit);
938 if ( len <= 2 ) { /* short version, must be at least three */
939 for ( len = 2 - len; len != 0; len-- )
946 =for apidoc vstringify
948 In order to maintain maximum compatibility with earlier versions
949 of Perl, this function will return either the floating point
950 notation or the multiple dotted notation, depending on whether
951 the original version contained 1 or more dots, respectively.
953 The SV returned has a refcount of 1.
959 #ifdef VUTIL_REPLACE_CORE
960 Perl_vstringify2(pTHX_ SV *vs)
962 Perl_vstringify(pTHX_ SV *vs)
966 PERL_ARGS_ASSERT_VSTRINGIFY;
968 /* extract the HV from the object */
971 Perl_croak(aTHX_ "Invalid version object");
973 svp = hv_fetchs(MUTABLE_HV(vs), "original", FALSE);
983 if ( hv_exists(MUTABLE_HV(vs), "qv", 2) )
993 Version object aware cmp. Both operands must already have been
994 converted into version objects.
1000 #ifdef VUTIL_REPLACE_CORE
1001 Perl_vcmp2(pTHX_ SV *lhv, SV *rhv)
1003 Perl_vcmp(pTHX_ SV *lhv, SV *rhv)
1008 bool lalpha = FALSE;
1009 bool ralpha = FALSE;
1014 PERL_ARGS_ASSERT_VCMP;
1016 /* extract the HVs from the objects */
1019 if ( ! ( lhv && rhv ) )
1020 Perl_croak(aTHX_ "Invalid version object");
1022 /* get the left hand term */
1023 lav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(lhv), "version", FALSE)));
1024 if ( hv_exists(MUTABLE_HV(lhv), "alpha", 5 ) )
1027 /* and the right hand term */
1028 rav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(rhv), "version", FALSE)));
1029 if ( hv_exists(MUTABLE_HV(rhv), "alpha", 5 ) )
1037 while ( i <= m && retval == 0 )
1039 SV * const lsv = *av_fetch(lav,i,0);
1042 rsv = *av_fetch(rav,i,0);
1051 /* tiebreaker for alpha with identical terms */
1052 if ( retval == 0 && l == r && left == right && ( lalpha || ralpha ) )
1054 if ( lalpha && !ralpha )
1058 else if ( ralpha && !lalpha)
1064 if ( l != r && retval == 0 ) /* possible match except for trailing 0's */
1068 while ( i <= r && retval == 0 )
1070 SV * const rsv = *av_fetch(rav,i,0);
1071 if ( SvIV(rsv) != 0 )
1072 retval = -1; /* not a match after all */
1078 while ( i <= l && retval == 0 )
1080 SV * const lsv = *av_fetch(lav,i,0);
1081 if ( SvIV(lsv) != 0 )
1082 retval = +1; /* not a match after all */