diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 1d148149af96e..d3a19a24ca25f 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1296,7 +1296,8 @@ package Maintainers; }, 'version' => { - 'DISTRIBUTION' => 'LEONT/version-0.9929.tar.gz', + 'DISTRIBUTION' => 'LEONT/version-0.9930.tar.gz', + 'SYNCINFO' => 'LeoNerd on Mon Sep 18 21:49:09 2023', 'FILES' => q[cpan/version vutil.c vutil.h vxs.inc], 'EXCLUDED' => [ qr{^vutil/lib/}, diff --git a/cpan/version/lib/version.pm b/cpan/version/lib/version.pm index 3b9786c184910..ea47b94eb0768 100644 --- a/cpan/version/lib/version.pm +++ b/cpan/version/lib/version.pm @@ -8,7 +8,7 @@ if ($] >= 5.015) { warnings::register_categories(qw/version/); } -our $VERSION = 0.9929; +our $VERSION = '0.9930'; our $CLASS = 'version'; our (@ISA, $STRICT, $LAX); diff --git a/cpan/version/lib/version/regex.pm b/cpan/version/lib/version/regex.pm index caaebe687c559..9964b3865364b 100644 --- a/cpan/version/lib/version/regex.pm +++ b/cpan/version/lib/version/regex.pm @@ -2,7 +2,7 @@ package version::regex; use strict; -our $VERSION = 0.9929; +our $VERSION = '0.9930'; #--------------------------------------------------------------------------# # Version regexp components diff --git a/cpan/version/t/01base.t b/cpan/version/t/01base.t index d60abae4f4f6c..68426950332ac 100644 --- a/cpan/version/t/01base.t +++ b/cpan/version/t/01base.t @@ -14,7 +14,7 @@ BEGIN { ) ); require $coretests; - use_ok('version', 0.9929); + use_ok('version', 0.9930); } BaseTests("version","new","qv"); diff --git a/cpan/version/t/02derived.t b/cpan/version/t/02derived.t index 815b592f48e27..203fe5f331527 100644 --- a/cpan/version/t/02derived.t +++ b/cpan/version/t/02derived.t @@ -15,7 +15,7 @@ BEGIN { ) ); require $coretests; - use_ok("version", 0.9929); + use_ok("version", 0.9930); # If we made it this far, we are ok. } diff --git a/cpan/version/t/03require.t b/cpan/version/t/03require.t index a7a72baa1c826..1e421a23883c1 100644 --- a/cpan/version/t/03require.t +++ b/cpan/version/t/03require.t @@ -19,7 +19,7 @@ BEGIN { # Don't want to use, because we need to make sure that the import doesn't # fire just yet (some code does this to avoid importing qv() and delare()). require_ok("version"); -is $version::VERSION, 0.9929, "Make sure we have the correct class"; +is $version::VERSION, '0.9930', "Make sure we have the correct class"; ok(!"main"->can("qv"), "We don't have the imported qv()"); ok(!"main"->can("declare"), "We don't have the imported declare()"); diff --git a/cpan/version/t/05sigdie.t b/cpan/version/t/05sigdie.t index 8d98e5c440760..84a17a04b4145 100644 --- a/cpan/version/t/05sigdie.t +++ b/cpan/version/t/05sigdie.t @@ -14,7 +14,7 @@ BEGIN { } BEGIN { - use version 0.9929; + use version 0.9930; } pass "Didn't get caught by the wrong DIE handler, which is a good thing"; diff --git a/cpan/version/t/06noop.t b/cpan/version/t/06noop.t index b5cf08a330155..b711da8bc5b33 100644 --- a/cpan/version/t/06noop.t +++ b/cpan/version/t/06noop.t @@ -7,7 +7,7 @@ use Test::More qw/no_plan/; BEGIN { - use_ok('version', 0.9929); + use_ok('version', 0.9930); } my $v1 = 'version'->new('1.2'); diff --git a/cpan/version/t/08_corelist.t b/cpan/version/t/08_corelist.t index a0b4fdd31f4ab..8ee8034725881 100644 --- a/cpan/version/t/08_corelist.t +++ b/cpan/version/t/08_corelist.t @@ -5,7 +5,7 @@ ######################### use Test::More tests => 3; -use_ok("version", 0.9929); +use_ok("version", 0.9930); # do strict lax tests in a sub to isolate a package to test importing SKIP: { diff --git a/cpan/version/t/09_list_util.t b/cpan/version/t/09_list_util.t index cf354072edfca..f7c33b9ac5558 100644 --- a/cpan/version/t/09_list_util.t +++ b/cpan/version/t/09_list_util.t @@ -4,7 +4,7 @@ ######################### use strict; -use_ok("version", 0.9929); +use_ok("version", 0.9930); use Test::More; BEGIN { diff --git a/cpan/version/t/coretests.pm b/cpan/version/t/coretests.pm index b38b275c7decd..7966d3d0f01f0 100644 --- a/cpan/version/t/coretests.pm +++ b/cpan/version/t/coretests.pm @@ -570,7 +570,7 @@ SKIP: { or diag $@; $_112478::VERSION = 1; eval { _112478->VERSION(9e99) }; - unlike $@, qr/panic/, '->VERSION(9e99) does not panic'; + unlike $@, qr/^panic: /, '->VERSION(9e99) does not panic'; } { # https://rt.cpan.org/Ticket/Display.html?id=79259 diff --git a/t/porting/customized.dat b/t/porting/customized.dat index 56d05b5845528..9cfaf2e765b79 100644 --- a/t/porting/customized.dat +++ b/t/porting/customized.dat @@ -17,5 +17,5 @@ Time::Piece cpan/Time-Piece/Piece.pm 8cec8b66183ceddb9bf2b6af35dcdd345bc9adfa Time::Piece cpan/Time-Piece/Piece.xs 543152540ee17788a638b2c5746b86c3d04401d1 Win32API::File cpan/Win32API-File/File.pm 8fd212857f821cb26648878b96e57f13bf21b99e Win32API::File cpan/Win32API-File/File.xs beb870fed4490d2faa547b4a8576b8d64d1d27c5 -version cpan/version/lib/version.pm a963b513cf812bd7f4d28b3422efd9904e70a34c +version cpan/version/lib/version.pm 8080cfe1fb21d5248c8ff5133b298d249d11e8e8 version cpan/version/t/07locale.t b1cceee71544ce6b6c926d06656a52aabbfe8abf diff --git a/vutil.c b/vutil.c index ab05c33c575e3..e2d908e47a455 100644 --- a/vutil.c +++ b/vutil.c @@ -7,6 +7,28 @@ #define VERSION_MAX 0x7FFFFFFF +#ifndef STRLENs +# define STRLENs(s) (sizeof("" s "") - 1) +#endif +#ifndef POSIX_SETLOCALE_LOCK +# ifdef gwLOCALE_LOCK +# define POSIX_SETLOCALE_LOCK gwLOCALE_LOCK +# define POSIX_SETLOCALE_UNLOCK gwLOCALE_UNLOCK +# else +# define POSIX_SETLOCALE_LOCK NOOP +# define POSIX_SETLOCALE_UNLOCK NOOP +# endif +#endif +#ifndef DISABLE_LC_NUMERIC_CHANGES +# ifdef LOCK_LC_NUMERIC_STANDARD +# define DISABLE_LC_NUMERIC_CHANGES() LOCK_LC_NUMERIC_STANDARD() +# define REENABLE_LC_NUMERIC_CHANGES() UNLOCK_LC_NUMERIC_STANDARD() +# else +# define DISABLE_LC_NUMERIC_CHANGES() NOOP +# define REENABLE_LC_NUMERIC_CHANGES() NOOP +# endif +#endif + /* =for apidoc prescan_version @@ -23,8 +45,8 @@ 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) { + const char **errstr, + bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha) { bool qv = (sqv ? *sqv : FALSE); int width = 3; int saw_decimal = 0; @@ -35,200 +57,200 @@ Perl_prescan_version(pTHX_ const char *s, bool strict, PERL_UNUSED_CONTEXT; if (qv && isDIGIT(*d)) - goto dotted_decimal_version; + goto dotted_decimal_version; if (*d == 'v') { /* explicit v-string */ - d++; - if (isDIGIT(*d)) { - qv = TRUE; - } - else { /* degenerate v-string */ - /* requires v1.2.3 */ - BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)"); - } + d++; + if (isDIGIT(*d)) { + qv = TRUE; + } + else { /* degenerate v-string */ + /* requires v1.2.3 */ + BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)"); + } dotted_decimal_version: - if (strict && d[0] == '0' && isDIGIT(d[1])) { - /* no leading zeros allowed */ - BADVERSION(s,errstr,"Invalid version format (no leading zeros)"); - } - - while (isDIGIT(*d)) /* integer part */ - d++; - - if (*d == '.') - { - saw_decimal++; - d++; /* decimal point */ - } - else - { - if (strict) { - /* require v1.2.3 */ - BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)"); - } - else { - goto version_prescan_finish; - } - } - - { - int i = 0; - int j = 0; - while (isDIGIT(*d)) { /* just keep reading */ - i++; - while (isDIGIT(*d)) { - d++; j++; - /* maximum 3 digits between decimal */ - if (strict && j > 3) { - BADVERSION(s,errstr,"Invalid version format (maximum 3 digits between decimals)"); - } - } - if (*d == '_') { - if (strict) { - BADVERSION(s,errstr,"Invalid version format (no underscores)"); - } - if ( alpha ) { - BADVERSION(s,errstr,"Invalid version format (multiple underscores)"); - } - d++; - alpha = TRUE; - } - else if (*d == '.') { - if (alpha) { - BADVERSION(s,errstr,"Invalid version format (underscores before decimal)"); - } - saw_decimal++; - d++; - } - else if (!isDIGIT(*d)) { - break; - } - j = 0; - } - - if (strict && i < 2) { - /* requires v1.2.3 */ - BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)"); - } - } - } /* end if dotted-decimal */ + if (strict && d[0] == '0' && isDIGIT(d[1])) { + /* no leading zeros allowed */ + BADVERSION(s,errstr,"Invalid version format (no leading zeros)"); + } + + while (isDIGIT(*d)) /* integer part */ + d++; + + if (*d == '.') + { + saw_decimal++; + d++; /* decimal point */ + } + else + { + if (strict) { + /* require v1.2.3 */ + BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)"); + } + else { + goto version_prescan_finish; + } + } + + { + int i = 0; + int j = 0; + while (isDIGIT(*d)) { /* just keep reading */ + i++; + while (isDIGIT(*d)) { + d++; j++; + /* maximum 3 digits between decimal */ + if (strict && j > 3) { + BADVERSION(s,errstr,"Invalid version format (maximum 3 digits between decimals)"); + } + } + if (*d == '_') { + if (strict) { + BADVERSION(s,errstr,"Invalid version format (no underscores)"); + } + if ( alpha ) { + BADVERSION(s,errstr,"Invalid version format (multiple underscores)"); + } + d++; + alpha = TRUE; + } + else if (*d == '.') { + if (alpha) { + BADVERSION(s,errstr,"Invalid version format (underscores before decimal)"); + } + saw_decimal++; + d++; + } + else if (!isDIGIT(*d)) { + break; + } + j = 0; + } + + if (strict && i < 2) { + /* requires v1.2.3 */ + BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions require at least three parts)"); + } + } + } /* end if dotted-decimal */ else - { /* decimal versions */ - int j = 0; /* may need this later */ - /* special strict case for leading '.' or '0' */ - if (strict) { - if (*d == '.') { - BADVERSION(s,errstr,"Invalid version format (0 before decimal required)"); - } - if (*d == '0' && isDIGIT(d[1])) { - BADVERSION(s,errstr,"Invalid version format (no leading zeros)"); - } - } - - /* and we never support negative versions */ - if ( *d == '-') { - BADVERSION(s,errstr,"Invalid version format (negative version number)"); - } - - /* consume all of the integer part */ - while (isDIGIT(*d)) - d++; - - /* look for a fractional part */ - if (*d == '.') { - /* we found it, so consume it */ - saw_decimal++; - d++; - } - else if (!*d || *d == ';' || isSPACE(*d) || *d == '{' || *d == '}') { - if ( d == s ) { - /* found nothing */ - BADVERSION(s,errstr,"Invalid version format (version required)"); - } - /* found just an integer */ - goto version_prescan_finish; - } - else if ( d == s ) { - /* didn't find either integer or period */ - BADVERSION(s,errstr,"Invalid version format (non-numeric data)"); - } - else if (*d == '_') { - /* underscore can't come after integer part */ - if (strict) { - BADVERSION(s,errstr,"Invalid version format (no underscores)"); - } - else if (isDIGIT(d[1])) { - BADVERSION(s,errstr,"Invalid version format (alpha without decimal)"); - } - else { - BADVERSION(s,errstr,"Invalid version format (misplaced underscore)"); - } - } - else { - /* anything else after integer part is just invalid data */ - BADVERSION(s,errstr,"Invalid version format (non-numeric data)"); - } - - /* scan the fractional part after the decimal point*/ - - if (!isDIGIT(*d) && (strict || ! (!*d || *d == ';' || isSPACE(*d) || *d == '{' || *d == '}') )) { - /* strict or lax-but-not-the-end */ - BADVERSION(s,errstr,"Invalid version format (fractional part required)"); - } - - while (isDIGIT(*d)) { - d++; j++; - if (*d == '.' && isDIGIT(d[-1])) { - if (alpha) { - BADVERSION(s,errstr,"Invalid version format (underscores before decimal)"); - } - if (strict) { - BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions must begin with 'v')"); - } - d = (char *)s; /* start all over again */ - qv = TRUE; - goto dotted_decimal_version; - } - if (*d == '_') { - if (strict) { - BADVERSION(s,errstr,"Invalid version format (no underscores)"); - } - if ( alpha ) { - BADVERSION(s,errstr,"Invalid version format (multiple underscores)"); - } - if ( ! isDIGIT(d[1]) ) { - BADVERSION(s,errstr,"Invalid version format (misplaced underscore)"); - } - width = j; - d++; - alpha = TRUE; - } - } + { /* decimal versions */ + int j = 0; /* may need this later */ + /* special strict case for leading '.' or '0' */ + if (strict) { + if (*d == '.') { + BADVERSION(s,errstr,"Invalid version format (0 before decimal required)"); + } + if (*d == '0' && isDIGIT(d[1])) { + BADVERSION(s,errstr,"Invalid version format (no leading zeros)"); + } + } + + /* and we never support negative versions */ + if ( *d == '-') { + BADVERSION(s,errstr,"Invalid version format (negative version number)"); + } + + /* consume all of the integer part */ + while (isDIGIT(*d)) + d++; + + /* look for a fractional part */ + if (*d == '.') { + /* we found it, so consume it */ + saw_decimal++; + d++; + } + else if (!*d || *d == ';' || isSPACE(*d) || *d == '{' || *d == '}') { + if ( d == s ) { + /* found nothing */ + BADVERSION(s,errstr,"Invalid version format (version required)"); + } + /* found just an integer */ + goto version_prescan_finish; + } + else if ( d == s ) { + /* didn't find either integer or period */ + BADVERSION(s,errstr,"Invalid version format (non-numeric data)"); + } + else if (*d == '_') { + /* underscore can't come after integer part */ + if (strict) { + BADVERSION(s,errstr,"Invalid version format (no underscores)"); + } + else if (isDIGIT(d[1])) { + BADVERSION(s,errstr,"Invalid version format (alpha without decimal)"); + } + else { + BADVERSION(s,errstr,"Invalid version format (misplaced underscore)"); + } + } + else { + /* anything else after integer part is just invalid data */ + BADVERSION(s,errstr,"Invalid version format (non-numeric data)"); + } + + /* scan the fractional part after the decimal point*/ + + if (!isDIGIT(*d) && (strict || ! (!*d || *d == ';' || isSPACE(*d) || *d == '{' || *d == '}') )) { + /* strict or lax-but-not-the-end */ + BADVERSION(s,errstr,"Invalid version format (fractional part required)"); + } + + while (isDIGIT(*d)) { + d++; j++; + if (*d == '.' && isDIGIT(d[-1])) { + if (alpha) { + BADVERSION(s,errstr,"Invalid version format (underscores before decimal)"); + } + if (strict) { + BADVERSION(s,errstr,"Invalid version format (dotted-decimal versions must begin with 'v')"); + } + d = (char *)s; /* start all over again */ + qv = TRUE; + goto dotted_decimal_version; + } + if (*d == '_') { + if (strict) { + BADVERSION(s,errstr,"Invalid version format (no underscores)"); + } + if ( alpha ) { + BADVERSION(s,errstr,"Invalid version format (multiple underscores)"); + } + if ( ! isDIGIT(d[1]) ) { + BADVERSION(s,errstr,"Invalid version format (misplaced underscore)"); + } + width = j; + d++; + alpha = TRUE; + } + } } version_prescan_finish: while (isSPACE(*d)) - d++; + d++; - if (!isDIGIT(*d) && (! (!*d || *d == ';' || *d == '{' || *d == '}') )) { - /* trailing non-numeric data */ - BADVERSION(s,errstr,"Invalid version format (non-numeric data)"); + if (!isDIGIT(*d) && (! (!*d || *d == ';' || *d == ':' || *d == '{' || *d == '}') )) { + /* 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)"); + /* no trailing period allowed */ + BADVERSION(s,errstr,"Invalid version format (trailing decimal)"); } if (sqv) - *sqv = qv; + *sqv = qv; if (swidth) - *swidth = width; + *swidth = width; if (ssaw_decimal) - *ssaw_decimal = saw_decimal; + *ssaw_decimal = saw_decimal; if (salpha) - *salpha = alpha; + *salpha = alpha; return d; } @@ -275,19 +297,19 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv) PERL_ARGS_ASSERT_SCAN_VERSION; while (isSPACE(*s)) /* leading whitespace is OK */ - s++; + s++; 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+1,"ndef")) ) { - Perl_croak(aTHX_ "%s", errstr); - } + /* "undef" is a special case and not an error */ + if ( ! ( *s == 'u' && strEQ(s+1,"ndef")) ) { + Perl_croak(aTHX_ "%s", errstr); + } } start = s; if (*s == 'v') - s++; + s++; pos = s; /* Now that we are through the prescan, start creating the object */ @@ -300,66 +322,66 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv) #endif if ( qv ) - (void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(qv)); + (void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(qv)); if ( alpha ) - (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(alpha)); + (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(alpha)); if ( !qv && width < 3 ) - (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width)); + (void)hv_stores(MUTABLE_HV(hv), "width", newSViv(width)); while (isDIGIT(*pos) || *pos == '_') - pos++; + pos++; if (!isALPHA(*pos)) { - I32 rev; - - for (;;) { - rev = 0; - { - /* this is atoi() that delimits on underscores */ - const char *end = pos; - I32 mult = 1; - I32 orev; - - /* the following if() will only be true after the decimal - * point of a version originally created with a bare - * floating point number, i.e. not quoted in any way - */ - if ( !qv && s > start && saw_decimal == 1 ) { - mult *= 100; - while ( s < end ) { - if (*s == '_') - continue; - orev = rev; - rev += (*s - '0') * mult; - mult /= 10; - if ( (PERL_ABS(orev) > PERL_ABS(rev)) - || (PERL_ABS(rev) > VERSION_MAX )) { - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in version %d",VERSION_MAX); - s = end - 1; - rev = VERSION_MAX; - vinf = 1; - } - s++; - if ( *s == '_' ) - s++; - } - } - else { - while (--end >= s) { - int i; - if (*end == '_') - continue; - i = (*end - '0'); + I32 rev; + + for (;;) { + rev = 0; + { + /* this is atoi() that delimits on underscores */ + const char *end = pos; + I32 mult = 1; + I32 orev; + + /* the following if() will only be true after the decimal + * point of a version originally created with a bare + * floating point number, i.e. not quoted in any way + */ + if ( !qv && s > start && saw_decimal == 1 ) { + mult *= 100; + while ( s < end ) { + if (*s == '_') + continue; + orev = rev; + rev += (*s - '0') * mult; + mult /= 10; + if ( (PERL_ABS(orev) > PERL_ABS(rev)) + || (PERL_ABS(rev) > VERSION_MAX )) { + Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), + "Integer overflow in version %d",VERSION_MAX); + s = end - 1; + rev = VERSION_MAX; + vinf = 1; + } + s++; + if ( *s == '_' ) + s++; + } + } + else { + while (--end >= s) { + 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; - } + Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), + "Integer overflow in version"); + end = s - 1; + rev = VERSION_MAX; + vinf = 1; + } else rev += i * mult; @@ -367,79 +389,79 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv) mult = VERSION_MAX; else mult *= 10; - } - } - } - - /* Append revision */ - av_push(av, newSViv(rev)); - if ( vinf ) { - s = last; - break; - } - 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]) ) - s = ++pos; - else if ( isDIGIT(*pos) ) - s = pos; - else { - s = pos; - break; - } - if ( qv ) { - while ( isDIGIT(*pos) || *pos == '_') - pos++; - } - else { - int digits = 0; - while ( ( isDIGIT(*pos) || *pos == '_' ) && digits < 3 ) { - if ( *pos != '_' ) - digits++; - pos++; - } - } - } + } + } + } + + /* Append revision */ + av_push(av, newSViv(rev)); + if ( vinf ) { + s = last; + break; + } + 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]) ) + s = ++pos; + else if ( isDIGIT(*pos) ) + s = pos; + else { + s = pos; + break; + } + if ( qv ) { + while ( isDIGIT(*pos) || *pos == '_') + pos++; + } + else { + int digits = 0; + while ( ( isDIGIT(*pos) || *pos == '_' ) && digits < 3 ) { + if ( *pos != '_' ) + digits++; + pos++; + } + } + } } if ( qv ) { /* quoted versions always get at least three terms*/ - 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: - gcc version 3.3 20030304 (Apple Computer, Inc. build 1640) - for ( len = 2 - len; len > 0; len-- ) - av_push(MUTABLE_AV(sv), newSViv(0)); - */ - len = 2 - len; - while (len-- > 0) - av_push(av, newSViv(0)); + 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: + gcc version 3.3 20030304 (Apple Computer, Inc. build 1640) + for ( len = 2 - len; len > 0; len-- ) + av_push(MUTABLE_AV(sv), newSViv(0)); + */ + len = 2 - len; + while (len-- > 0) + av_push(av, newSViv(0)); } /* need to save off the current version string for later */ if ( vinf ) { - SV * orig = newSVpvn("v.Inf", sizeof("v.Inf")-1); - (void)hv_stores(MUTABLE_HV(hv), "original", orig); - (void)hv_stores(MUTABLE_HV(hv), "vinf", newSViv(1)); + SV * orig = newSVpvn("v.Inf", sizeof("v.Inf")-1); + (void)hv_stores(MUTABLE_HV(hv), "original", orig); + (void)hv_stores(MUTABLE_HV(hv), "vinf", newSViv(1)); } else if ( s > start ) { - SV * orig = newSVpvn(start,s-start); - if ( qv && saw_decimal == 1 && *start != 'v' ) { - /* need to insert a v to be consistent */ - sv_insert(orig, 0, 0, "v", 1); - } - (void)hv_stores(MUTABLE_HV(hv), "original", orig); + SV * orig = newSVpvn(start,s-start); + if ( qv && saw_decimal == 1 && *start != 'v' ) { + /* need to insert a v to be consistent */ + sv_insert(orig, 0, 0, "v", 1); + } + (void)hv_stores(MUTABLE_HV(hv), "original", orig); } else { - (void)hv_stores(MUTABLE_HV(hv), "original", newSVpvs("0")); - av_push(av, newSViv(0)); + (void)hv_stores(MUTABLE_HV(hv), "original", newSVpvs("0")); + av_push(av, newSViv(0)); } /* And finally, store the AV in the hash */ @@ -447,7 +469,7 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv) /* fix RT#19517 - special case 'undef' as string */ if ( *s == 'u' && strEQ(s+1,"ndef") ) { - s += 5; + s += 5; } return s; @@ -477,74 +499,74 @@ Perl_new_version(pTHX_ SV *ver) PERL_ARGS_ASSERT_NEW_VERSION; if ( ISA_VERSION_OBJ(ver) ) /* can just copy directly */ { - SSize_t key; - AV * const av = newAV(); - AV *sav; - /* This will get reblessed later if a derived class*/ - SV * const hv = newSVrv(rv, "version"); - (void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */ + SSize_t key; + AV * const av = newAV(); + AV *sav; + /* This will get reblessed later if a derived class*/ + SV * const hv = newSVrv(rv, "version"); + (void)sv_upgrade(hv, SVt_PVHV); /* needs to be an HV type */ #ifndef NODEFAULT_SHAREKEYS - HvSHAREKEYS_on(hv); /* key-sharing on by default */ + HvSHAREKEYS_on(hv); /* key-sharing on by default */ #endif - if ( SvROK(ver) ) - ver = SvRV(ver); - - /* Begin copying all of the elements */ - if ( hv_exists(MUTABLE_HV(ver), "qv", 2) ) - (void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(1)); - - if ( hv_exists(MUTABLE_HV(ver), "alpha", 5) ) - (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(1)); - { - 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)); - } - } - { - 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++ ) - { - SV * const sv = *av_fetch(sav, key, FALSE); - const I32 rev = SvIV(sv); - av_push(av, newSViv(rev)); - } - - (void)hv_stores(MUTABLE_HV(hv), "version", newRV_noinc(MUTABLE_SV(av))); - return rv; + if ( SvROK(ver) ) + ver = SvRV(ver); + + /* Begin copying all of the elements */ + if ( hv_exists(MUTABLE_HV(ver), "qv", 2) ) + (void)hv_stores(MUTABLE_HV(hv), "qv", newSViv(1)); + + if ( hv_exists(MUTABLE_HV(ver), "alpha", 5) ) + (void)hv_stores(MUTABLE_HV(hv), "alpha", newSViv(1)); + { + 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)); + } + } + { + 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++ ) + { + SV * const sv = *av_fetch(sav, key, FALSE); + const I32 rev = SvIV(sv); + av_push(av, newSViv(rev)); + } + + (void)hv_stores(MUTABLE_HV(hv), "version", newRV_noinc(MUTABLE_SV(av))); + return rv; } #ifdef SvVOK { - const MAGIC* const mg = SvVSTRING_mg(ver); - if ( mg ) { /* already a v-string */ - const STRLEN len = mg->mg_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_set(rv, SvCUR(rv) - 1); - *SvEND(rv) = '\0'; - } - /* this is for consistency with the pure Perl class */ - if ( isDIGIT(*version) ) - sv_insert(rv, 0, 0, "v", 1); - } - else { + const MAGIC* const mg = SvVSTRING_mg(ver); + if ( mg ) { /* already a v-string */ + const STRLEN len = mg->mg_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_set(rv, SvCUR(rv) - 1); + *SvEND(rv) = '\0'; + } + /* this is for consistency with the pure Perl class */ + if ( isDIGIT(*version) ) + sv_insert(rv, 0, 0, "v", 1); + } + else { #endif - SvSetSV_nosteal(rv, ver); /* make a duplicate */ + SvSetSV_nosteal(rv, ver); /* make a duplicate */ #ifdef SvVOK - } + } } #endif sv_2mortal(rv); /* in case upg_version croaks before it returns */ @@ -564,6 +586,30 @@ to force this SV to be interpreted as an "extended" version. =cut */ +/* Macro to do the meat of getting the PV of an NV version number. This is + * macroized because can be called from several places */ +#define GET_NUMERIC_VERSION(ver, sv, tbuf, buf, len) \ + STMT_START { \ + \ + /* Prevent callees from trying to change the locale */ \ + DISABLE_LC_NUMERIC_CHANGES(); \ + \ + /* We earlier created 'sv' for very large version numbers, to rely \ + * on the specialized algorithms SV code has built-in for such \ + * values */ \ + if (sv) { \ + Perl_sv_setpvf(aTHX_ sv, "%.9" NVff, SvNVX(ver)); \ + len = SvCUR(sv); \ + buf = SvPVX(sv); \ + } \ + else { \ + len = my_snprintf(tbuf, sizeof(tbuf), "%.9" NVff, SvNVX(ver)); \ + buf = tbuf; \ + } \ + \ + REENABLE_LC_NUMERIC_CHANGES(); \ + } STMT_END + SV * #ifdef VUTIL_REPLACE_CORE Perl_upg_version2(pTHX_ SV *ver, bool qv) @@ -582,239 +628,267 @@ Perl_upg_version(pTHX_ SV *ver, bool qv) PERL_ARGS_ASSERT_UPG_VERSION; 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); + || (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); + 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; + STRLEN len; - /* may get too much accuracy */ - char tbuf[64]; - SV *sv = SvNVX(ver) > 10e50 ? newSV(64) : 0; - char *buf; + /* may get too much accuracy */ + 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; - } + if (SvPOK(ver)) { + /* dualvar? */ + goto VER_PV; + } #endif -#ifdef USE_LOCALE_NUMERIC - { - /* 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]. */ + { + +#ifdef USE_POSIX_2008_LOCALE - /* In windows, or not threaded, or not thread-safe, if it isn't C, - * set it to C. */ + /* With POSIX 2008, all we have to do is toggle to the C locale + * just long enough to get the value (which should have a dot). */ + const locale_t locale_obj_on_entry = uselocale(PL_C_locale_obj); + GET_NUMERIC_VERSION(ver, sv, tbuf, buf, len); + uselocale(locale_obj_on_entry); +#else + /* Without POSIX 2008, it could be that toggling will zap another + * thread's locale. Avoid that if possible by looking at the NV and + * changing a non-dot radix into a dot */ -# ifndef USE_POSIX_2008_LOCALE + char * radix = NULL; + unsigned int radix_len = 0; - const char * locale_name_on_entry; + GET_NUMERIC_VERSION(ver, sv, tbuf, buf, len); - LC_NUMERIC_LOCK(0); /* Start critical section */ +# ifndef ARABIC_DECIMAL_SEPARATOR_UTF8 - locale_name_on_entry = setlocale(LC_NUMERIC, NULL); - if ( strNE(locale_name_on_entry, "C") - && strNE(locale_name_on_entry, "POSIX")) - { - /* the setlocale() call might free or overwrite the name */ - locale_name_on_entry = savepv(locale_name_on_entry); - setlocale(LC_NUMERIC, "C"); + /* This becomes feasible since there are only very few possible + * radix characters in the world. khw knows of just 3 possible + * ones. If we are being compiled on a perl without the very rare + * third one, ARABIC DECIMAL SEPARATOR, just scan for the other + * two: FULL STOP (dot) and COMMA */ + radix = strpbrk(buf, ".,"); + if (LIKELY(radix)) { + radix_len = 1; } - else { /* This value indicates to the restore code that we didn't - change the locale */ - locale_name_on_entry = NULL; +# else + /* Here, we have information about the third one; since it is + * multi-byte, it becomes a little more work. Scan for the dot, + * comma, or first byte of the arabic one */ + radix = strpbrk(buf, + ".," + ARABIC_DECIMAL_SEPARATOR_UTF8_FIRST_BYTE_s); + + if (LIKELY(radix)) { + if (LIKELY( (* (U8 *) radix) + != ARABIC_DECIMAL_SEPARATOR_UTF8_FIRST_BYTE)) + { + radix_len = 1; /* Dot and comma are length 1 */ + } + else { + + /* Make sure that the rest of the bytes are what we expect + * for the remainder of the arabic radix. If not, we + * didn't find the radix. */ + radix_len = STRLENs(ARABIC_DECIMAL_SEPARATOR_UTF8); + if ( radix + radix_len >= buf + len + || memNEs(radix + 1, + STRLENs(ARABIC_DECIMAL_SEPARATOR_UTF8_TAIL), + ARABIC_DECIMAL_SEPARATOR_UTF8_TAIL)) + { + radix = NULL; + radix_len = 0; + } + } } -# 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) { +# endif - /* in the global locale, we can call system setlocale and if it - * isn't C, set it to C. */ - LC_NUMERIC_LOCK(0); + /* Now convert any found radix into a dot (if not already). This + * effectively does: ver =~ s/radix/dot/ */ + if (radix) { + if (*radix != '.') { + *radix = '.'; + + if (radix_len > 1) { + Move(radix + radix_len, /* from what follows the radix + */ + radix + 1, /* to just after the new dot */ + + /* the number of bytes remaining, plus the NUL + * */ + len - (radix - buf) - radix_len + 1, + char); + len -= radix_len - 1; + } + } - locale_name_on_entry = setlocale(LC_NUMERIC, NULL); - if ( strNE(locale_name_on_entry, "C") - && strNE(locale_name_on_entry, "POSIX")) - { - /* the setlocale() call might free or overwrite the name */ - locale_name_on_entry = savepv(locale_name_on_entry); - setlocale(LC_NUMERIC, "C"); + /* Guard against the very unlikely case that the radix is more + * than a single character, like ".."; that is, make sure the + * radix string we found above is the whole radix, and not just + * the prefix of a longer one. Success is indicated by it + * being at the end of the string, or the next byte should be a + * digit */ + if (radix < buf + len && ! inRANGE(radix[1], '0', '9')) { + radix = NULL; + radix_len = 0; } - 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 + if (! radix) { - /* Prevent recursed calls from trying to change back */ - LOCK_LC_NUMERIC_STANDARD(); + /* If we couldn't find what the radix is, or didn't find it in + * the PV, resort to toggling the locale to one known to have a + * dot radix. 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]. + * */ -#endif - - if (sv) { - Perl_sv_setpvf(aTHX_ sv, "%.9" NVff, SvNVX(ver)); - len = SvCUR(sv); - buf = SvPVX(sv); - } - else { - len = my_snprintf(tbuf, sizeof(tbuf), "%.9" NVff, SvNVX(ver)); - buf = tbuf; - } +# if ! defined(LC_NUMERIC) || ! defined(USE_LOCALE_NUMERIC) -#ifdef USE_LOCALE_NUMERIC + Perl_croak(aTHX_ "panic: Unexpectedly didn't find a dot radix" + " character in '%s'", buf); +# else + const char * locale_name_on_entry = NULL; - UNLOCK_LC_NUMERIC_STANDARD(); + /* In windows, or not threaded, or not thread-safe, if it isn't + * C, set it to C. */ -# ifndef USE_POSIX_2008_LOCALE + POSIX_SETLOCALE_LOCK; /* Start critical section */ - if (locale_name_on_entry) { - setlocale(LC_NUMERIC, locale_name_on_entry); - Safefree(locale_name_on_entry); - } + locale_name_on_entry = setlocale(LC_NUMERIC, NULL); + if ( strEQ(locale_name_on_entry, "C") + || strEQ(locale_name_on_entry, "C.UTF-8") + || strEQ(locale_name_on_entry, "POSIX")) + { + /* No need to change the locale, since these all are known + * to have a dot radix. Change the variable to indicate to + * the restore code that nothing needs to be done */ + locale_name_on_entry = NULL; + } + else { + /* The setlocale() call might free or overwrite the name */ + locale_name_on_entry = savepv(locale_name_on_entry); + setlocale(LC_NUMERIC, "C"); + } - LC_NUMERIC_UNLOCK; /* End critical section */ + GET_NUMERIC_VERSION(ver, sv, tbuf, buf, len); -# else + if (locale_name_on_entry) { + setlocale(LC_NUMERIC, locale_name_on_entry); + Safefree(locale_name_on_entry); + } - if (locale_name_on_entry) { - setlocale(LC_NUMERIC, locale_name_on_entry); - Safefree(locale_name_on_entry); - LC_NUMERIC_UNLOCK; - } - else if (locale_obj_on_entry == PL_underlying_numeric_obj) { - RESTORE_LC_NUMERIC(); + POSIX_SETLOCALE_UNLOCK; /* End critical section */ +# endif } - else if (locale_obj_on_entry != PL_C_locale_obj) { - uselocale(locale_obj_on_entry); +#endif } -# endif - - } + /* Strip trailing zero's from the version number */ + while (buf[len-1] == '0' && len > 0) len--; -#endif /* USE_LOCALE_NUMERIC */ + if ( buf[len-1] == '.' ) len--; /* eat the trailing decimal */ - 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); + 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; + version = savepvn( (const char*)mg->mg_ptr,mg->mg_len ); + SAVEFREEPV(version); + qv = TRUE; } #endif else if ( SvPOK(ver))/* must be a string or something like a string */ VER_PV: { - STRLEN len; - version = savepvn(SvPV(ver,len), SvCUR(ver)); - SAVEFREEPV(version); + STRLEN len; + version = savepvn(SvPV(ver,len), SvCUR(ver)); + SAVEFREEPV(version); #ifndef SvVOK - /* This will only be executed for 5.6.0 - 5.8.0 inclusive */ - if ( len >= 3 && !instr(version,".") && !instr(version,"_")) { - /* may be a v-string */ - char *testv = (char *)version; - STRLEN tlen = len; - for (tlen=0; tlen < len; tlen++, testv++) { - /* if one of the characters is non-text assume v-string */ - if (testv[0] < ' ') { - SV * const nsv = sv_newmortal(); - const char *nver; - const char *pos; - int saw_decimal = 0; - sv_setpvf(nsv,"v%vd",ver); - pos = nver = savepv(SvPV_nolen(nsv)); + /* This will only be executed for 5.6.0 - 5.8.0 inclusive */ + if ( len >= 3 && !instr(version,".") && !instr(version,"_")) { + /* may be a v-string */ + char *testv = (char *)version; + STRLEN tlen = len; + for (tlen=0; tlen < len; tlen++, testv++) { + /* if one of the characters is non-text assume v-string */ + if (testv[0] < ' ') { + SV * const nsv = sv_newmortal(); + const char *nver; + const char *pos; + 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' */ - while ( *pos == '.' || isDIGIT(*pos) ) { - if ( *pos == '.' ) - saw_decimal++ ; - pos++; - } - - /* is definitely a v-string */ - if ( saw_decimal >= 2 ) { - version = nver; - } - break; - } - } - } + /* scan the resulting formatted string */ + pos++; /* skip the leading 'v' */ + while ( *pos == '.' || isDIGIT(*pos) ) { + if ( *pos == '.' ) + saw_decimal++ ; + pos++; + } + + /* is definitely a v-string */ + if ( saw_decimal >= 2 ) { + version = nver; + } + break; + } + } + } #endif } #if PERL_VERSION_LT(5,17,2) else if (SvIOKp(ver)) { - goto VER_IV; + goto VER_IV; } else if (SvNOKp(ver)) { - goto VER_NV; + goto VER_NV; } else if (SvPOKp(ver)) { - goto VER_PV; + goto VER_PV; } #endif else { - /* no idea what this is */ - Perl_croak(aTHX_ "Invalid version format (non-numeric data)"); + /* no idea what this is */ + Perl_croak(aTHX_ "Invalid version format (non-numeric data)"); } 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); + if ( *s != '\0' ) + Perl_ck_warner(aTHX_ packWARN(WARN_MISC), + "Version string '%s' contains invalid data; " + "ignoring: '%s'", version, s); #if PERL_VERSION_LT(5,19,8) && defined(USE_ITHREADS) LEAVE; @@ -862,16 +936,16 @@ Perl_vverify(pTHX_ SV *vs) PERL_ARGS_ASSERT_VVERIFY; if ( SvROK(vs) ) - vs = SvRV(vs); + vs = SvRV(vs); /* see if the appropriate elements exist */ if ( SvTYPE(vs) == SVt_PVHV - && (svp = hv_fetchs(MUTABLE_HV(vs), "version", FALSE)) - && (sv = SvRV(*svp)) - && SvTYPE(sv) == SVt_PVAV ) - return vs; + && (svp = hv_fetchs(MUTABLE_HV(vs), "version", FALSE)) + && (sv = SvRV(*svp)) + && SvTYPE(sv) == SVt_PVAV ) + return vs; else - return NULL; + return NULL; } /* @@ -908,42 +982,42 @@ Perl_vnumify(pTHX_ SV *vs) /* extract the HV from the object */ vs = VVERIFY(vs); if ( ! vs ) - Perl_croak(aTHX_ "Invalid version object"); + Perl_croak(aTHX_ "Invalid version object"); /* see if various flags exist */ if ( hv_exists(MUTABLE_HV(vs), "alpha", 5 ) ) - alpha = TRUE; + alpha = TRUE; if (alpha) { - Perl_ck_warner(aTHX_ packWARN(WARN_NUMERIC), - "alpha->numify() is lossy"); + 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"); + return newSVpvs("0"); } len = av_len(av); if ( len == -1 ) { - return newSVpvs("0"); + return newSVpvs("0"); } { - SV * tsv = *av_fetch(av, 0, 0); - digit = SvIV(tsv); + SV * tsv = *av_fetch(av, 0, 0); + digit = SvIV(tsv); } sv = Perl_newSVpvf(aTHX_ "%d.", (int)PERL_ABS(digit)); for ( i = 1 ; i <= len ; i++ ) { - SV * tsv = *av_fetch(av, i, 0); - digit = SvIV(tsv); - Perl_sv_catpvf(aTHX_ sv, "%03d", (int)digit); + SV * tsv = *av_fetch(av, i, 0); + digit = SvIV(tsv); + Perl_sv_catpvf(aTHX_ sv, "%03d", (int)digit); } if ( len == 0 ) { - sv_catpvs(sv, "000"); + sv_catpvs(sv, "000"); } return sv; } @@ -980,29 +1054,29 @@ Perl_vnormal(pTHX_ SV *vs) /* extract the HV from the object */ vs = VVERIFY(vs); if ( ! vs ) - Perl_croak(aTHX_ "Invalid version object"); + Perl_croak(aTHX_ "Invalid version object"); av = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(vs), "version", FALSE))); len = av_len(av); if ( len == -1 ) { - return newSVpvs(""); + return newSVpvs(""); } { - SV * tsv = *av_fetch(av, 0, 0); - digit = SvIV(tsv); + 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); + 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 */ - for ( len = 2 - len; len != 0; len-- ) - sv_catpvs(sv,".0"); + for ( len = 2 - len; len != 0; len-- ) + sv_catpvs(sv,".0"); } return sv; } @@ -1033,33 +1107,33 @@ Perl_vstringify(pTHX_ SV *vs) /* extract the HV from the object */ vs = VVERIFY(vs); if ( ! vs ) - Perl_croak(aTHX_ "Invalid version object"); + Perl_croak(aTHX_ "Invalid version object"); svp = hv_fetchs(MUTABLE_HV(vs), "original", FALSE); if (svp) { - SV *pv; - pv = *svp; - if ( SvPOK(pv) + SV *pv; + pv = *svp; + if ( SvPOK(pv) #if PERL_VERSION_LT(5,17,2) - || SvPOKp(pv) + || SvPOKp(pv) #endif - ) - return newSVsv(pv); - else - return &PL_sv_undef; + ) + return newSVsv(pv); + else + return &PL_sv_undef; } else { - if ( hv_exists(MUTABLE_HV(vs), "qv", 2) ) - return VNORMAL(vs); - else - return VNUMIFY(vs); + if ( hv_exists(MUTABLE_HV(vs), "qv", 2) ) + return VNORMAL(vs); + else + return VNUMIFY(vs); } } /* =for apidoc vcmp -Version object aware cmp. Both operands must already have been +Version object aware cmp. Both operands must already have been converted into version objects. =cut @@ -1084,7 +1158,7 @@ Perl_vcmp(pTHX_ SV *lhv, SV *rhv) lhv = VVERIFY(lhv); rhv = VVERIFY(rhv); if ( ! ( lhv && rhv ) ) - Perl_croak(aTHX_ "Invalid version object"); + Perl_croak(aTHX_ "Invalid version object"); /* get the left hand term */ lav = MUTABLE_AV(SvRV(*hv_fetchs(MUTABLE_HV(lhv), "version", FALSE))); @@ -1099,40 +1173,40 @@ Perl_vcmp(pTHX_ SV *lhv, SV *rhv) i = 0; while ( i <= m && retval == 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 ) - retval = +1; - i++; + 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 ) + retval = +1; + i++; } if ( l != r && retval == 0 ) /* possible match except for trailing 0's */ { - if ( l < r ) - { - while ( i <= r && retval == 0 ) - { - SV * const rsv = *av_fetch(rav,i,0); - if ( SvIV(rsv) != 0 ) - retval = -1; /* not a match after all */ - i++; - } - } - else - { - while ( i <= l && retval == 0 ) - { - SV * const lsv = *av_fetch(lav,i,0); - if ( SvIV(lsv) != 0 ) - retval = +1; /* not a match after all */ - i++; - } - } + if ( l < r ) + { + while ( i <= r && retval == 0 ) + { + SV * const rsv = *av_fetch(rav,i,0); + if ( SvIV(rsv) != 0 ) + retval = -1; /* not a match after all */ + i++; + } + } + else + { + while ( i <= l && retval == 0 ) + { + SV * const lsv = *av_fetch(lav,i,0); + if ( SvIV(lsv) != 0 ) + retval = +1; /* not a match after all */ + i++; + } + } } return retval; }