Change 30302 by [EMAIL PROTECTED] on 2007/02/14 22:00:02
Integrate:
[ 29566]
Add a new flag SVprv_PCS_IMPORTED (which is a pseudonym for SVf_SCREAM)
to note when a proxy constant subroutine is copied. This allows us to
correctly set GvIMPORTED_CV_on() if the symbol is ever turned into a
real GV.
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#333 integrate
... //depot/maint-5.8/perl/dump.c#79 integrate
... //depot/maint-5.8/perl/gv.c#101 integrate
... //depot/maint-5.8/perl/pp_hot.c#133 integrate
... //depot/maint-5.8/perl/sv.h#79 integrate
... //depot/maint-5.8/perl/t/lib/proxy_constant_subs.t#1 branch
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#333 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#332~30299~ 2007-02-14 13:31:37.000000000 -0800
+++ perl/MANIFEST 2007-02-14 14:00:02.000000000 -0800
@@ -2695,6 +2695,7 @@
t/lib/Math/BigInt/Subclass.pm Empty subclass of BigInt for test
t/lib/Math/BigRat/Test.pm Math::BigRat test helper
t/lib/NoExporter.pm Part of Test-Simple
+t/lib/proxy_constant_subs.t Test that Proxy Constant Subs behave correctly
t/lib/sample-tests/bailout Test data for Test::Harness
t/lib/sample-tests/bignum Test data for Test::Harness
t/lib/sample-tests/bignum_many Test data for Test::Harness
==== //depot/maint-5.8/perl/dump.c#79 (text) ====
Index: perl/dump.c
--- perl/dump.c#78~30291~ 2007-02-14 08:37:49.000000000 -0800
+++ perl/dump.c 2007-02-14 14:00:02.000000000 -0800
@@ -1202,8 +1202,12 @@
if (flags & SVp_IOK) sv_catpv(d, "pIOK,");
if (flags & SVp_NOK) sv_catpv(d, "pNOK,");
if (flags & SVp_POK) sv_catpv(d, "pPOK,");
- if (flags & SVp_SCREAM && type != SVt_PVHV)
+ if (flags & SVp_SCREAM && type != SVt_PVHV) {
+ if (SvPCS_IMPORTED(sv))
+ sv_catpv(d, "PCS_IMPORTED,");
+ else
sv_catpv(d, "SCREAM,");
+ }
switch (type) {
case SVt_PVCV:
==== //depot/maint-5.8/perl/gv.c#101 (text) ====
Index: perl/gv.c
--- perl/gv.c#100~30295~ 2007-02-14 10:04:52.000000000 -0800
+++ perl/gv.c 2007-02-14 14:00:02.000000000 -0800
@@ -191,6 +191,7 @@
const bool doproto = SvTYPE(gv) > SVt_NULL;
const char * const proto = (doproto && SvPOK(gv)) ? SvPVX_const(gv) : NULL;
SV *const has_constant = doproto && SvROK(gv) ? SvRV(gv) : NULL;
+ const U32 exported_constant = has_constant ? SvPCS_IMPORTED(gv) : 0;
assert (!(proto && has_constant));
@@ -232,6 +233,11 @@
if (has_constant) {
/* newCONSTSUB takes ownership of the reference from us. */
GvCV(gv) = newCONSTSUB(stash, (char *)name, has_constant);
+ /* If this reference was a copy of another, then the subroutine
+ must have been "imported", by a Perl space assignment to a GV
+ from a reference to CV. */
+ if (exported_constant)
+ GvIMPORTED_CV_on(gv);
} else {
/* XXX unsafe for 5005 threads if eval_owner isn't held */
(void) start_subparse(0,0); /* Create empty CV in compcv. */
==== //depot/maint-5.8/perl/pp_hot.c#133 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#132~30295~ 2007-02-14 10:04:52.000000000 -0800
+++ perl/pp_hot.c 2007-02-14 14:00:02.000000000 -0800
@@ -142,7 +142,7 @@
SV *const value = SvRV(cv);
SvUPGRADE((SV *)gv, SVt_RV);
- SvROK_on(gv);
+ SvPCS_IMPORTED_on(gv);
SvRV_set(gv, value);
SvREFCNT_inc(value);
SETs(right);
==== //depot/maint-5.8/perl/sv.h#79 (text) ====
Index: perl/sv.h
--- perl/sv.h#78~30290~ 2007-02-14 08:13:48.000000000 -0800
+++ perl/sv.h 2007-02-14 14:00:02.000000000 -0800
@@ -282,6 +282,10 @@
#define SVf_NOK 0x00020000 /* has valid public numeric value */
#define SVf_POK 0x00040000 /* has valid public pointer value */
#define SVf_ROK 0x00080000 /* has a valid reference pointer */
+#define SVprv_PCS_IMPORTED SVp_SCREAM /* RV is a proxy for a constant
+ subroutine in another package. Set the
+ CvIMPORTED_CV_ON() if it needs to be
+ expanded to a real GV */
#define SVf_FAKE 0x00100000 /* 0: glob or lexical is just a copy
1: SV head arena wasn't malloc()ed
@@ -841,6 +845,11 @@
#define SvWEAKREF_on(sv) (SvFLAGS(sv) |= (SVf_ROK|SVprv_WEAKREF))
#define SvWEAKREF_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK|SVprv_WEAKREF))
+#define SvPCS_IMPORTED(sv) ((SvFLAGS(sv) & (SVf_ROK|SVprv_PCS_IMPORTED)) \
+ == (SVf_ROK|SVprv_PCS_IMPORTED))
+#define SvPCS_IMPORTED_on(sv) (SvFLAGS(sv) |= (SVf_ROK|SVprv_PCS_IMPORTED))
+#define SvPCS_IMPORTED_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK|SVprv_PCS_IMPORTED))
+
#define SvTHINKFIRST(sv) (SvFLAGS(sv) & SVf_THINKFIRST)
#define SvPADBUSY(sv) (SvFLAGS(sv) & SVs_PADBUSY)
==== //depot/maint-5.8/perl/t/lib/proxy_constant_subs.t#1 (text) ====
Index: perl/t/lib/proxy_constant_subs.t
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/t/lib/proxy_constant_subs.t 2007-02-14 14:00:02.000000000 -0800
@@ -0,0 +1,41 @@
+my @symbols;
+BEGIN {
+ chdir 't';
+ @INC = '../lib';
+ require Config;
+ if (($Config::Config{'extensions'} !~ /\bB\b/) ){
+ print "1..0 # Skip -- Perl configured without B module\n";
+ exit 0;
+ }
+ if ($Config::Config{'extensions'} !~ /\bPOSIX\b/) {
+ print "1..0 # Skip -- Perl configured without POSIX\n";
+ exit 0;
+ }
+ # errno is a real subroutine, and acts as control
+ # SEEK_SET is a proxy constant subroutine.
+ @symbols = qw(errno SEEK_SET);
+}
+
+use strict;
+use warnings;
+use Test::More tests => 4 * @symbols;
+use B qw(svref_2object GVf_IMPORTED_CV);
+use POSIX @symbols;
+
+# GVf_IMPORTED_CV should not be set on the original, but should be set on the
+# imported GV.
+
+foreach my $symbol (@symbols) {
+ my ($ps, $ms);
+ {
+ no strict 'refs';
+ $ps = svref_2object(\*{"POSIX::$symbol"});
+ $ms = svref_2object(\*{"::$symbol"});
+ }
+ isa_ok($ps, 'B::GV');
+ is($ps->GvFLAGS() & GVf_IMPORTED_CV, 0,
+ "GVf_IMPORTED_CV not set on original");
+ isa_ok($ms, 'B::GV');
+ is($ms->GvFLAGS() & GVf_IMPORTED_CV, GVf_IMPORTED_CV,
+ "GVf_IMPORTED_CV set on imported GV");
+}
End of Patch.
