Change 29566 by [EMAIL PROTECTED] on 2006/12/16 23:03:42
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/perl/MANIFEST#1495 edit
... //depot/perl/dump.c#243 edit
... //depot/perl/gv.c#337 edit
... //depot/perl/pp_hot.c#492 edit
... //depot/perl/sv.h#306 edit
... //depot/perl/t/lib/proxy_constant_subs.t#1 add
Differences ...
==== //depot/perl/MANIFEST#1495 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#1494~29557~ 2006-12-15 02:14:16.000000000 -0800
+++ perl/MANIFEST 2006-12-16 15:03:42.000000000 -0800
@@ -3362,6 +3362,7 @@
t/lib/mypragma.pm An example user pragma
t/lib/mypragma.t Test the example user pragma
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/perl/dump.c#243 (text) ====
Index: perl/dump.c
--- perl/dump.c#242~29565~ 2006-12-16 08:54:06.000000000 -0800
+++ perl/dump.c 2006-12-16 15:03:42.000000000 -0800
@@ -1385,8 +1385,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 && !isGV_with_GP(sv))
+ if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)) {
+ if (SvPCS_IMPORTED(sv))
+ sv_catpv(d, "PCS_IMPORTED,");
+ else
sv_catpv(d, "SCREAM,");
+ }
switch (type) {
case SVt_PVCV:
==== //depot/perl/gv.c#337 (text) ====
Index: perl/gv.c
--- perl/gv.c#336~29565~ 2006-12-16 08:54:06.000000000 -0800
+++ perl/gv.c 2006-12-16 15:03:42.000000000 -0800
@@ -191,6 +191,7 @@
const bool doproto = old_type > 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));
@@ -239,6 +240,11 @@
if (has_constant) {
/* newCONSTSUB takes ownership of the reference from us. */
GvCV(gv) = newCONSTSUB(stash, 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 threads if eval_owner isn't held */
(void) start_subparse(0,0); /* Create empty CV in compcv. */
==== //depot/perl/pp_hot.c#492 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#491~29544~ 2006-12-13 00:35:43.000000000 -0800
+++ perl/pp_hot.c 2006-12-16 15:03:42.000000000 -0800
@@ -150,7 +150,7 @@
SV *const value = SvRV(cv);
SvUPGRADE((SV *)gv, SVt_RV);
- SvROK_on(gv);
+ SvPCS_IMPORTED_on(gv);
SvRV_set(gv, value);
SvREFCNT_inc_simple_void(value);
SETs(right);
==== //depot/perl/sv.h#306 (text) ====
Index: perl/sv.h
--- perl/sv.h#305~29565~ 2006-12-16 08:54:06.000000000 -0800
+++ perl/sv.h 2006-12-16 15:03:42.000000000 -0800
@@ -294,6 +294,10 @@
#define SVp_SCREAM 0x00008000 /* has been studied? */
#define SVphv_CLONEABLE SVp_SCREAM /* PVHV (stashes) clone its objects
*/
#define SVpgv_GP SVp_SCREAM /* GV has a valid GP */
+#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 SVs_PADSTALE 0x00010000 /* lexical has gone out of scope */
#define SVpad_STATE 0x00010000 /* pad name is a "state" var */
@@ -1013,6 +1017,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 SvPADSTALE(sv) (SvFLAGS(sv) & SVs_PADSTALE)
==== //depot/perl/t/lib/proxy_constant_subs.t#1 (text) ====
Index: perl/t/lib/proxy_constant_subs.t
--- /dev/null 2006-11-16 10:04:37.532058837 -0800
+++ perl/t/lib/proxy_constant_subs.t 2006-12-16 15:03:42.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.
