Patch against svn.perl.org repo revision 14448 attached.
It also fixes an unrelated test bug ("$version" == "..." is wrong. It
has to be "$version" eq "..." because the overloading is lost when
stringified)
-- David
Index: t/coretests.pm
===================================================================
--- t/coretests.pm (revision 14448)
+++ t/coretests.pm (working copy)
@@ -342,16 +342,26 @@
if $] < 5.006_000;
diag "Tests with v-strings" if $Verbose;
$version = $CLASS->$method(1.2.3);
- ok("$version" == "v1.2.3", '"$version" == 1.2.3');
+ ok("$version" eq "v1.2.3", '"$version" eq 1.2.3');
$version = $CLASS->$method(1.0.0);
$new_version = $CLASS->$method(1);
ok($version == $new_version, '$version == $new_version');
skip "version require'd instead of use'd, cannot test declare", 1
unless defined $qv_declare;
$version = &$qv_declare(1.2.3);
- ok("$version" == "v1.2.3", 'v-string initialized $qv_declare()');
+ ok("$version" eq "v1.2.3", 'v-string initialized $qv_declare()');
}
+SKIP: {
+ skip 'Cannot test bare alpha v-strings with Perl < 5.8.1', 2
+ if $] lt 5.008_001;
+ diag "Tests with bare alpha v-strings" if $Verbose;
+ $version = $CLASS->$method(v1.2.3_4);
+ is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4"');
+ $version = $CLASS->$method(eval "v1.2.3_4");
+ is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4" (from eval)');
+ }
+
diag "Tests with real-world (malformed) data" if $Verbose;
# trailing zero testing (reported by Andreas Koenig).
Index: vperl/vpp.pm
===================================================================
--- vperl/vpp.pm (revision 14448)
+++ vperl/vpp.pm (working copy)
@@ -495,17 +495,44 @@
sub _un_vstring {
my $value = shift;
# may be a v-string
- if ( $] >= 5.006_000 && length($value) >= 3 && $value !~ /[._]/
- && (ord($value) < ord('0') || ord($value) > ord('9')) ) {
- my $tvalue = sprintf("v%vd",$value);
- if ( $tvalue =~ /^v\d+(\.\d+){2,}$/ ) {
- # must be a v-string
- $value = $tvalue;
- }
+ if ( length($value) >= 3 && $value !~ /[._]/
+ && (ord($value) < ord('0') || ord($value) > ord('9'))
+ ) {
+ my $tvalue;
+ if ( $] ge 5.008_001 ) {
+ $tvalue = _find_magic_vstring($value);
+ $value = $tvalue if length $tvalue;
+ }
+ elsif ( $] ge 5.006_000 ) {
+ $tvalue = sprintf("v%vd",$value);
+ if ( $tvalue =~ /^v\d+(\.\d+){2,}$/ ) {
+ # must be a v-string
+ $value = $tvalue;
+ }
+ }
}
return $value;
}
+sub _find_magic_vstring {
+ my $value = shift;
+ my $tvalue = '';
+ require B;
+ my $sv = B::svref_2object(\$value);
+ my $magic = ref($sv) eq 'B::PVMG' ? $sv->MAGIC : undef;
+ while ( $magic ) {
+ if ( $magic->TYPE eq 'V' ) {
+ $tvalue = $magic->PTR;
+ $tvalue =~ s/^v?(.+)$/v$1/;
+ last;
+ }
+ else {
+ $magic = $magic->MOREMAGIC;
+ }
+ }
+ return $tvalue;
+}
+
sub _VERSION {
my ($obj, $req) = @_;
my $class = ref($obj) || $obj;
