This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Grab latest changes from CPAN 0.9905
authorJohn Peacock <jpeacock@cpan.org>
Wed, 25 Dec 2013 19:19:19 +0000 (14:19 -0500)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 4 Jan 2014 13:10:04 +0000 (05:10 -0800)
cpan/version/t/07locale.t
cpan/version/t/09_list_util.t [new file with mode: 0644]
vutil.c
vxs.inc

index 15247d0..a3c75c0 100644 (file)
@@ -22,8 +22,6 @@ SKIP: {
        # test locale handling
        my $warning;
 
        # test locale handling
        my $warning;
 
-       use locale;
-
        local $SIG{__WARN__} = sub { $warning = $_[0] };
 
        my $ver = 1.23;  # has to be floating point number
        local $SIG{__WARN__} = sub { $warning = $_[0] };
 
        my $ver = 1.23;  # has to be floating point number
@@ -33,10 +31,12 @@ SKIP: {
                                                      # because have to
                                                      # evaluate in current
                                                      # scope
                                                      # because have to
                                                      # evaluate in current
                                                      # scope
+       use locale;
+
        while (<DATA>) {
            chomp;
            $loc = setlocale( LC_ALL, $_);
        while (<DATA>) {
            chomp;
            $loc = setlocale( LC_ALL, $_);
-           last if localeconv()->{decimal_point} eq ',';
+           last if $loc && localeconv()->{decimal_point} eq ',';
        }
        skip 'Cannot test locale handling without a comma locale', 5
            unless $loc and localeconv()->{decimal_point} eq ',';
        }
        skip 'Cannot test locale handling without a comma locale', 5
            unless $loc and localeconv()->{decimal_point} eq ',';
diff --git a/cpan/version/t/09_list_util.t b/cpan/version/t/09_list_util.t
new file mode 100644 (file)
index 0000000..f7fb89f
--- /dev/null
@@ -0,0 +1,37 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+#########################
+
+use strict;
+use Test::More tests => 3;
+use_ok("version", 0.9905);
+
+# do strict lax tests in a sub to isolate a package to test importing
+SKIP: {
+    eval "use List::Util qw(reduce);";
+    skip 'No reduce() in List::Util', 2
+       if $@;
+
+    # use again to get the import()
+    use List::Util qw(reduce);
+    {
+       my $fail = 0;
+       my $ret = reduce {
+           version->parse($a);
+           $fail++ unless defined $a;
+           1
+       } "0.039", "0.035";
+       is $fail, 0, 'reduce() with parse';
+    }
+
+    {
+       my $fail = 0;
+       my $ret = reduce {
+           version->qv($a);
+           $fail++ unless defined $a;
+           1
+       } "0.039", "0.035";
+       is $fail, 0, 'reduce() with qv';
+    }
+}
diff --git a/vutil.c b/vutil.c
index 303e76c..8eafd75 100644 (file)
--- a/vutil.c
+++ b/vutil.c
@@ -521,7 +521,7 @@ Perl_new_version(pTHX_ SV *ver)
        }
        else {
 #endif
        }
        else {
 #endif
-       sv_setsv(rv,ver); /* make a duplicate */
+       SvSetSV_nosteal(rv, ver); /* make a duplicate */
 #ifdef SvVOK
        }
     }
 #ifdef SvVOK
        }
     }
@@ -598,6 +598,7 @@ Perl_upg_version(pTHX_ SV *ver, bool qv)
 #endif
     else if ( (SvUOK(ver) && SvUVX(ver) > VERSION_MAX)
           || (SvIOK(ver) && SvIVX(ver) > VERSION_MAX) ) {
 #endif
     else 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);
        STRLEN len;
        char tbuf[64];
        len = my_snprintf(tbuf, sizeof(tbuf), "%d", VERSION_MAX);
@@ -605,6 +606,9 @@ Perl_upg_version(pTHX_ SV *ver, bool qv)
        Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                       "Integer overflow in version %d",VERSION_MAX);
     }
        Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                       "Integer overflow in version %d",VERSION_MAX);
     }
+    else if ( SvUOK(ver) || SvIOK(ver) ) {
+       version = savesvpv(ver);
+    }
     else /* must be a string or something like a string */
     {
        STRLEN len;
     else /* must be a string or something like a string */
     {
        STRLEN len;
diff --git a/vxs.inc b/vxs.inc
index 78b1fef..cb894f2 100644 (file)
--- a/vxs.inc
+++ b/vxs.inc
@@ -418,7 +418,7 @@ VXS(version_qv)
        }
        if ( !SvVOK(ver) ) { /* not already a v-string */
            rv = sv_newmortal();
        }
        if ( !SvVOK(ver) ) { /* not already a v-string */
            rv = sv_newmortal();
-           sv_setsv(rv,ver); /* make a duplicate */
+           SvSetSV_nosteal(rv,ver); /* make a duplicate */
            UPG_VERSION(rv, TRUE);
        } else {
            rv = sv_2mortal(NEW_VERSION(ver));
            UPG_VERSION(rv, TRUE);
        } else {
            rv = sv_2mortal(NEW_VERSION(ver));