summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--dist/constant/t/constant.t2
-rw-r--r--ext/B/t/OptreeCheck.pm18
-rw-r--r--ext/B/t/optree_constants.t3
-rw-r--r--op.c12
-rw-r--r--pad.c2
-rw-r--r--t/op/not.t1
-rw-r--r--t/op/ref.t4
7 files changed, 18 insertions, 24 deletions
diff --git a/dist/constant/t/constant.t b/dist/constant/t/constant.t
index 6b2ac27dcc..d39c05a6d3 100644
--- a/dist/constant/t/constant.t
+++ b/dist/constant/t/constant.t
@@ -363,7 +363,6 @@ eval q{
local $TODO;
if ($Config::Config{useithreads}) {
skip "fails under threads", 1 if $] < 5.019001;
- $TODO = ' ';
}
like $@, qr/^Modification of a read-only value attempted at /,
'... and immutable through refgen, too';
@@ -387,7 +386,6 @@ SKIP: {
local $TODO;
if ($Config::Config{useithreads}) {
skip "fails under threads", 1 if $] < 5.019001;
- $TODO = ' ';
}
like $@, qr/^Modification of a read-only value attempted at /,
'... and immutable through refgen, too';
diff --git a/ext/B/t/OptreeCheck.pm b/ext/B/t/OptreeCheck.pm
index 45523133a3..547f017d72 100644
--- a/ext/B/t/OptreeCheck.pm
+++ b/ext/B/t/OptreeCheck.pm
@@ -213,7 +213,8 @@ They're both required, and the correct one is selected for the platform
being tested, and saved into the synthesized property B<wanted>.
Individual sample lines may be suffixed with whitespace followed
-by (<|<=|==|>=|>)5.nnnn to select that line only for the listed perl
+by (<|<=|==|>=|>)5.nnnn (up to two times) to
+select that line only for the listed perl
version; the whitespace and conditional are stripped.
=head2 bcopts => $bcopts || [ @bcopts ]
@@ -641,9 +642,10 @@ sub mkCheckRex {
# strip out conditional lines
- $str =~ s{^(.*?)\s+(<|<=|==|>=|>)\s*(5\.\d+)\ *\n}
+ $str =~ s{^(.*?) \s+(<|<=|==|>=|>)\s*(5\.\d+)
+ (?:\s+(<|<=|==|>=|>)\s*(5\.\d+))? \ *\n}
{
- my ($line, $cmp, $version) = ($1,$2,$3);
+ my ($line, $cmp, $version, $cmp2, $v2) = ($1,$2,$3,$4,$5,$6);
my $repl = "";
if ( $cmp eq '<' ? $] < $version
: $cmp eq '<=' ? $] <= $version
@@ -651,11 +653,19 @@ sub mkCheckRex {
: $cmp eq '>=' ? $] >= $version
: $cmp eq '>' ? $] > $version
: die("bad comparision '$cmp' in string [$str]\n")
+ and !$cmp2 || (
+ $cmp2 eq '<' ? $] < $v2
+ : $cmp2 eq '<=' ? $] <= $v2
+ : $cmp2 eq '==' ? $] == $v2
+ : $cmp2 eq '>=' ? $] >= $v2
+ : $cmp2 eq '>' ? $] > $v2
+ : die("bad comparision '$cmp2' in string [$str]\n")
+ )
) {
$repl = "$line\n";
}
$repl;
- }gem;
+ }gemx;
$tc->{wantstr} = $str;
diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t
index bfd355e0cc..d08c6be93d 100644
--- a/ext/B/t/optree_constants.t
+++ b/ext/B/t/optree_constants.t
@@ -348,7 +348,8 @@ checkOptree ( name => 'lc*,uc*,gt,lt,ge,le,cmp',
# n <$> const[PV "b-cmp-a"] s ->o
# p <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
# q <$> const[PVNV 0] s/SHORT ->r < 5.017002
-# q <$> const[PVNV 0] s/FOLD,SHORT ->r >=5.017002
+# q <$> const[PVNV 0] s/FOLD,SHORT ->r >=5.017002 < 5.019001
+# q <$> const[SPECIAL sv_no] s/FOLD,SHORT ->r >=5.019001
EOT_EOT
# r <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->r
diff --git a/op.c b/op.c
index bc62048944..f7cfe39018 100644
--- a/op.c
+++ b/op.c
@@ -1752,16 +1752,7 @@ S_finalize_op(pTHX_ OP* o)
* for reference counts, sv_upgrade() etc. */
if (cSVOPo->op_sv) {
const PADOFFSET ix = pad_alloc(OP_CONST, SVf_READONLY);
- if (o->op_type != OP_METHOD_NAMED &&
- (SvPADTMP(cSVOPo->op_sv) || SvPADMY(cSVOPo->op_sv)))
- {
- /* If op_sv is already a PADTMP/MY then it is being used by
- * some pad, so make a copy. */
- sv_setsv(PAD_SVl(ix),cSVOPo->op_sv);
- if (!SvIsCOW(PAD_SVl(ix))) SvREADONLY_on(PAD_SVl(ix));
- SvREFCNT_dec(cSVOPo->op_sv);
- }
- else if (o->op_type != OP_METHOD_NAMED
+ if (o->op_type != OP_METHOD_NAMED
&& cSVOPo->op_sv == &PL_sv_undef) {
/* PL_sv_undef is hack - it's unsafe to store it in the
AV that is the pad, because av_fetch treats values of
@@ -1775,7 +1766,6 @@ S_finalize_op(pTHX_ OP* o)
}
else {
SvREFCNT_dec(PAD_SVl(ix));
- SvPADTMP_on(cSVOPo->op_sv);
PAD_SETSV(ix, cSVOPo->op_sv);
/* XXX I don't know how this isn't readonly already. */
if (!SvIsCOW(PAD_SVl(ix))) SvREADONLY_on(PAD_SVl(ix));
diff --git a/pad.c b/pad.c
index 3586b64f09..8e7c47ca98 100644
--- a/pad.c
+++ b/pad.c
@@ -1638,7 +1638,7 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
"Pad 0x%"UVxf"[0x%"UVxf"] swipe: %ld\n",
PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
- if (PL_curpad[po])
+ if (PL_curpad[po] && !SvPADMY(PL_curpad[po]))
SvPADTMP_off(PL_curpad[po]);
if (refadjust)
SvREFCNT_dec(PL_curpad[po]);
diff --git a/t/op/not.t b/t/op/not.t
index e82f62751e..54de3b0ce7 100644
--- a/t/op/not.t
+++ b/t/op/not.t
@@ -88,6 +88,5 @@ for (!1) { eval { $_ = 43 } }
like $@, qr/^Modification of a read-only value attempted at /,
'not 1 is read-only';
require Config;
-$::TODO = 'not fixed yet' if $Config::Config{useithreads};;
is \!0, \$yes, '!0 returns the same value each time [perl #114838]';
is \!1, \$no, '!1 returns the same value each time [perl #114838]';
diff --git a/t/op/ref.t b/t/op/ref.t
index acd278ea49..a6564cea44 100644
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -793,7 +793,6 @@ for (3) {
like $@, qr/^Modification of a read-only/,
'assignment to value aliased to literal number';
require Config;
- local $::TODO = " " if $Config::Config{useithreads};
eval { ${\$_} = 4 };
like $@, qr/^Modification of a read-only/,
'refgen does not allow assignment to value aliased to literal number';
@@ -803,14 +802,11 @@ for ("4eounthouonth") {
like $@, qr/^Modification of a read-only/,
'assignment to value aliased to literal string';
require Config;
- local $::TODO = " " if $Config::Config{useithreads};
eval { ${\$_} = 4 };
like $@, qr/^Modification of a read-only/,
'refgen does not allow assignment to value aliased to literal string';
}
{
- local $::TODO = ' '
- if $Config::Config{useithreads} && $Config::Config{mad};
my $aref = \123;
is \$$aref, $aref,
'[perl #109746] referential identity of \literal under threads+mad'
View Lorry Controller Status