version-0.9923_02

rurban · rurban · commit 1a9b8e451ae0 · 2018-09-13T12:57:34.000+02:00
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
@@ -1535,7 +1535,7 @@ package Maintainers;
     },
 
     'version' => {
-        'DISTRIBUTION' => 'JPEACOCK/version-0.9918.tar.gz',
+        'DISTRIBUTION' => 'JPEACOCK/version-0.9923.tar.gz',
         '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
@@ -4,11 +4,10 @@ package version;
 use 5.006002;
 use strict;
 
-use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
-
-$VERSION = '0.9918_02c';
-$VERSION =~ s/c$//;
-$CLASS = 'version';
+our $VERSION = '0.9923_02';
+#$VERSION =~ s/c$//;
+our $CLASS = 'version';
+our (@ISA, $STRICT, $LAX);
 
 # avoid using Exporter
 require version::regex;
diff --git a/cpan/version/lib/version.pod b/cpan/version/lib/version.pod
@@ -269,11 +269,10 @@ leading-v and at least 3 components.
 
 =head2 numify()
 
-Returns a value representing the object in a pure decimal form without
-trailing zeroes.
+Returns a value representing the object in a pure decimal.
 
- version->declare('v1.2')->numify;  # 1.002
- version->parse('1.2')->numify;     # 1.2
+ version->declare('v1.2')->numify;  # 1.002000
+ version->parse('1.2')->numify;     # 1.200
 
 =head2 stringify()
 
@@ -283,7 +282,7 @@ way perl would normally represent it in a string.  This method is used whenever
 a version object is interpolated into a string.
 
  version->declare('v1.2')->stringify;    # v1.2
- version->parse('1.200')->stringify;     # 1.200
+ version->parse('1.200')->stringify;     # 1.2
  version->parse(1.02_30)->stringify;     # 1.023
 
 =head1 EXPORTED FUNCTIONS
diff --git a/cpan/version/lib/version/regex.pm b/cpan/version/lib/version/regex.pm
@@ -2,14 +2,8 @@ package version::regex;
 
 use strict;
 
-use vars qw(
-    $VERSION $CLASS $STRICT $LAX
-    $STRICT_DECIMAL_VERSION $STRICT_DOTTED_DECIMAL_VERSION
-    $LAX_DECIMAL_VERSION $LAX_DOTTED_DECIMAL_VERSION
-);
-
-$VERSION = '0.9918_02c';
-$VERSION =~ s/c$//;
+our $VERSION = '0.9923_02';
+#$VERSION =~ s/c$//;
 
 #--------------------------------------------------------------------------#
 # Version regexp components
@@ -63,19 +57,19 @@ my $LAX_ALPHA_PART = qr/(?:_[0-9]+c?|c?)/;
 
 # Strict decimal version number.
 
-$STRICT_DECIMAL_VERSION =
+our $STRICT_DECIMAL_VERSION =
     qr/ $STRICT_INTEGER_PART $FRACTION_PART? c? /x;
 
 # Strict dotted-decimal version number.  Must have both leading "v" and
 # at least three parts, to avoid confusion with decimal syntax.
 
-$STRICT_DOTTED_DECIMAL_VERSION =
+our $STRICT_DOTTED_DECIMAL_VERSION =
     qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} c? /x;
 
 # Complete strict version number syntax -- should generally be used
 # anchored: qr/ \A $STRICT \z /x
 
-$STRICT =
+our $STRICT =
     qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x;
 
 #--------------------------------------------------------------------------#
@@ -86,7 +80,7 @@ $STRICT =
 # allowing an alpha suffix or allowing a leading or trailing
 # decimal-point
 
-$LAX_DECIMAL_VERSION =
+our $LAX_DECIMAL_VERSION =
     qr/ $LAX_INTEGER_PART (?: $FRACTION_PART | \. )? $LAX_ALPHA_PART?
 	|
 	$FRACTION_PART $LAX_ALPHA_PART?
