David Golden wrote: > I've released 0.33_01 so we can test the hell out of it with the goal > if getting it into Perl 5.10.1. I'll prepare a patch for blead and > will start regression testing it versus 0.33.
Since it looks like you are going to have to do a quick 0.33_02 to fix the problems with the core tests, I'm attaching a patch to bring M::B up to speed with the soon to be released version.pm 0.77 changes. There are a number of API changes that are included (parse/declare in the place of new/qv) and more importantly, a bug fix relating to eval and locales: http://rt.perl.org/rt3/Ticket/Display.html?id=66244 http://rt.cpan.org/Ticket/Display.html?id=46921 that changes the parser. I haven't actually been able to trigger the error in a test case (only with XS), but I made parallel changes to the pure Perl modules just to be on the safe side. I also patched Module::Build::Base and the associated t/metadata.t test to match the expected behavior /vis-a-vis/ normalized dotted-decimal version tuples. Thanks John
=== lib/Module/Build/Base.pm ================================================================== --- lib/Module/Build/Base.pm (revision 2576) +++ lib/Module/Build/Base.pm (local) @@ -3620,9 +3620,7 @@ } elsif ( ref $version eq 'version' || ref $version eq 'Module::Build::Version' ) { # version objects - my $string = $version->stringify; - # normalize leading-v: "v1.2" -> "v1.2.0" - $version = substr($string,0,1) eq 'v' ? $version->normal : $string; + $version = $version->is_qv ? $version->normal : $version->stringify; } elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots # normalize string tuples without "v": "1.2.3" -> "v1.2.3" === lib/Module/Build/Version.pm ================================================================== --- lib/Module/Build/Version.pm (revision 2576) +++ lib/Module/Build/Version.pm (local) @@ -2,7 +2,7 @@ use strict; use vars qw($VERSION); -$VERSION = 0.74; +$VERSION = 0.77; eval "use version $VERSION"; if ($@) { # can't locate version files, use our own @@ -46,35 +46,81 @@ use 5.005_04; use strict; -use vars qw(@ISA $VERSION $CLASS *qv); +use vars qw(@ISA $VERSION $CLASS *declare *qv); -$VERSION = 0.000; +$VERSION = 0; $CLASS = 'version'; push @ISA, "version::vpp"; +local $^W; *version::qv = \&version::vpp::qv; +*version::declare = \&version::vpp::declare; +*version::_VERSION = \&version::vpp::_VERSION; +if ($] > 5.009001 && $] <= 5.010000) { + no strict 'refs'; + *{'version::stringify'} = \*version::vpp::stringify; + *{'version::(""'} = \*version::vpp::stringify; +} # Preloaded methods go here. sub import { - my ($class) = @_; + no strict 'refs'; + my ($class) = shift; + + # Set up any derived class + unless ($class eq 'version') { + local $^W; + *{$class.'::declare'} = \&version::declare; + *{$class.'::qv'} = \&version::qv; + } + + my %args; + if (@_) { # any remaining terms are arguments + map { $args{$_} = 1 } @_ + } + else { # no parameters at all on use line + %args = + ( + qv => 1, + 'UNIVERSAL::VERSION' => 1, + ); + } + my $callpkg = caller(); - no strict 'refs'; - *{$callpkg."::qv"} = - sub {return bless version::qv(shift), $class } - unless defined(&{"$callpkg\::qv"}); + if (exists($args{declare})) { + *{$callpkg."::declare"} = + sub {return $class->declare(shift) } + unless defined(&{$callpkg.'::declare'}); + } + if (exists($args{qv})) { + *{$callpkg."::qv"} = + sub {return $class->qv(shift) } + unless defined(&{"$callpkg\::qv"}); + } + + if (exists($args{'UNIVERSAL::VERSION'})) { + local $^W; + *UNIVERSAL::VERSION = \&version::_VERSION; + } + + if (exists($args{'VERSION'})) { + *{$callpkg."::VERSION"} = \&version::_VERSION; + } } 1; + # replace everything from here to the end with the current version/vpp.pm package version::vpp; use strict; +use POSIX qw/locale_h/; use locale; use vars qw ($VERSION @ISA @REGEXS); -$VERSION = 0.76; +$VERSION = '0.77'; push @REGEXS, qr/ ^v? # optional leading 'v' @@ -108,7 +154,7 @@ my ($class, $value) = @_; my $self = bless ({}, ref ($class) || $class); - if ( ref($value) && eval("$value->isa('version')") ) { + if ( ref($value) && eval('$value->isa("version")') ) { # Can copy the elements directly $self->{version} = [ @{$value->{version} } ]; $self->{qv} = 1 if $value->{qv}; @@ -117,10 +163,15 @@ return $self; } - require POSIX; - my $currlocale = POSIX::setlocale(&POSIX::LC_ALL); - my $radix_comma = ( POSIX::localeconv()->{decimal_point} eq ',' ); + my $currlocale = setlocale(LC_ALL); + # if the current locale uses commas for decimal points, we + # just replace commas with decimal places, rather than changing + # locales + if ( localeconv()->{decimal_point} eq ',' ) { + $value =~ tr/,/./; + } + if ( not defined $value or $value =~ /^undef$/ ) { # RT #19517 - special case for undef comparison # or someone forgot to pass a value @@ -136,18 +187,11 @@ $value = _un_vstring($value); # exponential notation - if ( $value =~ /\d+.?\d*e-?\d+/ ) { + if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) { $value = sprintf("%.9f",$value); - $value =~ s/(0+)$//; + $value =~ s/(0+)$//; # trim trailing zeros } - # if the original locale used commas for decimal points, we - # just replace commas with decimal places, rather than changing - # locales - if ( $radix_comma ) { - $value =~ tr/,/./; - } - # This is not very efficient, but it is morally equivalent # to the XS code (as that is the reference implementation). # See vutil/vutil.c for details @@ -171,7 +215,7 @@ $start = $last = $pos = $s; # pre-scan the input string to check for decimals/underbars - while ( substr($value,$pos,1) =~ /[._\d]/ ) { + while ( substr($value,$pos,1) =~ /[._\d,]/ ) { if ( substr($value,$pos,1) eq '.' ) { if ($alpha) { Carp::croak("Invalid version format ". @@ -189,6 +233,12 @@ $alpha = 1; $width = $pos - $last - 1; # natural width of sub-version } + elsif ( substr($value,$pos,1) eq ',' + and substr($value,$pos+1,1) =~ /[0-9]/ ) { + # looks like an unhandled locale + $saw_period++; + $last = $pos; + } $pos++; } @@ -291,6 +341,10 @@ && substr($value,$pos+1,1) =~ /\d/ ) { $s = ++$pos; } + elsif ( substr($value,$pos,1) eq ',' + && substr($value,$pos+1,1) =~ /\d/ ) { + $s = ++$pos; + } elsif ( substr($value,$pos,1) =~ /\d/ ) { $s = $pos; } @@ -342,6 +396,8 @@ return ($self); } +*parse = \&new; + sub numify { my ($self) = @_; @@ -518,14 +574,21 @@ } sub qv { - my ($value) = @_; + my $value = shift; + my $class = 'version'; + if (@_) { + $class = ref($value) || $value; + $value = shift; + } $value = _un_vstring($value); $value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/; - my $version = version->new($value); # always use base class + my $version = $class->new($value); return $version; } +*declare = \&qv; + sub is_qv { my ($self) = @_; return (exists $self->{qv}); @@ -558,69 +621,64 @@ return $value; } -# Thanks to Yitzchak Scott-Thoennes for this mode of operation -{ - local $^W; - *UNIVERSAL::VERSION # Module::Build::ModuleInfo doesn't see this now - = sub { - my ($obj, $req) = @_; - my $class = ref($obj) || $obj; +sub _VERSION { + my ($obj, $req) = @_; + my $class = ref($obj) || $obj; - no strict 'refs'; - eval "require $class" unless %{"$class\::"}; # already existing - return undef if $@ =~ /Can't locate/ and not defined $req; - - if ( not %{"$class\::"} and $] >= 5.008) { # file but no package + no strict 'refs'; + eval "require $class" unless %{"$class\::"}; # already existing + return undef if $@ =~ /Can't locate/ and not defined $req; + + if ( not %{"$class\::"} and $] >= 5.008) { # file but no package + require Carp; + Carp::croak( "$class defines neither package nor VERSION" + ."--version check failed"); + } + + my $version = eval "\$$class\::VERSION"; + if ( defined $version ) { + local $^W if $] <= 5.008; + $version = version::vpp->new($version); + } + + if ( defined $req ) { + unless ( defined $version ) { require Carp; - Carp::croak( "$class defines neither package nor VERSION" - ."--version check failed"); - } - - my $version = eval "\$$class\::VERSION"; - if ( defined $version ) { - local $^W if $] <= 5.008; - $version = version::vpp->new($version); - } + my $msg = $] < 5.006 + ? "$class version $req required--this is only version " + : "$class does not define \$$class\::VERSION" + ."--version check failed"; - if ( defined $req ) { - unless ( defined $version ) { - require Carp; - my $msg = $] < 5.006 - ? "$class version $req required--this is only version " - : "$class does not define \$$class\::VERSION" - ."--version check failed"; - - if ( $ENV{VERSION_DEBUG} ) { - Carp::confess($msg); - } - else { - Carp::croak($msg); - } + if ( $ENV{VERSION_DEBUG} ) { + Carp::confess($msg); } + else { + Carp::croak($msg); + } + } - $req = version::vpp->new($req); + $req = version::vpp->new($req); - if ( $req > $version ) { - require Carp; - if ( $req->is_qv ) { - Carp::croak( - sprintf ("%s version %s required--". - "this is only version %s", $class, - $req->normal, $version->normal) - ); - } - else { - Carp::croak( - sprintf ("%s version %s required--". - "this is only version %s", $class, - $req->stringify, $version->stringify) - ); - } + if ( $req > $version ) { + require Carp; + if ( $req->is_qv ) { + Carp::croak( + sprintf ("%s version %s required--". + "this is only version %s", $class, + $req->normal, $version->normal) + ); } + else { + Carp::croak( + sprintf ("%s version %s required--". + "this is only version %s", $class, + $req->stringify, $version->stringify) + ); + } } + } - return defined $version ? $version->stringify : undef; - }; + return defined $version ? $version->stringify : undef; } 1; #this line is important and will help the module return a true value === t/metadata.t ================================================================== --- t/metadata.t (revision 2576) +++ t/metadata.t (local) @@ -165,8 +165,8 @@ --- $dist->regen; my $provides = new_build()->prepare_metadata()->{provides}; - is $provides->{'Simple'}{version}, '0.60.128', "Check version"; - is $provides->{'Simple::Simon'}{version}, '0.61.129', "Check version"; + is $provides->{'Simple'}{version}, 'v0.60.128', "Check version"; + is $provides->{'Simple::Simon'}{version}, 'v0.61.129', "Check version"; is ref($provides->{'Simple'}{version}), '', "Versions from prepare_metadata() aren't refs"; is ref($provides->{'Simple::Simon'}{version}), '', "Versions from prepare_metadata() aren't refs"; }