Change 29898 by [EMAIL PROTECTED] on 2007/01/20 18:43:49
Integrate:
[ 27241]
Add a new CvISXSUB() macro, for abstracting the test as to whether a
PVCV is perl or XS.
[ 27267]
Change 24643 made the mistake of assuming that CvCONST can only be true
on XSUBs. Somehow it can also end up on perl subs. Bug spotted by and
test case from Marcus Holland-Moritz.
Affected files ...
... //depot/maint-5.8/perl/cv.h#13 integrate
... //depot/maint-5.8/perl/dump.c#59 integrate
... //depot/maint-5.8/perl/ext/Devel/Peek/Peek.xs#5 integrate
... //depot/maint-5.8/perl/gv.c#83 integrate
... //depot/maint-5.8/perl/op.c#162 integrate
... //depot/maint-5.8/perl/pad.c#58 integrate
... //depot/maint-5.8/perl/pp_ctl.c#145 integrate
... //depot/maint-5.8/perl/pp_hot.c#112 integrate
... //depot/maint-5.8/perl/pp_sort.c#42 integrate
... //depot/maint-5.8/perl/sv.c#294 integrate
... //depot/maint-5.8/perl/t/op/threads.t#5 integrate
Differences ...
==== //depot/maint-5.8/perl/cv.h#13 (text) ====
Index: perl/cv.h
--- perl/cv.h#12~26582~ 2006-01-02 11:40:28.000000000 -0800
+++ perl/cv.h 2007-01-20 10:43:49.000000000 -0800
@@ -153,7 +153,7 @@
#define CvWEAKOUTSIDE_on(cv) (CvFLAGS(cv) |= CVf_WEAKOUTSIDE)
#define CvWEAKOUTSIDE_off(cv) (CvFLAGS(cv) &= ~CVf_WEAKOUTSIDE)
-
+#define CvISXSUB(cv) (CvXSUB(cv) ? TRUE : FALSE)
/*
=head1 CV reference counts and CvOUTSIDE
==== //depot/maint-5.8/perl/dump.c#59 (text) ====
Index: perl/dump.c
--- perl/dump.c#58~29807~ 2007-01-14 05:09:22.000000000 -0800
+++ perl/dump.c 2007-01-20 10:43:49.000000000 -0800
@@ -84,7 +84,7 @@
gv_fullname3(sv, gv, NULL);
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX_const(sv));
- if (CvXSUB(GvCV(gv)))
+ if (CvISXSUB(GvCV(gv)))
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
PTR2UV(CvXSUB(GvCV(gv))),
(int)CvXSUBANY(GvCV(gv)).any_i32);
==== //depot/maint-5.8/perl/ext/Devel/Peek/Peek.xs#5 (text) ====
Index: perl/ext/Devel/Peek/Peek.xs
--- perl/ext/Devel/Peek/Peek.xs#4~25521~ 2005-09-20 09:41:56.000000000
-0700
+++ perl/ext/Devel/Peek/Peek.xs 2007-01-20 10:43:49.000000000 -0800
@@ -39,7 +39,7 @@
int levels, tots = 0, levela, tota = 0, levelas, totas = 0;
int dumpit = 0;
- if (CvXSUB(sv)) {
+ if (CvISXSUB(sv)) {
continue; /* XSUB */
}
if (!CvGV(sv)) {
==== //depot/maint-5.8/perl/gv.c#83 (text) ====
Index: perl/gv.c
--- perl/gv.c#82~29896~ 2007-01-20 09:47:00.000000000 -0800
+++ perl/gv.c 2007-01-20 10:43:49.000000000 -0800
@@ -607,7 +607,7 @@
packname, (int)len, name);
#ifndef USE_5005THREADS
- if (CvXSUB(cv)) {
+ if (CvISXSUB(cv)) {
/* rather than lookup/init $AUTOLOAD here
* only to have the XSUB do another lookup for $AUTOLOAD
* and split that value on the last '::',
==== //depot/maint-5.8/perl/op.c#162 (text) ====
Index: perl/op.c
--- perl/op.c#161~29897~ 2007-01-20 10:14:46.000000000 -0800
+++ perl/op.c 2007-01-20 10:43:49.000000000 -0800
@@ -4150,14 +4150,14 @@
#endif /* USE_5005THREADS */
#ifdef USE_ITHREADS
- if (CvFILE(cv) && !CvXSUB(cv)) {
+ if (CvFILE(cv) && !CvISXSUB(cv)) {
/* for XSUBs CvFILE point directly to static memory; __FILE__ */
Safefree(CvFILE(cv));
}
CvFILE(cv) = 0;
#endif
- if (!CvXSUB(cv) && CvROOT(cv)) {
+ if (!CvISXSUB(cv) && CvROOT(cv)) {
#ifdef USE_5005THREADS
if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
Perl_croak(aTHX_ "Can't undef active subroutine");
==== //depot/maint-5.8/perl/pad.c#58 (text) ====
Index: perl/pad.c
--- perl/pad.c#57~29896~ 2007-01-20 09:47:00.000000000 -0800
+++ perl/pad.c 2007-01-20 10:43:49.000000000 -0800
@@ -1358,8 +1358,8 @@
CvOWNER(cv) = 0;
#endif /* USE_5005THREADS */
#ifdef USE_ITHREADS
- CvFILE(cv) = CvXSUB(proto) ? CvFILE(proto)
- : savepv(CvFILE(proto));
+ CvFILE(cv) = CvISXSUB(proto) ? CvFILE(proto)
+ : savepv(CvFILE(proto));
#else
CvFILE(cv) = CvFILE(proto);
#endif
==== //depot/maint-5.8/perl/pp_ctl.c#145 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#144~29897~ 2007-01-20 10:14:46.000000000 -0800
+++ perl/pp_ctl.c 2007-01-20 10:43:49.000000000 -0800
@@ -1629,7 +1629,7 @@
hasargs = 0;
SPAGAIN;
- if (CvXSUB(cv)) {
+ if (CvISXSUB(cv)) {
CvDEPTH(cv)++;
PUSHMARK(SP);
(void)(*CvXSUB(cv))(aTHX_ cv);
@@ -2212,7 +2212,7 @@
PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av);
}
}
- else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */
+ else if (CvISXSUB(cv)) { /* put GvAV(defgv) back onto stack */
#ifdef USE_5005THREADS
AV* const av = (AV*)PAD_SVl(0);
#else
@@ -2233,7 +2233,7 @@
/* Now do some callish stuff. */
SAVETMPS;
SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
- if (CvXSUB(cv)) {
+ if (CvISXSUB(cv)) {
if (reified) {
I32 index;
for (index=0; index<items; index++)
==== //depot/maint-5.8/perl/pp_hot.c#112 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#111~29896~ 2007-01-20 09:47:00.000000000 -0800
+++ perl/pp_hot.c 2007-01-20 10:43:49.000000000 -0800
@@ -2620,7 +2620,7 @@
SvIV_set(dbsv, PTR2IV(cv)); /* Do it the quickest way */
}
- if (CvXSUB(cv))
+ if (CvISXSUB(cv))
PL_curcopdb = PL_curcop;
cv = GvCV(PL_DBsub);
return cv;
@@ -2869,7 +2869,7 @@
}
#endif /* USE_5005THREADS */
- if (CvXSUB(cv)) {
+ if (CvISXSUB(cv)) {
#ifdef PERL_XSUB_OLDSTYLE
if (CvOLDSTYLE(cv)) {
I32 (*fp3)(int,int,int);
==== //depot/maint-5.8/perl/pp_sort.c#42 (text) ====
Index: perl/pp_sort.c
--- perl/pp_sort.c#41~29888~ 2007-01-19 13:24:46.000000000 -0800
+++ perl/pp_sort.c 2007-01-20 10:43:49.000000000 -0800
@@ -1517,7 +1517,7 @@
}
}
if (!(cv && CvROOT(cv))) {
- if (cv && CvXSUB(cv)) {
+ if (cv && CvISXSUB(cv)) {
is_xsub = 1;
}
else if (gv) {
==== //depot/maint-5.8/perl/sv.c#294 (text) ====
Index: perl/sv.c
--- perl/sv.c#293~29897~ 2007-01-20 10:14:46.000000000 -0800
+++ perl/sv.c 2007-01-20 10:43:49.000000000 -0800
@@ -9570,7 +9570,7 @@
OP_REFCNT_LOCK;
CvROOT(dstr) = OpREFCNT_inc(CvROOT(dstr));
OP_REFCNT_UNLOCK;
- if (CvCONST(dstr)) {
+ if (CvCONST(dstr) && CvISXSUB(dstr)) {
CvXSUBANY(dstr).any_ptr = GvUNIQUE(CvGV(dstr)) ?
SvREFCNT_inc(CvXSUBANY(dstr).any_ptr) :
sv_dup_inc((SV *)CvXSUBANY(dstr).any_ptr, param);
@@ -9587,7 +9587,7 @@
CvWEAKOUTSIDE(sstr)
? cv_dup( CvOUTSIDE(dstr), param)
: cv_dup_inc(CvOUTSIDE(dstr), param);
- if (!CvXSUB(dstr))
+ if (!CvISXSUB(dstr))
CvFILE(dstr) = SAVEPV(CvFILE(dstr));
break;
}
==== //depot/maint-5.8/perl/t/op/threads.t#5 (text) ====
Index: perl/t/op/threads.t
--- perl/t/op/threads.t#4~26700~ 2006-01-07 06:14:30.000000000 -0800
+++ perl/t/op/threads.t 2007-01-20 10:43:49.000000000 -0800
@@ -18,7 +18,7 @@
print "1..0 # Skip: no dynamic loading on miniperl, no threads\n";
exit 0;
}
- plan(3);
+ plan(4);
}
use threads;
@@ -60,3 +60,13 @@
threads->new(sub { $ref = $object } )->join; # $ref = $object causes problems
print "ok";
EOI
+
+# Change 24643 made the mistake of assuming that CvCONST can only be true on
+# XSUBs. Somehow it can also end up on perl subs.
+fresh_perl_is(<<'EOI', 'ok', { }, 'cloning constant subs');
+use constant x=>1;
+use threads;
+$SIG{__WARN__} = sub{};
+async sub {};
+print "ok";
+EOI
End of Patch.
