New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
regex not evaluated in constant ?: #6233
Comments
From perl-5.8.0@ton.iguana.beCreated by perl-5.8.0@ton.iguana.beRecently i was helping someone on irc who tried to use signal !~ ( $var eq "a" ? /$test$/ : /^$test/) and was confused that it didn't do what she expected. Of course in What however confused the asker most was that $signal !~ ( 1 ? /$test$/ : /^$test/) actually matches $test to signal. It confuses me too, but for the Perl Info
|
From @rgsperl-5.8.0@ton.iguana.be (via RT) wrote:
I don't understand _what_ is the bug you're reporting. use Test::More tests => 8; It produces with bleadperl and with 5.8.0 : 1..8 note that in the first four tests, the conditionals are $ bleadperl -MO=Deparse,-p test.pl |
From @ysthOn Mon, 27 Jan 2003 00:11:43 +0100, rgarciasuarez@free.fr wrote:
?? In all those cases, whether the /foo/ or /bar/ path is taken, the (N.B., the doc doesn't make it clear to me whether = |
From perl5-porters@ton.iguana.beIn article <20030127001143.7d5eaec2.rgarciasuarez@_ree._r>,
(I already answered this in a direct mail, but I didn't see it appear It's the way the constant folding works that I'm reporting as a bug. $_="foo"; (prints 1, it matches the constant "foo" to /foo/, $_ isn't involved) $p=1; (prints nothing, $_ is matched with /foo/ which gives "1", which does not match "foo") $_="foo"; (prints nothing, "1" doesn't match "foo" (again $_ is not involved at all) and $p=1; (prints 1, /foo/ matches $_, giving "1" which in turn matches the 1 I don't think these should differ. And I think the ones using $p The tests you gave in the example are not very relevant since if they More interesting would be: "a"= Here the empty match is first set up to mean "match a". Now it does NOT |
From me-02@ton.iguana.beOn Sun, Jan 26, 2003 at 11:06:13PM -0000, Rafael Garcia-Suarez wrote:
It's the constant folding that I'm reporting as a bug. $_="foo"; (prints 1, it matches the constant "foo" to /foo/, $_ isn't involved) $p=1; (prints nothing, $_ is matched with /foo/ which gives "1", which does not match "foo") $_="foo"; (prints nothing, "1" doesn't match "foo" (again $_ is not involved at all) and $p=1; (prints 1, /foo/ matches $_, giving "1" which in turn matches the 1 I don't think these should differ. And I think the ones using $p The tests you gave in the example are not very relevant since if they More interesting would be: "a"= Here the empty match is first set up to mean "match a". Now it does NOT |
From @cpansproutThis patch solves the problem by marking match and subst ops as OPf_SPECIAL during constant folding, so the =~ operator can tell not to take possession of it. |
From @cpansproutInline Patchdiff -Nup blead/op.c blead-20444-re-const-flodding/op.c
--- blead/op.c 2010-07-25 10:28:10.000000000 -0700
+++ blead-20444-re-const-flodding/op.c 2010-08-01 11:15:56.000000000 -0700
@@ -2242,9 +2242,10 @@ Perl_bind_match(pTHX_ I32 type, OP *left
type == OP_NOT)
yyerror("Using !~ with s///r doesn't make sense");
- ismatchop = rtype == OP_MATCH ||
- rtype == OP_SUBST ||
- rtype == OP_TRANS;
+ ismatchop = (rtype == OP_MATCH ||
+ rtype == OP_SUBST ||
+ rtype == OP_TRANS)
+ && !(right->op_flags & OPf_SPECIAL);
if (ismatchop && right->op_private & OPpTARGET_MY) {
right->op_targ = 0;
right->op_private &= ~OPpTARGET_MY;
@@ -4689,6 +4690,11 @@ S_new_logop(pTHX_ I32 type, I32 flags, O
op_free(first);
if (other->op_type == OP_LEAVE)
other = newUNOP(OP_NULL, OPf_SPECIAL, other);
+ else if (other->op_type == OP_MATCH
+ || other->op_type == OP_SUBST
+ || other->op_type == OP_TRANS)
+ /* Mark the op as being unbindable with =~ */
+ other->op_flags |= OPf_SPECIAL;
return other;
}
else {
@@ -4827,6 +4833,10 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *firs
}
if (live->op_type == OP_LEAVE)
live = newUNOP(OP_NULL, OPf_SPECIAL, live);
+ else if (live->op_type == OP_MATCH || live->op_type == OP_SUBST
+ || live->op_type == OP_TRANS)
+ /* Mark the op as being unbindable with =~ */
+ live->op_flags |= OPf_SPECIAL;
return live;
}
NewOp(1101, logop, 1, LOGOP);
diff -Nup blead/op.h blead-20444-re-const-flodding/op.h
--- blead/op.h 2010-07-29 03:17:10.000000000 -0700
+++ blead-20444-re-const-flodding/op.h 2010-08-01 07:06:45.000000000 -0700
@@ -142,6 +142,10 @@ Deprecated. Use C<GIMME_V> instead.
/* On OP_HELEM and OP_HSLICE, localization will be followed
by assignment, so do not wipe the target if it is special
(e.g. a glob or a magic SV) */
+ /* On OP_MATCH, OP_SUBST & OP_TRANS, the
+ operand of a logical or conditional
+ that was optimised away, so it should
+ not be bound via =~ */
/* old names; don't use in new code, but don't break them, either */
#define OPf_LIST OPf_WANT_LIST
diff -Nurp blead/t/comp/fold.t blead-20444-re-const-flodding/t/comp/fold.t
--- blead/t/comp/fold.t 2009-11-19 08:51:40.000000000 -0800
+++ blead-20444-re-const-flodding/t/comp/fold.t 2010-08-01 11:15:02.000000000 -0700
@@ -4,7 +4,7 @@
# we've not yet verified that use works.
# use strict;
-print "1..13\n";
+print "1..19\n";
my $test = 0;
# Historically constant folding was performed by evaluating the ops, and if
@@ -52,6 +52,16 @@ sub is {
failed($got, "'$expect'", $name);
}
+sub ok {
+ my ($got, $name) = @_;
+ $test = $test + 1;
+ if ($got) {
+ print "ok $test - $name\n";
+ return 1;
+ }
+ failed($got, "a true value", $name);
+}
+
my $a;
$a = eval '$b = 0/0 if 0; 3';
is ($a, 3, 'constants in conditionals don\'t affect constant folding');
@@ -88,3 +98,23 @@ is ($@, '', 'no error');
like ($@, qr/division/, "eval caught division");
is($c, 2, "missing die hook");
}
+
+# [perl #20444] Constant folding should not change the meaning of match
+# operators.
+{
+ local *_;
+ $_="foo"; my $jing = 1;
+ ok scalar $jing =~ (1 ? /foo/ : /bar/),
+ 'lone m// is not bound via =~ after ? : folding';
+ ok scalar $jing =~ (0 || /foo/),
+ 'lone m// is not bound via =~ after || folding';
+ ok scalar $jing =~ (1 ? s/foo/foo/ : /bar/),
+ 'lone s/// is not bound via =~ after ? : folding';
+ ok scalar $jing =~ (0 || s/foo/foo/),
+ 'lone s/// is not bound via =~ after || folding';
+ $jing = 3;
+ ok scalar $jing =~ (1 ? y/fo// : /bar/),
+ 'lone y/// is not bound via =~ after ? : folding';
+ ok scalar $jing =~ (0 || y/fo//),
+ 'lone y/// is not bound via =~ after || folding';
+} |
From @cpansproutOn Aug 1, 2010, at 12:21 PM, Father Chrysostomos wrote:
With that patch: $ ./perl -Ilib -MO=Deparse -e'"foo" =~ (1?/foo/:/bar/)' So the Deparse output no longer matches what perl does. With the patch attached to this message applied after that one: $ ./perl -Ilib -MO=Deparse -e'"foo" =~ (1?/foo/:/bar/)' |
From @cpansproutInline Patchdiff -Nurp blead-20444-re-const-flodding/dist/B-Deparse/Deparse.pm blead-20444-re-const-flodding-copy/dist/B-Deparse/Deparse.pm
--- blead-20444-re-const-flodding/dist/B-Deparse/Deparse.pm 2010-06-21 14:31:10.000000000 -0700
+++ blead-20444-re-const-flodding-copy/dist/B-Deparse/Deparse.pm 2010-08-01 18:25:57.000000000 -0700
@@ -4221,6 +4221,7 @@ sub matchop {
}
my $quote = 1;
my $extended = ($op->pmflags & PMf_EXTENDED);
+ my $rhs_bound_to_defsv;
if (null $kid) {
my $unbacked = re_unback($op->precomp);
if ($extended) {
@@ -4232,6 +4233,7 @@ sub matchop {
carp("found ".$kid->name." where regcomp expected");
} else {
($re, $quote) = $self->regcomp($kid, 21, $extended);
+ $rhs_bound_to_defsv = 1 if $kid->first->first->flags & OPf_SPECIAL;
}
my $flags = "";
$flags .= "c" if $op->pmflags & PMf_CONTINUE;
@@ -4250,7 +4252,13 @@ sub matchop {
}
$re = $re . $flags if $quote;
if ($binop) {
- return $self->maybe_parens("$var =~ $re", $cx, 20);
+ return
+ $self->maybe_parens(
+ $rhs_bound_to_defsv
+ ? "$var =~ (\$_ =~ $re)"
+ : "$var =~ $re",
+ $cx, 20
+ );
} else {
return $re;
}
diff -Nurp blead-20444-re-const-flodding/dist/B-Deparse/t/deparse.t blead-20444-re-const-flodding-copy/dist/B-Deparse/t/deparse.t
--- blead-20444-re-const-flodding/dist/B-Deparse/t/deparse.t 2010-05-03 14:22:11.000000000 -0700
+++ blead-20444-re-const-flodding-copy/dist/B-Deparse/t/deparse.t 2010-08-01 18:26:56.000000000 -0700
@@ -17,7 +17,7 @@ BEGIN {
require feature;
feature->import(':5.10');
}
-use Test::More tests => 89;
+use Test::More tests => 90;
use Config ();
use B::Deparse;
@@ -645,3 +645,12 @@ pop;
pop();
####
pop @_;
+####
+# 82 [perl #20444]
+"foo" =~ (1 ? /foo/ : /bar/);
+"foo" =~ (1 ? y/foo// : /bar/);
+"foo" =~ (1 ? s/foo// : /bar/);
+>>>>
+'foo' =~ ($_ =~ /foo/);
+'foo' =~ ($_ =~ tr/fo//);
+'foo' =~ ($_ =~ s/foo//); |
From @cpansproutOn Sun Aug 01 20:12:28 2010, sprout wrote:
The two patches have been applied as |
@cpansprout - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#20444 (status was 'resolved')
Searchable as RT20444$
The text was updated successfully, but these errors were encountered: