[PATCH] Make UNIVERSAL::VERSION return $VERSION #11522
Comments
From @cpansproutSee the discussion starting at http://www.nntp.perl.org/group/perl.perl5.porters/2011/06/msg173710.html With this patch: Flags: Site configuration information for perl 5.15.0: Configured by sprout at Thu Jun 16 05:42:17 PDT 2011. Summary of my perl5 (revision 5 version 15 subversion 0) configuration: Locally applied patches: @INC for perl 5.15.0: Environment for perl 5.15.0: |
From @cpansproutInline Patchdiff --git a/universal.c b/universal.c
index 3295fc5..1caab9d 100644
--- a/universal.c
+++ b/universal.c
@@ -327,21 +327,20 @@ XS(XS_UNIVERSAL_VERSION)
gvp = pkg ? (GV**)hv_fetchs(pkg, "VERSION", FALSE) : NULL;
if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
- SV * const nsv = sv_newmortal();
- sv_setsv(nsv, sv);
- sv = nsv;
- if ( !sv_derived_from(sv, "version"))
- upg_version(sv, FALSE);
+ ST(0) = sv_newmortal();
+ sv_setsv(ST(0), sv);
undef = NULL;
}
else {
- sv = &PL_sv_undef;
+ sv = ST(0) = &PL_sv_undef;
undef = "(undef)";
}
if (items > 1) {
SV *req = ST(1);
+ if ( !sv_derived_from(sv, "version"))
+ upg_version(sv, FALSE);
if (undef) {
if (pkg) {
const char * const name = HvNAME_get(pkg);
@@ -376,12 +375,6 @@ XS(XS_UNIVERSAL_VERSION)
}
- if ( SvOK(sv) && sv_derived_from(sv, "version") ) {
- ST(0) = sv_2mortal(vstringify(sv));
- } else {
- ST(0) = sv;
- }
-
XSRETURN(1);
}
|
From @JohnPeacockOn 07/24/2011 07:55 PM, Father Chrysostomos (via RT) wrote:
Close, but if you run lib/version.t, you will see that you are throwing ... # Failed test 'Replacement handles modules without package or VERSION' The attached replacement patch fixes that (just need to delay upgrading sv). I'm including this change in the next version.pm on CPAN (hopefully John |
From @JohnPeacockVERSION2.diffdiff --git a/universal.c b/universal.c
index 3295fc5..896b3db 100644
--- a/universal.c
+++ b/universal.c
@@ -327,15 +327,12 @@ XS(XS_UNIVERSAL_VERSION)
gvp = pkg ? (GV**)hv_fetchs(pkg, "VERSION", FALSE) : NULL;
if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
- SV * const nsv = sv_newmortal();
- sv_setsv(nsv, sv);
- sv = nsv;
- if ( !sv_derived_from(sv, "version"))
- upg_version(sv, FALSE);
+ ST(0) = sv_newmortal();
+ sv_setsv(ST(0), sv);
undef = NULL;
}
else {
- sv = &PL_sv_undef;
+ sv = ST(0) = &PL_sv_undef;
undef = "(undef)";
}
@@ -355,6 +352,9 @@ XS(XS_UNIVERSAL_VERSION)
}
}
+ if ( !sv_derived_from(sv, "version"))
+ upg_version(sv, FALSE);
+
if ( !sv_derived_from(req, "version")) {
/* req may very well be R/O, so create a new object */
req = sv_2mortal( new_version(req) );
@@ -376,12 +376,6 @@ XS(XS_UNIVERSAL_VERSION)
}
- if ( SvOK(sv) && sv_derived_from(sv, "version") ) {
- ST(0) = sv_2mortal(vstringify(sv));
- } else {
- ST(0) = sv;
- }
-
XSRETURN(1);
}
|
|
The RT System itself - Status changed from 'new' to 'open' |
From @JohnPeacockOn 07/26/2011 11:25 AM, John Peacock wrote:
And attached is an even better patch that includes the test I added to John |
From @JohnPeacockVERSION2.diffdiff --git a/lib/version.t b/lib/version.t
index bee9078..ac6a5dd 100644
--- a/lib/version.t
+++ b/lib/version.t
@@ -474,6 +474,20 @@ SKIP: {
'Replacement handles modules without VERSION');
unlink $filename;
}
+SKIP: { # https://rt.perl.org/rt3/Ticket/Display.html?id=95544
+ skip "version require'd instead of use'd, cannot test UNIVERSAL::VERSION", 2
+ unless defined $qv_declare;
+ my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
+ (my $package = basename($filename)) =~ s/\.pm$//;
+ print $fh "package $package;\n\$VERSION = '3alpha';\n1;\n";
+ close $fh;
+ eval "use lib '.'; use $package;";
+ unlike ($@, qr/Invalid version format (non-numeric data)/,
+ 'Do not warn about bad $VERSION unless asked');
+ eval "use lib '.'; use $package; warn $package->VERSION";
+ ok ($warning =~ /3alpha/, 'Even a bad $VERSION is returned:
+ '.$warning);
+ }
SKIP: {
skip 'Cannot test bare v-strings with Perl < 5.6.0', 4
@@ -624,7 +638,6 @@ SKIP: {
my $warning;
local $SIG{__WARN__} = sub { $warning = $_[0] };
-$DB::single = 1;
my $v = eval { $CLASS->$method('1,7') };
# is( $@, "", 'Directly test comma as decimal compliance');
diff --git a/universal.c b/universal.c
index 3295fc5..896b3db 100644
--- a/universal.c
+++ b/universal.c
@@ -327,15 +327,12 @@ XS(XS_UNIVERSAL_VERSION)
gvp = pkg ? (GV**)hv_fetchs(pkg, "VERSION", FALSE) : NULL;
if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
- SV * const nsv = sv_newmortal();
- sv_setsv(nsv, sv);
- sv = nsv;
- if ( !sv_derived_from(sv, "version"))
- upg_version(sv, FALSE);
+ ST(0) = sv_newmortal();
+ sv_setsv(ST(0), sv);
undef = NULL;
}
else {
- sv = &PL_sv_undef;
+ sv = ST(0) = &PL_sv_undef;
undef = "(undef)";
}
@@ -355,6 +352,9 @@ XS(XS_UNIVERSAL_VERSION)
}
}
+ if ( !sv_derived_from(sv, "version"))
+ upg_version(sv, FALSE);
+
if ( !sv_derived_from(req, "version")) {
/* req may very well be R/O, so create a new object */
req = sv_2mortal( new_version(req) );
@@ -376,12 +376,6 @@ XS(XS_UNIVERSAL_VERSION)
}
- if ( SvOK(sv) && sv_derived_from(sv, "version") ) {
- ST(0) = sv_2mortal(vstringify(sv));
- } else {
- ST(0) = sv;
- }
-
XSRETURN(1);
}
|
From @cpansproutOn Tue Jul 26 11:25:57 2011, john.peacock@havurah-software.org wrote:
I forgot to mention that the patch was intended mainly for discussion. I Thank you for finding the bug. Before you make the release (I hope I’m Perl_croak(aTHX_ We can’t get rid of the scalar it’s using. Attached is a better patch. |
From @cpansproutInline Patchdiff --git a/universal.c b/universal.c
index 3295fc5..c891b54 100644
--- a/universal.c
+++ b/universal.c
@@ -311,6 +311,7 @@ XS(XS_UNIVERSAL_VERSION)
GV **gvp;
GV *gv;
SV *sv;
+ SV *ret;
const char *undef;
PERL_UNUSED_ARG(cv);
@@ -327,15 +328,12 @@ XS(XS_UNIVERSAL_VERSION)
gvp = pkg ? (GV**)hv_fetchs(pkg, "VERSION", FALSE) : NULL;
if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
- SV * const nsv = sv_newmortal();
- sv_setsv(nsv, sv);
- sv = nsv;
- if ( !sv_derived_from(sv, "version"))
- upg_version(sv, FALSE);
+ ret = sv_newmortal();
+ sv_setsv(ret, sv);
undef = NULL;
}
else {
- sv = &PL_sv_undef;
+ sv = ret = &PL_sv_undef;
undef = "(undef)";
}
@@ -355,6 +353,9 @@ XS(XS_UNIVERSAL_VERSION)
}
}
+ if ( !sv_derived_from(sv, "version"))
+ upg_version(sv, FALSE);
+
if ( !sv_derived_from(req, "version")) {
/* req may very well be R/O, so create a new object */
req = sv_2mortal( new_version(req) );
@@ -376,11 +377,7 @@ XS(XS_UNIVERSAL_VERSION)
}
- if ( SvOK(sv) && sv_derived_from(sv, "version") ) {
- ST(0) = sv_2mortal(vstringify(sv));
- } else {
- ST(0) = sv;
- }
+ ST(0) = ret;
XSRETURN(1);
} |
From [Unknown Contact. See original ticket]On Tue Jul 26 11:25:57 2011, john.peacock@havurah-software.org wrote:
I forgot to mention that the patch was intended mainly for discussion. I Thank you for finding the bug. Before you make the release (I hope I’m Perl_croak(aTHX_ We can’t get rid of the scalar it’s using. Attached is a better patch. |
From @cpansproutOn Tue Jul 26 18:38:03 2011, john.peacock@havurah-software.org wrote:
Argh!! I was too late, wasn’t I? (See my previous message.) |
From [Unknown Contact. See original ticket]On Tue Jul 26 18:38:03 2011, john.peacock@havurah-software.org wrote:
Argh!! I was too late, wasn’t I? (See my previous message.) |
From @cpansproutOn Tue Jul 26 18:38:03 2011, john.peacock@havurah-software.org wrote:
Don’t you mean \( and \) in that regexp? Shouldn’t it actually be is($@, ''), so that a changing error message |
From [Unknown Contact. See original ticket]On Tue Jul 26 18:38:03 2011, john.peacock@havurah-software.org wrote:
Don’t you mean \( and \) in that regexp? Shouldn’t it actually be is($@, ''), so that a changing error message |
From @JohnPeacockOn 07/26/2011 08:27 PM, Father Chrysostomos via RT wrote:
John |
From @JohnPeacockOn 07/26/2011 08:34 PM, Father Chrysostomos via RT wrote:
Yes, actually I do. I'll make that change to the version.pm repo, but I
No, I want to be sure that I match the exact error message that is John |
From @cpansproutOn Wed Jul 27 07:05:48 2011, john.peacock@havurah-software.org wrote:
ST(0), which contains the package name. We can’t write to ST(0) until after that block, which is why my updated |
From [Unknown Contact. See original ticket]On Wed Jul 27 07:05:48 2011, john.peacock@havurah-software.org wrote:
ST(0), which contains the package name. We can’t write to ST(0) until after that block, which is why my updated |
From @JohnPeacockOn 07/27/2011 08:30 AM, Father Chrysostomos via RT wrote:
John |
From @JohnPeacockOn 07/26/2011 08:34 PM, Father Chrysostomos via RT wrote:
John |
From @JohnPeacockVERSION3.diffdiff --git a/lib/version.t b/lib/version.t
index bee9078..dd47e87 100644
--- a/lib/version.t
+++ b/lib/version.t
@@ -474,6 +474,22 @@ SKIP: {
'Replacement handles modules without VERSION');
unlink $filename;
}
+SKIP: { # https://rt.perl.org/rt3/Ticket/Display.html?id=95544
+ skip "version require'd instead of use'd, cannot test UNIVERSAL::VERSION", 2
+ unless defined $qv_declare;
+ my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
+ (my $package = basename($filename)) =~ s/\.pm$//;
+ print $fh "package $package;\n\$VERSION = '3alpha';\n1;\n";
+ close $fh;
+ eval "use lib '.'; use $package; die $package->VERSION";
+ ok ($@ =~ /3alpha/, 'Even a bad $VERSION is returned');
+ eval "use lib '.'; use $package;";
+ unlike ($@, qr/Invalid version format \(non-numeric data\)/,
+ 'Do not warn about bad $VERSION unless asked');
+ eval "use lib '.'; use $package 1;";
+ like ($@, qr/Invalid version format \(non-numeric data\)/,
+ 'Warn about bad $VERSION when asked');
+ }
SKIP: {
skip 'Cannot test bare v-strings with Perl < 5.6.0', 4
@@ -624,7 +640,6 @@ SKIP: {
my $warning;
local $SIG{__WARN__} = sub { $warning = $_[0] };
-$DB::single = 1;
my $v = eval { $CLASS->$method('1,7') };
# is( $@, "", 'Directly test comma as decimal compliance');
|
From @cpansproutOn Wed Jul 27 13:01:24 2011, john.peacock@havurah-software.org wrote:
Thank you. I’ve just applied my patch as 9bf41c1 and yours as a0e8d7b. |
From [Unknown Contact. See original ticket]On Wed Jul 27 13:01:24 2011, john.peacock@havurah-software.org wrote:
Thank you. I’ve just applied my patch as 9bf41c1 and yours as a0e8d7b. |
|
@cpansprout - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#95544 (status was 'resolved')
Searchable as RT95544$
The text was updated successfully, but these errors were encountered: