diff options
| -rw-r--r-- | cpan/version/t/07locale.t | 6 | ||||
| -rw-r--r-- | cpan/version/t/09_list_util.t | 37 | ||||
| -rw-r--r-- | vutil.c | 6 | ||||
| -rw-r--r-- | vxs.inc | 2 |
4 files changed, 46 insertions, 5 deletions
diff --git a/cpan/version/t/07locale.t b/cpan/version/t/07locale.t index 15247d0262..a3c75c0bf5 100644 --- a/cpan/version/t/07locale.t +++ b/cpan/version/t/07locale.t @@ -22,8 +22,6 @@ SKIP: { # test locale handling my $warning; - use locale; - 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 + use locale; + 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 ','; diff --git a/cpan/version/t/09_list_util.t b/cpan/version/t/09_list_util.t new file mode 100644 index 0000000000..f7fb89f021 --- /dev/null +++ b/cpan/version/t/09_list_util.t @@ -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'; + } +} @@ -521,7 +521,7 @@ Perl_new_version(pTHX_ SV *ver) } else { #endif - sv_setsv(rv,ver); /* make a duplicate */ + SvSetSV_nosteal(rv, ver); /* make a duplicate */ #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) ) { + /* out of bounds [unsigned] integer */ 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); } + else if ( SvUOK(ver) || SvIOK(ver) ) { + version = savesvpv(ver); + } else /* must be a string or something like a string */ { STRLEN len; @@ -418,7 +418,7 @@ VXS(version_qv) } 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)); |