Change 32740 by [EMAIL PROTECTED] on 2007/12/27 13:46:46
Regexps are now orange.
(Correct a comparison of $] with 5.011 in B.pm)
Affected files ...
... //depot/perl/ext/B/B.pm#85 edit
... //depot/perl/ext/Devel/Peek/t/Peek.t#31 edit
... //depot/perl/lib/overload.t#33 edit
... //depot/perl/pp_hot.c#536 edit
... //depot/perl/regexec.c#549 edit
... //depot/perl/sv.c#1454 edit
... //depot/perl/util.c#640 edit
Differences ...
==== //depot/perl/ext/B/B.pm#85 (text) ====
Index: perl/ext/B/B.pm
--- perl/ext/B/B.pm#84~32734~ 2007-12-26 09:03:56.000000000 -0800
+++ perl/ext/B/B.pm 2007-12-27 05:46:46.000000000 -0800
@@ -34,10 +34,11 @@
@B::IV::ISA = 'B::SV';
@B::NV::ISA = 'B::SV';
# RV is eliminated with 5.11.0, but effectively is a specialisation of IV now.
[EMAIL PROTECTED]::RV::ISA = $] > 5.011 ? 'B::IV' : 'B::SV';
[EMAIL PROTECTED]::RV::ISA = $] >= 5.011 ? 'B::IV' : 'B::SV';
@B::PVIV::ISA = qw(B::PV B::IV);
@B::PVNV::ISA = qw(B::PVIV B::NV);
@B::PVMG::ISA = 'B::PVNV';
[EMAIL PROTECTED]::ORANGE::ISA = 'B::PVMG' if $] >= 5.011;
# Change in the inheritance hierarchy post 5.9.0
@B::PVLV::ISA = $] > 5.009 ? 'B::GV' : 'B::PVMG';
# BM is eliminated post 5.9.5, but effectively is a specialisation of GV now.
==== //depot/perl/ext/Devel/Peek/t/Peek.t#31 (text) ====
Index: perl/ext/Devel/Peek/t/Peek.t
--- perl/ext/Devel/Peek/t/Peek.t#30~32734~ 2007-12-26 09:03:56.000000000
-0800
+++ perl/ext/Devel/Peek/t/Peek.t 2007-12-27 05:46:46.000000000 -0800
@@ -275,6 +275,27 @@
\\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump2"
OUTSIDE = $ADDR \\(MAIN\\)');
+if ($] >= 5.011) {
+do_test(15,
+ qr(tic),
+'SV = $RV\\($ADDR\\) at $ADDR
+ REFCNT = 1
+ FLAGS = \\(ROK\\)
+ RV = $ADDR
+ SV = ORANGE\\($ADDR\\) at $ADDR
+ REFCNT = 1
+ FLAGS = \\(OBJECT,SMG\\)
+ IV = 0
+ NV = 0
+ PV = 0
+ MAGIC = $ADDR
+ MG_VIRTUAL = $ADDR
+ MG_TYPE = PERL_MAGIC_qr\(r\)
+ MG_OBJ = $ADDR
+ PAT = "\(\?-xism:tic\)"
+ REFCNT = 2
+ STASH = $ADDR\\t"Regexp"');
+} else {
do_test(15,
qr(tic),
'SV = $RV\\($ADDR\\) at $ADDR
@@ -294,6 +315,7 @@
PAT = "\(\?-xism:tic\)"
REFCNT = 2
STASH = $ADDR\\t"Regexp"');
+}
do_test(16,
(bless {}, "Tac"),
==== //depot/perl/lib/overload.t#33 (text) ====
Index: perl/lib/overload.t
--- perl/lib/overload.t#32~32141~ 2007-10-19 00:47:45.000000000 -0700
+++ perl/lib/overload.t 2007-12-27 05:46:46.000000000 -0800
@@ -1125,7 +1125,7 @@
like(overload::StrVal(sub{1}), qr/^CODE\(0x[0-9a-f]+\)$/);
like(overload::StrVal(\*GLOB), qr/^GLOB\(0x[0-9a-f]+\)$/);
like(overload::StrVal(\$o), qr/^REF\(0x[0-9a-f]+\)$/);
- like(overload::StrVal(qr/a/), qr/^Regexp=SCALAR\(0x[0-9a-f]+\)$/);
+ like(overload::StrVal(qr/a/), qr/^Regexp=ORANGE\(0x[0-9a-f]+\)$/);
like(overload::StrVal($o), qr/^perl31793=ARRAY\(0x[0-9a-f]+\)$/);
like(overload::StrVal($of), qr/^perl31793_fb=ARRAY\(0x[0-9a-f]+\)$/);
like(overload::StrVal($no), qr/^no_overload=ARRAY\(0x[0-9a-f]+\)$/);
==== //depot/perl/pp_hot.c#536 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#535~32737~ 2007-12-26 10:12:32.000000000 -0800
+++ perl/pp_hot.c 2007-12-27 05:46:46.000000000 -0800
@@ -1197,6 +1197,7 @@
SV * const sv = newSVrv(rv, SvPV_nolen(pkg));
if (rx->extflags & RXf_TAINTED)
SvTAINTED_on(rv);
+ sv_upgrade(sv, SVt_ORANGE);
sv_magic(sv,(SV*)ReREFCNT_inc(rx), PERL_MAGIC_qr,0,0);
XPUSHs(rv);
RETURN;
==== //depot/perl/regexec.c#549 (text) ====
Index: perl/regexec.c
--- perl/regexec.c#548~32630~ 2007-12-17 09:17:23.000000000 -0800
+++ perl/regexec.c 2007-12-27 05:46:46.000000000 -0800
@@ -3730,9 +3730,11 @@
re = CALLREGCOMP(ret, pm_flags);
if (!(SvFLAGS(ret)
& (SVs_TEMP | SVs_PADTMP | SVf_READONLY
- | SVs_GMG)))
+ | SVs_GMG))) {
+ SvUPGRADE(ret, SVt_ORANGE);
sv_magic(ret,(SV*)ReREFCNT_inc(re),
PERL_MAGIC_qr,0,0);
+ }
PL_regsize = osize;
}
}
==== //depot/perl/sv.c#1454 (text) ====
Index: perl/sv.c
--- perl/sv.c#1453~32738~ 2007-12-26 10:53:48.000000000 -0800
+++ perl/sv.c 2007-12-27 05:46:46.000000000 -0800
@@ -916,8 +916,9 @@
{ sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, SVt_PVMG, FALSE, HADNV,
HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
- /* There are plans for this */
- { 0, 0, 0, SVt_ORANGE, FALSE, NONV, NOARENA, 0 },
+ /* 28 */
+ { sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, SVt_ORANGE, FALSE,
HADNV,
+ HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
/* 48 */
{ sizeof(XPVGV), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV,
@@ -1309,6 +1310,7 @@
case SVt_PVGV:
case SVt_PVCV:
case SVt_PVLV:
+ case SVt_ORANGE:
case SVt_PVMG:
case SVt_PVNV:
case SVt_PV:
@@ -2696,7 +2698,7 @@
if (!referent) {
len = 7;
retval = buffer = savepvn("NULLREF", len);
- } else if (SvTYPE(referent) == SVt_PVMG
+ } else if (SvTYPE(referent) == SVt_ORANGE
&& ((SvFLAGS(referent) &
(SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
== (SVs_OBJECT|SVs_SMG))
@@ -7768,6 +7770,7 @@
case SVt_PVFM: return "FORMAT";
case SVt_PVIO: return "IO";
case SVt_BIND: return "BIND";
+ case SVt_ORANGE: return "ORANGE";
default: return "UNKNOWN";
}
}
==== //depot/perl/util.c#640 (text) ====
Index: perl/util.c
--- perl/util.c#639~32713~ 2007-12-22 16:39:17.000000000 -0800
+++ perl/util.c 2007-12-27 05:46:46.000000000 -0800
@@ -5921,7 +5921,7 @@
mg_get(sv);
if (SvROK(sv) &&
(tmpsv = (SV*)SvRV(sv)) && /* assign deliberate */
- SvTYPE(tmpsv) == SVt_PVMG &&
+ SvTYPE(tmpsv) == SVt_ORANGE &&
(mg = mg_find(tmpsv, PERL_MAGIC_qr))) /* assign deliberate */
{
return (REGEXP *)mg->mg_obj;
End of Patch.