@@ -98,7 +92,7 @@ $LAX_DECIMAL_VERSION =
 # enough, without the leading "v", Perl takes .1.2 to mean v0.1.2,
 # so when there is no "v", the leading part is optional
 
-$LAX_DOTTED_DECIMAL_VERSION =
+our $LAX_DOTTED_DECIMAL_VERSION =
     qr/
 	v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )?
 	|
@@ -111,7 +105,7 @@ $LAX_DOTTED_DECIMAL_VERSION =
 # The string 'undef' is a special case to make for easier handling
 # of return values from ExtUtils::MM->parse_version
 
-$LAX =
+our $LAX =
     qr/ undef | $LAX_DOTTED_DECIMAL_VERSION | $LAX_DECIMAL_VERSION /x;
 
 #--------------------------------------------------------------------------#
diff --git a/cpan/version/t/01base.t b/cpan/version/t/01base.t
@@ -14,7 +14,7 @@ BEGIN {
         )
     );
     require $coretests;
-    use_ok('version', 0.9918);
+    use_ok('version', 0.9923);
 }
 
 BaseTests("version","new","qv");
diff --git a/cpan/version/t/02derived.t b/cpan/version/t/02derived.t
@@ -15,7 +15,7 @@ BEGIN {
         )
     );
     require $coretests;
-    use_ok("version", 0.9918);
+    use_ok("version", 0.9923);
     # If we made it this far, we are ok.
 }
 
@@ -51,8 +51,7 @@ print $fh <<"EOF";
 # This is an empty subclass
 package $package;
 use parent 'version';
-use vars '\$VERSION';
-\$VERSION=0.001;
+our \$VERSION = 0.001;
 EOF
 close $fh;
 
diff --git 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.9918_02', "Make sure we have the correct class";
+is $version::VERSION, '0.9923_02', "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
@@ -14,7 +14,7 @@ BEGIN {
 }
 
 BEGIN {
-    use version 0.9918;
+    use version 0.9923;
 }
 
 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
@@ -7,7 +7,7 @@
 use Test::More qw/no_plan/;
 
 BEGIN {
-    use_ok('version', 0.9918);
+    use_ok('version', 0.9923);
 }
 
 my $v1 = version->new('1.2');
diff --git a/cpan/version/t/07locale.t b/cpan/version/t/07locale.t
@@ -11,7 +11,7 @@ use Test::More tests => 8;
 use Config;
 
 BEGIN {
-    use_ok('version', 0.9918);
+    use_ok('version', 0.9923);
 }
 
 SKIP: {
diff --git 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.9918);
+use_ok("version", 0.9923);
 
 # 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
@@ -4,7 +4,7 @@
 #########################
 
 use strict;
