diff options
| -rw-r--r-- | universal.c | 1 | ||||
| -rw-r--r-- | util.c | 29 |
2 files changed, 21 insertions, 9 deletions
diff --git a/universal.c b/universal.c index 4a879e9750..7e80da2e72 100644 --- a/universal.c +++ b/universal.c @@ -192,6 +192,7 @@ Perl_boot_core_UNIVERSAL(pTHX) sv_inc(sv); SvSETMAGIC(sv); /* Make it findable via fetchmethod */ + newXS("version::()", XS_version_noop, file); newXS("version::new", XS_version_new, file); newXS("version::(\"\"", XS_version_stringify, file); newXS("version::stringify", XS_version_stringify, file); @@ -4155,27 +4155,34 @@ is a beta version). char * Perl_scan_version(pTHX_ char *version, SV *rv) { - char *d; + char* d; int beta = 0; - SV * sv = newSVrv(rv, "version"); /* create an SV and upgrade the RV */ + SV* sv = newSVrv(rv, "version"); /* create an SV and upgrade the RV */ d = version; if (*d == 'v') d++; if (isDIGIT(*d)) { - while (isDIGIT(*d) || *d == '.') + while (isDIGIT(*d) || *d == '.' || *d == '\0') d++; - if ( *d == '_' ) { + if (*d == '_') { *d = '.'; - if ( *(d+1) == '0' && *(d+2) != '0' ) { /* perl-style version */ + if (*(d+1) == '0' && *(d+2) != '0') { /* perl-style version */ *(d+1) = *(d+2); *(d+2) = '0'; + if (ckWARN(WARN_PORTABLE)) + Perl_warner(aTHX_ packWARN(WARN_PORTABLE), + "perl-style version not portable"); } else { beta = -1; } } + while (isDIGIT(*d) || *d == '.' || *d == '\0') + d++; + if (*d == '_') + Perl_croak(aTHX_ "Invalid version format (multiple underscores)"); } - version = scan_vstring(version,sv); /* store the v-string in the object */ + version = scan_vstring(version, sv); /* store the v-string in the object */ SvIVX(sv) = beta; return version; } @@ -4299,10 +4306,14 @@ Perl_vstringify(pTHX_ SV *sv, SV *vs) pv += retlen, len -= retlen) { digit = utf8_to_uvchr(pv,&retlen); - Perl_sv_catpvf(aTHX_ sv,".%03"UVf,digit); + Perl_sv_catpvf(aTHX_ sv,".%"UVf,digit); + } + if (SvIVX(vs) < 0) { + char* pv = SvPVX(sv); + for (pv += SvCUR(sv); *pv != '.'; pv--) + ; + *pv = '_'; } - if ( SvIVX(vs) < 0 ) - sv_catpv(sv,"beta"); return sv; } |