-use_ok("version", 0.9918);
+use_ok("version", 0.9923);
 use Test::More;
 
 BEGIN {
diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm
@@ -17623,6 +17623,8 @@ our %delta = (
             'Time::HiRes'           => '1.9758_01',
             'Time::Local'           => '1.28',
             'Time::Piece'           => '1.33',
+            'version'               => '0.9923_02',
+            'version::regex'        => '0.9923_02',
             'XSLoader'              => '1.04c',
         },
         removed => {
diff --git a/pod/perlcdelta.pod b/pod/perlcdelta.pod
@@ -544,6 +544,16 @@ Remove some compile warnings
 
 SP off by 1 in C<_crt_localtime>
 
+=item L<version> 0.9923_02
+
+Add updates from 0.9918: Add LAX_DECIMAL_VERSION, LAX_DOTTED_DECIMAL_VERSION,
+STRICT_DECIMAL_VERSION, STRICT_DOTTED_DECIMAL_VERSION regexes.
+Add updates from 0.9921: pod, safer C locale switching.
+add vpp support for cperl: scmp, c suffix.
+use vars => our.
+
+Add F<t/11_taint.t>
+
 =item L<XSLoader> 1.04c
 
 Fix wrong usage of C<SvREFCNT_inc_simple_NN> with a function, fixes a memory leak.
diff --git a/t/porting/customized.dat b/t/porting/customized.dat
@@ -119,8 +119,8 @@ threads dist/threads/lib/threads.pm 532c5f595f81666fa7ff534a919cbf679dae9b8a
 threads dist/threads/t/locale.t 9a2a5b43a39867590eb288d4a1759abac2052aa8
 threads dist/threads/threads.xs 030620f4374ad62176e3c5d4d24b2dbd90a12b69
 threads::shared dist/threads-shared/t/waithires.t dc867159fd2fa8c09326cd7627f5a0635ca5e3b5
-version cpan/version/lib/version.pm 2a13001de38b343b29720bd432612472dfd3f265
-version cpan/version/lib/version/regex.pm 78326aeeff8b3603558da9f9b86822a04c0b7be2
-version vutil.c e97a2b726c8ea7bb668175e493955657e12c5885
-version vutil.h 7f3bac361fc044df5448bde5a6cfc51d015677ad
-version vxs.inc 4d5b01db64de0e6f54db11baa30aac9ecc0b2788
+version cpan/version/lib/version.pm 1b451b1390960dd06445daf6796e503951fe2ab7
+version cpan/version/lib/version/regex.pm 43601bfc51311eff1b8e347ce62fab2bf2dd8809
+version vutil.c ea25ed9a0947909ea4d10a9a5f866f62c2299112
+version vutil.h f1d54142bdc95f32a83dcfdc5a78f8d1b448e110
+version vxs.inc 3ac4b29b5093605e3bbf59c20814ef4a601484e4
diff --git a/vutil.c b/vutil.c
@@ -651,54 +651,121 @@ Perl_upg_version(pTHX_ SV *ver, bool qv)
 	    goto VER_PV;
 	}
 #endif
-
 #ifdef USE_LOCALE_NUMERIC
+
 	{
-	    const char * const cur_numeric = setlocale(LC_NUMERIC, NULL);
-	    assert(cur_numeric);
-
-	    /* XS code can set the locale without us knowing.  To protect the
-	     * version number parsing, which requires the radix character to be a
-	     * dot, update our records as to what the locale is, so that our
-	     * existing macro mechanism can correctly change it to a dot and back
-	     * if necessary.  This code is extremely unlikely to be in a loop, so
-	     * the extra work will have a negligible performance impact.  See [perl
-	     * #121930].
-	     *
-	     * If the current locale is a standard one, but we are expecting it to
-	     * be a different, underlying locale, update our records to make the
-	     * underlying locale this (standard) one.  If the current locale is not
-	     * a standard one, we should be expecting a non-standard one, the same
-	     * one that we have recorded as the underlying locale.  If not, update
-	     * our records. */
-	    if (strEQc(cur_numeric, "C") || strEQc(cur_numeric, "POSIX")) {
-		if (! PL_numeric_standard) {
-		    new_numeric(cur_numeric);
-		}
-	    }
-	    else if (PL_numeric_standard
-		     || ! PL_numeric_name
-		     || strNE(PL_numeric_name, cur_numeric))
-	    {
-		new_numeric(cur_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]. */
+
+            /* In windows, or not threaded, or not thread-safe, if it isn't C,
+             * set it to C. */
+
+#  ifndef USE_POSIX_2008_LOCALE
+
+            const char * locale_name_on_entry;
+
+            LC_NUMERIC_LOCK(0);    /* Start critical section */
+
+            locale_name_on_entry = setlocale(LC_NUMERIC, NULL);
+            if (   strNEc(locale_name_on_entry, "C")
+                && strNEc(locale_name_on_entry, "POSIX"))
+            {
+                setlocale(LC_NUMERIC, "C");
+            }
+            else {  /* This value indicates to the restore code that we didn't
+                       change the locale */
+                locale_name_on_entry = NULL;
+            }
+
+# 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) {
+
+                /* in the global locale, we can call system setlocale and if it
+                 * isn't C, set it to C. */
+                LC_NUMERIC_LOCK(0);
+
+                locale_name_on_entry = setlocale(LC_NUMERIC, NULL);
+                if (   strNE(locale_name_on_entry, "C")
+                    && strNE(locale_name_on_entry, "POSIX"))
+                {
+                    setlocale(LC_NUMERIC, "C");
+                }
+                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
+
+            /* Prevent recursed calls from trying to change back */
+            LOCK_LC_NUMERIC_STANDARD();
+
 #endif
-        { /* Braces needed because macro just below declares a variable */
-        STORE_NUMERIC_LOCAL_SET_STANDARD();
-        LOCK_NUMERIC_STANDARD();
+
 	if (sv) {
-	    Perl_sv_catpvf(aTHX_ sv, "%.9" NVff, SvNVX(ver));
+                Perl_sv_catpvf(aTHX_ sv, "%.9" NVff, SvNVX(ver));
 	    len = SvCUR(sv);
 	    buf = SvPVX(sv);
 	}
 	else {
-	    len = my_snprintf(tbuf, sizeof(tbuf), "%.9" NVff, SvNVX(ver));
+                len = my_snprintf(tbuf, sizeof(tbuf), "%.9" NVff, SvNVX(ver));
 	    buf = tbuf;
 	}
-        UNLOCK_NUMERIC_STANDARD();
-        RESTORE_NUMERIC_LOCAL();
+
+#ifdef USE_LOCALE_NUMERIC
+
+            UNLOCK_LC_NUMERIC_STANDARD();
+
+#  ifndef USE_POSIX_2008_LOCALE
+
+            if (locale_name_on_entry) {
+                setlocale(LC_NUMERIC, locale_name_on_entry);
+            }
+
+            LC_NUMERIC_UNLOCK;  /* End critical section */
+
+#  else
+
+            if (locale_name_on_entry) {
+                setlocale(LC_NUMERIC, locale_name_on_entry);
+                LC_NUMERIC_UNLOCK;
+            }
+            else if (locale_obj_on_entry == PL_underlying_numeric_obj) {
+                RESTORE_LC_NUMERIC();
+            }
+            else if (locale_obj_on_entry != PL_C_locale_obj) {
+                uselocale(locale_obj_on_entry);
+        }
+
+#  endif
+
         }
+
+#endif  /* USE_LOCALE_NUMERIC */
+
 	while (buf[len-1] == '0' && len > 0) len--;
 	if ( buf[len-1] == '.' ) len--; /* eat the trailing decimal */
 	version = savepvn(buf, len);
diff --git a/vutil.h b/vutil.h
diff --git a/vxs.inc b/vxs.inc

Original file line number	Diff line number	Diff line change
`@@ -14,7 +14,7 @@ BEGIN {`
`14`	`14`	`)`
`15`	`15`	`);`
`16`	`16`	`require $coretests;`
`17`		`- use_ok('version', 0.9918);`
	`17`	`+ use_ok('version', 0.9923);`
`18`	`18`	`}`
`19`	`19`
`20`	`20`	`BaseTests("version","new","qv");`
Original file line number	Diff line number	Diff line change
`@@ -7,7 +7,7 @@`
`7`	`7`	`use Test::More qw/no_plan/;`
`8`	`8`
`9`	`9`	`BEGIN {`
`10`		`- use_ok('version', 0.9918);`
	`10`	`+ use_ok('version', 0.9923);`
`11`	`11`	`}`
`12`	`12`
`13`	`13`	`my $v1 = version->new('1.2');`
Original file line number	Diff line number	Diff line change
`@@ -11,7 +11,7 @@ use Test::More tests => 8;`
`11`	`11`	`use Config;`
`12`	`12`
`13`	`13`	`BEGIN {`
`14`		`- use_ok('version', 0.9918);`
	`14`	`+ use_ok('version', 0.9923);`
`15`	`15`	`}`
`16`	`16`
`17`	`17`	`SKIP: {`