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
return 0 or die; #9523
Comments
From rvtol@xs4all.nlCreated by rvtol@xs4all.nlC<return doit() or die "did it wrong";> Would be nice if that warns "unreachable statement". Perl Info
|
From @druud62"rvtol@xs4all.nl (via RT)" schreef:
Another variant of "unreachable": perl -wle 'my $x = <>; $x++ or die; print $x' (am not sure about the relation yet) -- "Gewoon is een tijger." |
The RT System itself - Status changed from 'new' to 'open' |
From Eirik-Berg.Hanssen@allverden.no"Dr.Ruud" <rvtol+news@isolution.nl> writes:
How so unreachable? echo -n | perl -wle 'my $x = <>; $x++ or die; print $x' Died at -e line 1.
(?) Eirik |
From @druud62Eirik Berg Hanssen schreef:
Oops, please ignore. (forgot to chomp my test values) -- "Gewoon is een tijger." |
From @druud62"rvtol(AT)xs4all.nl (via RT)" schreef:
Some examples can be seen here: There is one in: http://search.cpan.org/src/GRICHTER/ExtUtils-XSBuilder-0.28/XSBuilder/ParseSource.pm A multi-line example: -- "Gewoon is een tijger." |
From @davidnicolthis one looks like a typical offender: <<COPIED 88: if($simpleLocker){ 97: if($simpleLocker){ www.cpan.org/authors/id/A/AL/ALEXMASS/BatchSystem-SBS-0.32.tar.gz Refusing to allow return in non-void contexts would also disallow (wearedone and return) or domore; but how legit is that? wearedone and return; would be a non-violating rewrite. Alternately, dropping the precedence of return would make C<return a low-precedence return would surely expose some bugs in currently On Tue, Oct 21, 2008 at 6:19 PM, Dr.Ruud <rvtol+news@isolution.nl> wrote:
|
From olav@genebio.comHello David, I do not understand the problem.,, That's true that I was supposing the precedence of the return. I slightly modified the code as would that make this piece of code more secure? David Nicol wrote:
-- |
From tchrist@perl.comReturn *is* low precedence already. Compare: return ($a + $b) * $c; with print ($a + $b) * $c; --tom |
From @jkeenanI reviewed this 5-year-old ticket tonight. I don't see any claim that I am taking this ticket for the purpose of closing it in seven days -- Thank you very much. |
From @demerphqOn 19 February 2013 02:51, James E Keenan via RT
Well, Im not going to take it over, but IMO: return $x should warn or something. So maybe the ticket should be marked stalled and not closed? Yves -- |
From @druud62On 2013-02-19 03:03, demerphq wrote:
Indeed, the requested change is to warn on popular kinds of unreachable return ... or ...; Or leave it to perlcritic/perltidy? -- |
From @nwc10On Tue, Feb 19, 2013 at 11:44:21AM +0100, Dr.Ruud wrote:
(subexpression that always causes control flow) [operator] ... where ... is unreachable.
The code that we're suggesting should warn, is buggy as written. I don't To my mind, it's a legitimate todo. Nicholas Clark |
From @LeontOn Tue, Feb 19, 2013 at 3:03 AM, demerphq <demerphq@gmail.com> wrote:
Yeah, this is always buggy, so we might as well warn. Leon |
From @ap* Leon Timmermans <fawaka@gmail.com> [2013-02-19 13:15]:
Except in Perl poetry. I am sure that Paul Fenwick, for one, -- |
From @rjbs* Leon Timmermans <fawaka@gmail.com> [2013-02-19T07:12:42]
Agreed. I've made this mistake and then wondered why I didn't get an -- |
From tchrist@perl.com"Dr.Ruud" <rvtol+usenet@isolution.nl> wrote
What is it that gardenpaths people into making this sort of error, anyway? I'm serious. --tom |
From tchrist@perl.comLeon Timmermans <fawaka@gmail.com> wrote
Precedence is different on return than anywhere else in Perl. sub t1 { return(0) || warn "warning 1" } --tom |
From tchrist@perl.comRicardo Signes <perl.p5p@rjbs.manxome.org> wrote
Again I ask: what is it that leads anyone ever to make that --tom |
From @demerphqOn 19 February 2013 17:02, Tom Christiansen <tchrist@perl.com> wrote:
Who cares? People do it and it causes trouble and Perl should probably cheers, -- |
From @HugmeirOn Tue, Feb 19, 2013 at 1:02 PM, Tom Christiansen <tchrist@perl.com> wrote:
Playing the devil's advocate, how about: Blind code standardization, |
From tchrist@perl.comdemerphq <demerphq@gmail.com> wrote
The reason it matters is because I have no idea what that is supposed There are uncountably many similar constructs that Perl does not warn $ perl -cwe 'die "ABC"; die "XYZ"' $ perl -cwe 'die("ABC") || die("XYZ")' $ perl -cwe 'die("ABC") && die("XYZ")' None of which are caught and all of which should be. Remember /* NOTREACHED */ I want to understand what it is that the people who make this --tom |
From @LeontOn Tue, Feb 19, 2013 at 7:25 PM, Tom Christiansen <tchrist@perl.com> wrote:
It's a simple precedence mistake. Leon |
From @LeontOn Tue, Feb 19, 2013 at 3:08 PM, Aristoteles Pagaltzis <pagaltzis@gmx.de> wrote:
Fortunately, one usually doesn't run poetry with warnings enabled ;-) Leon |
From @ap* Tom Christiansen <tchrist@perl.com> [2013-02-19 17:00]:
This smells to me like a super-special parse reminiscent of how Perl sort foo($x) which has cost me way too many hairs over the years. I run into it just Err. I’m afraid I’m not sure any of that is even relevant to your point… all -- |
From tchrist@perl.comAristotle Pagaltzis <pagaltzis@gmx.de> wrote
The thing about return is that it is design to make it hard to make return ($a + 5) * 9; and have it do the right thing. I just had never heard of anybody Leave it that skunky "or" thing to screw that up. Thank goodness --tom |
From @rjbs* Tom Christiansen <tchrist@perl.com> [2013-02-19T11:02:02]
I don't remember how it came about. I assume it was the result of my $x = foo or die; turned into return foo or die; ...but I can't remember. I only remember that I've gotten that sort of I do think it's useful to know what kind of confusion of ideas that could -- |
From @janduboisOn Tue, Feb 19, 2013 at 4:54 PM, Ricardo Signes
Just for the record, I've also seen return foo() and bar(); # supposed to return TRUE only when in the wild (can't remember where). Which I guess proves Tom's point Cheers, |
From @LeontOn Wed, Feb 20, 2013 at 2:07 AM, Jan Dubois <jand@activestate.com> wrote:
People write bugs on any precedence level, I don't think that that Leon |
From tchrist@perl.comLeon Timmermans <fawaka@gmail.com> wrote
The argument is that the only people who do not make precedence mistakes Thinking that you -- and everybody else! -- always know, remember, and 1: left terms and list operators (leftward) That is the reasoning behind "just use parens". Once you start doing that, --tom |
From @nthykier0001-op.c-Add-op_folded-to-BASEOP.patchFrom 422e79d529540c15c6795d9a252329541eb05244 Mon Sep 17 00:00:00 2001
From: Niels Thykier <niels@thykier.net>
Date: Wed, 17 Jul 2013 20:59:54 +0200
Subject: [PATCH 1/2] op.c: Add op_folded to BASEOP
Add a new member, op_folded, to BASEOP. It is replacement for
OPpCONST_FOLDED (which can only be set on OP_CONST). At the moment
OPpCONST_FOLDED remains, as it is exposed in B (e.g. B::Concise relies
on it).
Signed-off-by: Niels Thykier <niels@thykier.net>
---
op.c | 14 ++++++++++----
op.h | 7 +++++--
toke.c | 1 +
3 files changed, 16 insertions(+), 6 deletions(-)
diff --git a/op.c b/op.c
index d5323a0..a9ee2d1 100644
--- a/op.c
+++ b/op.c
@@ -3345,7 +3345,10 @@ S_fold_constants(pTHX_ OP *o)
if (type == OP_RV2GV)
newop = newGVOP(OP_GV, 0, MUTABLE_GV(sv));
else
+ {
newop = newSVOP(OP_CONST, OPpCONST_FOLDED<<8, MUTABLE_SV(sv));
+ newop->op_folded = 1;
+ }
op_getmad(o,newop,'f');
return newop;
@@ -5880,6 +5883,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
other->op_flags |= OPf_SPECIAL;
else if (other->op_type == OP_CONST)
other->op_private |= OPpCONST_FOLDED;
+
+ other->op_folded = 1;
return other;
}
else {
@@ -6041,6 +6046,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
live->op_flags |= OPf_SPECIAL;
else if (live->op_type == OP_CONST)
live->op_private |= OPpCONST_FOLDED;
+ live->op_folded = 1;
return live;
}
NewOp(1101, logop, 1, LOGOP);
@@ -8651,7 +8657,7 @@ Perl_ck_ftst(pTHX_ OP *o)
const OPCODE kidtype = kid->op_type;
if (kidtype == OP_CONST && (kid->op_private & OPpCONST_BARE)
- && !(kid->op_private & OPpCONST_FOLDED)) {
+ && !kid->op_folded) {
OP * const newop = newGVOP(type, OPf_REF,
gv_fetchsv(kid->op_sv, GV_ADD, SVt_PVIO));
#ifdef PERL_MAD
@@ -9236,7 +9242,7 @@ Perl_ck_listiob(pTHX_ OP *o)
kid = kid->op_sibling;
else if (kid && !kid->op_sibling) { /* print HANDLE; */
if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE
- && !(kid->op_private & OPpCONST_FOLDED)) {
+ && !kid->op_folded) {
o->op_flags |= OPf_STACKED; /* make it a filehandle */
kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
cLISTOPo->op_first->op_sibling = kid;
@@ -10603,8 +10609,8 @@ Perl_ck_trunc(pTHX_ OP *o)
if (kid->op_type == OP_NULL)
kid = (SVOP*)kid->op_sibling;
if (kid && kid->op_type == OP_CONST &&
- (kid->op_private & (OPpCONST_BARE|OPpCONST_FOLDED))
- == OPpCONST_BARE)
+ (kid->op_private & OPpCONST_BARE) &&
+ !kid->op_folded)
{
o->op_flags |= OPf_SPECIAL;
kid->op_private &= ~OPpCONST_STRICT;
diff --git a/op.h b/op.h
index 5d1a771..dcfd5be 100644
--- a/op.h
+++ b/op.h
@@ -23,7 +23,8 @@
* op_static tell op_free() to skip PerlMemShared_free(), when
* !op_slabbed.
* op_savefree on savestack via SAVEFREEOP
- * op_spare Three spare bits
+ * op_folded Result/remainder of a constant fold operation.
+ * op_spare Two spare bits
* op_flags Flags common to all operations. See OPf_* below.
* op_private Flags peculiar to a particular operation (BUT,
* by default, set to the number of children until
@@ -56,7 +57,8 @@ typedef PERL_BITFIELD16 Optype;
PERL_BITFIELD16 op_slabbed:1; \
PERL_BITFIELD16 op_savefree:1; \
PERL_BITFIELD16 op_static:1; \
- PERL_BITFIELD16 op_spare:3; \
+ PERL_BITFIELD16 op_folded:1; \
+ PERL_BITFIELD16 op_spare:2; \
U8 op_flags; \
U8 op_private;
#endif
@@ -257,6 +259,7 @@ Deprecated. Use C<GIMME_V> instead.
#define OPpCONST_STRICT 8 /* bareword subject to strict 'subs' */
#define OPpCONST_ENTERED 16 /* Has been entered as symbol. */
#define OPpCONST_BARE 64 /* Was a bare word (filehandle?). */
+/* Replaced by op_folded in perl itself, still used by B/B::Concise etc. */
#define OPpCONST_FOLDED 128 /* Result of constant folding */
/* Private for OP_FLIP/FLOP */
diff --git a/toke.c b/toke.c
index 1615cb6..883b881 100644
--- a/toke.c
+++ b/toke.c
@@ -7391,6 +7391,7 @@ Perl_yylex(pTHX)
SvREFCNT_dec(((SVOP*)pl_yylval.opval)->op_sv);
((SVOP*)pl_yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
pl_yylval.opval->op_private = OPpCONST_FOLDED;
+ pl_yylval.opval->op_folded = 1;
pl_yylval.opval->op_flags |= OPf_SPECIAL;
TOKEN(WORD);
}
--
1.7.10.4
|
From @nthykier0002-op.c-Warn-on-return-a-or-b-perl-59802.patchFrom 1c7ceaba32801cdb7b754628fc6996b952a5b79f Mon Sep 17 00:00:00 2001
From: Niels Thykier <niels@thykier.net>
Date: Mon, 15 Jul 2013 22:25:19 +0200
Subject: [PATCH 2/2] op.c: Warn on "return $a or $b" [perl #59802]
Add a warning for the (likely) unintended use of "return $a or $b"
(and similar expressions), which perl parses as "(return $a) || $b"
(which is effectively just "return $a;").
Note this warning is triggered by some modules (e.g. Test::Builder).
These are not fixed by this commit.
Signed-off-by: Niels Thykier <niels@thykier.net>
---
op.c | 38 ++++++++++++++++++++++++++++++++++++++
pod/perldiag.pod | 22 ++++++++++++++++++++++
t/lib/warnings/op | 37 +++++++++++++++++++++++++++++++++++++
3 files changed, 97 insertions(+)
diff --git a/op.c b/op.c
index a9ee2d1..e2e5be6 100644
--- a/op.c
+++ b/op.c
@@ -5830,6 +5830,44 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
first = *firstp;
other = *otherp;
+ /* [perl #59802]: Warn about things like "return $a or $b", which
+ is parsed as "(return $a) or $b" rather than "return ($a or
+ $b)". NB: This also applies to xor, which is why we do it
+ here.
+ */
+ switch (first->op_type) {
+ case OP_NEXT:
+ case OP_LAST:
+ case OP_REDO:
+ /* XXX: Perhaps we should emit a stronger warning for these.
+ Even with the high-precedence operator they don't seem to do
+ anything sensible.
+
+ But until we do, fall through here.
+ */
+ case OP_RETURN:
+ case OP_DIE:
+ case OP_EXIT:
+ case OP_GOTO:
+ /* XXX: Currently we allow people to "shoot themselves in the
+ foot" by explicitly writing "(return $a) or $b".
+
+ Warn unless we are looking at the result from folding or if
+ the programmer explicitly grouped the operators like this.
+ The former can occur with e.g.
+
+ use constant FEATURE => ( $] >= ... );
+ sub { not FEATURE and return or do_stuff(); }
+ */
+ if (!first->op_folded && !(first->op_flags & OPf_PARENS))
+ Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+ "Possible precedence issue with control flow operator");
+ /* XXX: Should we optimze this to "return $a;" (i.e. remove
+ the "or $b" part)?
+ */
+ break;
+ }
+
if (type == OP_XOR) /* Not short circuit, but here by precedence. */
return newBINOP(type, flags, scalar(first), scalar(other));
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 5165599..7347969 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -4229,6 +4229,28 @@ higher precedence of C<==>. This is probably not what you want. (If you
really meant to write this, disable the warning, or, better, put the
parentheses explicitly and write C<$x & ($y == 0)>).
+=item Possible precedence issue with control flow operator
+
+(W syntax) There is a possible problem with the mixing of a control
+flow operator (e.g. C<return>) and a low-precedence operator like
+C<or>. Consider:
+
+ sub { return $a or $b; }
+
+This is parsed as:
+
+ sub { (return $a) or $b; }
+
+Which is effectively just:
+
+ sub { return $a; }
+
+Either use parentheses or the high-precedence variant of the operator.
+
+Note this may be also triggered for constructs like:
+
+ sub { 1 if die; }
+
=item Possible unintended interpolation of $\ in regex
(W ambiguous) You said something like C<m/$\/> in a regex.
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index c38bcde..7a5ae47 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -1575,3 +1575,40 @@ OPTION regex
?(?s).*
Subroutine DynaLoader::dl_error redefined at \(eval 2\) line 2\.
########
+# op.c
+use warnings;
+sub do_warn_1 { return $a or $b; }
+sub do_warn_2 { return $a and $b; }
+sub do_warn_3 { return $a xor $b; }
+sub do_warn_4 { die $a or $b; }
+sub do_warn_5 { die $a and $b; }
+sub do_warn_6 { die $a xor $b; }
+# These get re-written to "(return/die $a) and $b"
+sub do_warn_7 { $b if return $a; }
+sub do_warn_8 { $b if die $a; }
+
+use constant FEATURE => 1;
+use constant MISSING_FEATURE => 0;
+
+sub dont_warn_1 { return ($a or $b); }
+sub dont_warn_2 { return ($a and $b); }
+sub dont_warn_3 { return ($a xor $b); }
+
+sub dont_warn_4 { MISSING_FEATURE and return or dont_warn_3(); }
+sub dont_warn_5 { FEATURE || return and dont_warn_3(); }
+sub dont_warn_6 { not FEATURE and return or dont_warn_3(); }
+sub dont_warn_7 { !MISSING_FEATURE || return and dont_warn_3(); }
+
+# These are weird, but at least not ambiguous.
+sub dont_warn_8 { (return $a) or $b; }
+sub dont_warn_9 { (return $a) and $b; }
+sub dont_warn_10 { (return $a) xor $b; }
+EXPECT
+Possible precedence issue with control flow operator at - line 3.
+Possible precedence issue with control flow operator at - line 4.
+Possible precedence issue with control flow operator at - line 5.
+Possible precedence issue with control flow operator at - line 6.
+Possible precedence issue with control flow operator at - line 7.
+Possible precedence issue with control flow operator at - line 8.
+Possible precedence issue with control flow operator at - line 10.
+Possible precedence issue with control flow operator at - line 11.
--
1.7.10.4
|
From @cpansproutOn Wed Jul 17 12:37:07 2013, niels@thykier.net wrote:
Those patches look good. Thank you. Now we just have to wait for -- Father Chrysostomos |
From @xdgOn Wed, Jul 17, 2013 at 4:12 PM, Father Chrysostomos via RT
The patch is in the new Perl-Toolchain-Gang repo. I'll try to ship it tonight. David -- |
From @xdgParse-CPAN-Meta-1.4405.tar.gz has entered CPAN as file: $CPAN/authors/id/D/DA/ On Wed, Jul 17, 2013 at 4:59 PM, David Golden <xdg@xdg.me> wrote:
-- |
From @cpansproutOn Wed Jul 17 18:47:35 2013, xdg@xdg.me wrote:
Thank you. -- Father Chrysostomos |
From @nthykierOn 2013-07-17 22:12, Father Chrysostomos via RT wrote:
Revised warning patch attached with more tests. Thanks to Reini Urban ~Niels |
From @nthykier0002-op.c-Warn-on-return-a-or-b-perl-59802.patchFrom cb322ab05e51647edb4db431f1757b9631ef5001 Mon Sep 17 00:00:00 2001
From: Niels Thykier <niels@thykier.net>
Date: Mon, 15 Jul 2013 22:25:19 +0200
Subject: [PATCH 2/2] op.c: Warn on "return $a or $b" [perl #59802]
Add a warning for the (likely) unintended use of "return $a or $b"
(and similar expressions), which perl parses as "(return $a) || $b"
(which is effectively just "return $a;").
Note this warning is triggered by some modules (e.g. Test::Builder).
These are not fixed by this commit.
Signed-off-by: Niels Thykier <niels@thykier.net>
---
op.c | 38 ++++++++++++++++++
pod/perldiag.pod | 22 ++++++++++
t/lib/warnings/op | 115 +++++++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 175 insertions(+)
diff --git a/op.c b/op.c
index a9ee2d1..0459968 100644
--- a/op.c
+++ b/op.c
@@ -5830,6 +5830,44 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
first = *firstp;
other = *otherp;
+ /* [perl #59802]: Warn about things like "return $a or $b", which
+ is parsed as "(return $a) or $b" rather than "return ($a or
+ $b)". NB: This also applies to xor, which is why we do it
+ here.
+ */
+ switch (first->op_type) {
+ case OP_NEXT:
+ case OP_LAST:
+ case OP_REDO:
+ /* XXX: Perhaps we should emit a stronger warning for these.
+ Even with the high-precedence operator they don't seem to do
+ anything sensible.
+
+ But until we do, fall through here.
+ */
+ case OP_RETURN:
+ case OP_EXIT:
+ case OP_DIE:
+ case OP_GOTO:
+ /* XXX: Currently we allow people to "shoot themselves in the
+ foot" by explicitly writing "(return $a) or $b".
+
+ Warn unless we are looking at the result from folding or if
+ the programmer explicitly grouped the operators like this.
+ The former can occur with e.g.
+
+ use constant FEATURE => ( $] >= ... );
+ sub { not FEATURE and return or do_stuff(); }
+ */
+ if (!first->op_folded && !(first->op_flags & OPf_PARENS))
+ Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+ "Possible precedence issue with control flow operator");
+ /* XXX: Should we optimze this to "return $a;" (i.e. remove
+ the "or $b" part)?
+ */
+ break;
+ }
+
if (type == OP_XOR) /* Not short circuit, but here by precedence. */
return newBINOP(type, flags, scalar(first), scalar(other));
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 5165599..7347969 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -4229,6 +4229,28 @@ higher precedence of C<==>. This is probably not what you want. (If you
really meant to write this, disable the warning, or, better, put the
parentheses explicitly and write C<$x & ($y == 0)>).
+=item Possible precedence issue with control flow operator
+
+(W syntax) There is a possible problem with the mixing of a control
+flow operator (e.g. C<return>) and a low-precedence operator like
+C<or>. Consider:
+
+ sub { return $a or $b; }
+
+This is parsed as:
+
+ sub { (return $a) or $b; }
+
+Which is effectively just:
+
+ sub { return $a; }
+
+Either use parentheses or the high-precedence variant of the operator.
+
+Note this may be also triggered for constructs like:
+
+ sub { 1 if die; }
+
=item Possible unintended interpolation of $\ in regex
(W ambiguous) You said something like C<m/$\/> in a regex.
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index c38bcde..d858f32 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -1575,3 +1575,118 @@ OPTION regex
?(?s).*
Subroutine DynaLoader::dl_error redefined at \(eval 2\) line 2\.
########
+# op.c
+use warnings;
+sub do_warn_1 { return $a or $b; }
+sub do_warn_2 { return $a and $b; }
+sub do_warn_3 { return $a xor $b; }
+sub do_warn_4 { die $a or $b; }
+sub do_warn_5 { die $a and $b; }
+sub do_warn_6 { die $a xor $b; }
+sub do_warn_7 { exit $a or $b; }
+sub do_warn_8 { exit $a and $b; }
+sub do_warn_9 { exit $a xor $b; }
+
+# Since exit is an unary operator, it is even stronger than
+# || and &&.
+sub do_warn_10 { exit $a || $b; }
+sub do_warn_11 { exit $a && $b; }
+
+sub do_warn_12 { goto $a or $b; }
+sub do_warn_13 { goto $a and $b; }
+sub do_warn_14 { goto $a xor $b; }
+sub do_warn_15 { next $a or $b while(1); }
+sub do_warn_16 { next $a and $b while(1); }
+sub do_warn_17 { next $a xor $b while(1); }
+sub do_warn_18 { last $a or $b while(1); }
+sub do_warn_19 { last $a and $b while(1); }
+sub do_warn_20 { last $a xor $b while(1); }
+sub do_warn_21 { redo $a or $b while(1); }
+sub do_warn_22 { redo $a and $b while(1); }
+sub do_warn_23 { redo $a xor $b while(1); }
+# These get re-written to "(return/die $a) and $b"
+sub do_warn_24 { $b if return $a; }
+sub do_warn_25 { $b if die $a; }
+EXPECT
+Possible precedence issue with control flow operator at - line 3.
+Possible precedence issue with control flow operator at - line 4.
+Possible precedence issue with control flow operator at - line 5.
+Possible precedence issue with control flow operator at - line 6.
+Possible precedence issue with control flow operator at - line 7.
+Possible precedence issue with control flow operator at - line 8.
+Possible precedence issue with control flow operator at - line 9.
+Possible precedence issue with control flow operator at - line 10.
+Possible precedence issue with control flow operator at - line 11.
+Possible precedence issue with control flow operator at - line 15.
+Possible precedence issue with control flow operator at - line 16.
+Possible precedence issue with control flow operator at - line 18.
+Possible precedence issue with control flow operator at - line 19.
+Possible precedence issue with control flow operator at - line 20.
+Possible precedence issue with control flow operator at - line 21.
+Possible precedence issue with control flow operator at - line 22.
+Possible precedence issue with control flow operator at - line 23.
+Possible precedence issue with control flow operator at - line 24.
+Possible precedence issue with control flow operator at - line 25.
+Possible precedence issue with control flow operator at - line 26.
+Possible precedence issue with control flow operator at - line 27.
+Possible precedence issue with control flow operator at - line 28.
+Possible precedence issue with control flow operator at - line 29.
+Possible precedence issue with control flow operator at - line 31.
+Possible precedence issue with control flow operator at - line 32.
+########
+# op.c
+# (same as above, except these should not warn)
+use constant FEATURE => 1;
+use constant MISSING_FEATURE => 0;
+
+sub dont_warn_1 { MISSING_FEATURE and return or dont_warn_3(); }
+sub dont_warn_2 { FEATURE || return and dont_warn_3(); }
+sub dont_warn_3 { not FEATURE and return or dont_warn_3(); }
+sub dont_warn_4 { !MISSING_FEATURE || return and dont_warn_3(); }
+sub dont_warn_5 { MISSING_FEATURE and die or dont_warn_3(); }
+sub dont_warn_6 { FEATURE || die and dont_warn_3(); }
+sub dont_warn_7 { not FEATURE and die or dont_warn_3(); }
+sub dont_warn_8 { !MISSING_FEATURE || die and dont_warn_3(); }
+sub dont_warn_9 { MISSING_FEATURE and goto $a or dont_warn_3(); }
+sub dont_warn_10 { FEATURE || goto $a and dont_warn_3(); }
+sub dont_warn_11 { not FEATURE and goto $a or dont_warn_3(); }
+sub dont_warn_12 { !MISSING_FEATURE || goto $a and dont_warn_3(); }
+
+sub dont_warn_13 { MISSING_FEATURE and exit $a or dont_warn_3(); }
+sub dont_warn_14 { FEATURE || exit $a and dont_warn_3(); }
+sub dont_warn_15 { not FEATURE and exit $a or dont_warn_3(); }
+sub dont_warn_16 { !MISSING_FEATURE || exit $a and dont_warn_3(); }
+
+sub dont_warn_17 { MISSING_FEATURE and next or dont_warn_3() while(1); }
+sub dont_warn_18 { FEATURE || next and dont_warn_3() while(1); }
+sub dont_warn_19 { not FEATURE and next or dont_warn_3() while(1); }
+sub dont_warn_20 { !MISSING_FEATURE || next and dont_warn_3() while(1); }
+sub dont_warn_21 { MISSING_FEATURE and redo or dont_warn_3() while(1); }
+sub dont_warn_22 { FEATURE || redo and dont_warn_3() while(1); }
+sub dont_warn_23 { not FEATURE and redo or dont_warn_3() while(1); }
+sub dont_warn_24 { !MISSING_FEATURE || redo and dont_warn_3() while(1); }
+sub dont_warn_25 { MISSING_FEATURE and last or dont_warn_3() while(1); }
+sub dont_warn_26 { FEATURE || last and dont_warn_3() while(1); }
+sub dont_warn_27 { not FEATURE and last or dont_warn_3() while(1); }
+sub dont_warn_28 { !MISSING_FEATURE || last and dont_warn_3() while(1); }
+
+# These are weird, but at least not ambiguous.
+sub dont_warn_29 { return ($a or $b); }
+sub dont_warn_30 { return ($a and $b); }
+sub dont_warn_31 { return ($a xor $b); }
+sub dont_warn_32 { die ($a or $b); }
+sub dont_warn_33 { die ($a and $b); }
+sub dont_warn_34 { die ($a xor $b); }
+sub dont_warn_35 { goto ($a or $b); }
+sub dont_warn_36 { goto ($a and $b); }
+sub dont_warn_37 { goto ($a xor $b); }
+sub dont_warn_38 { next ($a or $b) while(1); }
+sub dont_warn_39 { next ($a and $b) while(1); }
+sub dont_warn_40 { next ($a xor $b) while(1); }
+sub dont_warn_41 { last ($a or $b) while(1); }
+sub dont_warn_42 { last ($a and $b) while(1); }
+sub dont_warn_43 { last ($a xor $b) while(1); }
+sub dont_warn_44 { redo ($a or $b) while(1); }
+sub dont_warn_45 { redo ($a and $b) while(1); }
+sub dont_warn_46 { redo ($a xor $b) while(1); }
+EXPECT
--
1.7.10.4
|
From @rurbanOn Thu, Jul 18, 2013 at 6:05 PM, Niels Thykier <niels@thykier.net> wrote:
LGTM. These are the bugs we found so far: Perl-Critic [cpan #87032] wrong return precedence in JSON-PP (no ticket yet) I needed the following patch to extend B for folded (and the other And the 2nd patch is a hint for the upstream maintainers. When I fixed all B modules to use the new B, we can get rid of -- |
From @rurban0001-more-op_folded-support-B-dump.patchFrom 9c97840a3a4c7538643548513ff282fb21a3ecde Mon Sep 17 00:00:00 2001
From: Reini Urban <rurban@x-ray.at>
Date: Thu, 18 Jul 2013 14:50:35 -0500
Subject: [PATCH 1/2] more op_folded support: B, dump
also add more B::OP accessors for the missing bitfields
---
dump.c | 5 +++--
ext/B/B.xs | 28 ++++++++++++++++++++++++++--
op.h | 2 ++
3 files changed, 31 insertions(+), 4 deletions(-)
diff --git a/dump.c b/dump.c
index 6ba4fd2..4720e30 100644
--- a/dump.c
+++ b/dump.c
@@ -861,13 +861,14 @@ S_op_private_to_names(pTHX_ SV *tmpsv, U32 optype, U32 op_private) {
if (o->op_slabbed) sv_catpvs(tmpsv, ",SLABBED"); \
if (o->op_savefree) sv_catpvs(tmpsv, ",SAVEFREE"); \
if (o->op_static) sv_catpvs(tmpsv, ",STATIC"); \
- if (!xml) \
+ if (o->op_folded) sv_catpvs(tmpsv, ",FOLDED"); \
+ if (!xml) \
Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", \
SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");\
else \
PerlIO_printf(file, " flags=\"%s\"", \
SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : ""); \
- SvREFCNT_dec_NN(tmpsv); \
+ SvREFCNT_dec_NN(tmpsv); \
}
#if !defined(PERL_MAD)
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 0b2ecae..a17f876 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -670,7 +670,7 @@ struct OP_methods {
STR_WITH_LEN("targ"), PADOFFSETp, offsetof(struct op, op_targ), /* 2*/
STR_WITH_LEN("flags"), U8p, offsetof(struct op, op_flags), /* 3*/
STR_WITH_LEN("private"), U8p, offsetof(struct op, op_private), /* 4*/
- STR_WITH_LEN("first"), OPp, offsetof(struct unop, op_first), /* 5*/
+ STR_WITH_LEN("first"), OPp, offsetof(struct unop, op_first), /* 5*/
STR_WITH_LEN("last"), OPp, offsetof(struct binop, op_last), /* 6*/
STR_WITH_LEN("other"), OPp, offsetof(struct logop, op_other), /* 7*/
STR_WITH_LEN("pmreplstart"), 0, -1, /* 8*/
@@ -730,6 +730,14 @@ struct OP_methods {
STR_WITH_LEN("warnings"),0, -1, /*44*/
STR_WITH_LEN("io"), 0, -1, /*45*/
STR_WITH_LEN("hints_hash"),0, -1, /*46*/
+#if PERL_VERSION >= 17
+ STR_WITH_LEN("slabbed"), 0, -1, /*47*/
+ STR_WITH_LEN("savefree"),0, -1, /*48*/
+ STR_WITH_LEN("static"), 0, -1, /*49*/
+#if PERL_VERSION >= 19
+ STR_WITH_LEN("folded"), 0, -1, /*50*/
+#endif
+#endif
};
#include "const-c.inc"
@@ -1001,6 +1009,10 @@ next(o)
B::COP::warnings = 44
B::COP::io = 45
B::COP::hints_hash = 46
+ B::OP::slabbed = 47
+ B::OP::savefree = 48
+ B::OP::static = 49
+ B::OP::folded = 50
PREINIT:
char *ptr;
SV *ret;
@@ -1076,10 +1088,22 @@ next(o)
case 30: /* type */
case 31: /* opt */
case 32: /* spare */
- /* These 3 are all bitfields, so we can't take their addresses */
+#if PERL_VERSION >= 17
+ case 47: /* slabbed */
+ case 48: /* savefree */
+ case 49: /* static */
+#if PERL_VERSION >= 19
+ case 50: /* folded */
+#endif
+#endif
+ /* These are all bitfields, so we can't take their addresses */
ret = sv_2mortal(newSVuv((UV)(
ix == 30 ? o->op_type
: ix == 31 ? o->op_opt
+ : ix == 47 ? o->op_slabbed
+ : ix == 48 ? o->op_savefree
+ : ix == 49 ? o->op_static
+ : ix == 50 ? o->op_folded
: o->op_spare)));
break;
case 33: /* children */
diff --git a/op.h b/op.h
index dcfd5be..ffb7178 100644
--- a/op.h
+++ b/op.h
@@ -656,6 +656,8 @@ struct loop {
# define OpREFCNT_dec(o) (--(o)->op_targ)
#endif
+#define OpFOLDED(o) ((o)->type == OP_CONST ? (o)->op_private & OPpCONST_FOLDED : (o)->op_folded)
+
/* flags used by Perl_load_module() */
#define PERL_LOADMOD_DENY 0x1 /* no Module */
#define PERL_LOADMOD_NOIMPORT 0x2 /* use Module () */
--
1.8.3.1
|
From @rurban0002-External-TODOs-for-59802-cpan-JSON-PP-cpan-Test-Simp.patchFrom 72758296adbd0c6b838d1a041381b5954bacecd1 Mon Sep 17 00:00:00 2001
From: Reini Urban <rurban@x-ray.at>
Date: Thu, 18 Jul 2013 11:00:57 -0500
Subject: [PATCH 2/2] External TODOs for #59802 cpan/JSON-PP, cpan/Test-Simple
---
cpan/JSON-PP/lib/JSON/PP.pm | 2 +-
cpan/Test-Simple/lib/Test/Builder.pm | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/cpan/JSON-PP/lib/JSON/PP.pm b/cpan/JSON-PP/lib/JSON/PP.pm
index e9e65b1..12b7d51 100644
--- a/cpan/JSON-PP/lib/JSON/PP.pm
+++ b/cpan/JSON-PP/lib/JSON/PP.pm
@@ -1564,7 +1564,7 @@ sub _incr_parse {
$self->{incr_text} = substr( $self->{incr_text}, $p );
$self->{incr_p} = 0;
- return $obj or '';
+ return $obj || '';
}
diff --git a/cpan/Test-Simple/lib/Test/Builder.pm b/cpan/Test-Simple/lib/Test/Builder.pm
index cb4335f..18e90f5 100644
--- a/cpan/Test-Simple/lib/Test/Builder.pm
+++ b/cpan/Test-Simple/lib/Test/Builder.pm
@@ -915,7 +915,7 @@ sub _is_dualvar {
no warnings 'numeric';
my $numval = $val + 0;
- return $numval != 0 and $numval ne $val ? 1 : 0;
+ return ($numval != 0 and $numval ne $val) ? 1 : 0;
}
=item B<is_eq>
--
1.8.3.1
|
From @nthykierOn 2013-07-19 06:22, Reini Urban wrote:
Great. :)
I believe these are filed: * https://rt.cpan.org/Public/Bug/Display.html?id=86948
Sounds good to me. :) ~Niels |
From @rurbanCPAN updates on this after the night run: + DBI [cpan #87029] (fixed) * Perl-Critic [cpan #87032] all patches also in my distroprefs: |
From @cpansproutOn Wed Jul 17 12:37:07 2013, niels@thykier.net wrote:
Thank you. I have applied the op_folded patch as 3513c74. The warning patch will again have to wait, as your more thorough version -- Father Chrysostomos |
From @cpansproutOn Thu Jul 18 21:23:27 2013, rurban wrote:
Thank you. I have applied the first patch as 3164fde, but I -- Father Chrysostomos |
From @rurbanOn Fri, Jul 19, 2013 at 12:30 PM, Father Chrysostomos via RT
Thanks and I'm fine with that. It thought it's a cool API for the time So missing are: commit 715975678ef3c57515eb6282cdaab53da6afbb46 op.c: Warn on "return $a or $b" [perl #59802] Add a warning for the (likely) unintended use of "return $a or $b" Note this warning is triggered by some modules (e.g. Test::Builder). Signed-off-by: Niels Thykier <niels@thykier.net> commit c1f7aff8b732c59411569240ce4ffc7a83080e33 Return B::HEK for B::CV::GV of lexical subs A lexsub has a hek instead of a gv. -- |
From @rjbs* Niels Thykier <niels@thykier.net> [2013-07-16T04:58:01]
Thanks, Niels, this warning is something I'm very happy to see finally -- |
From @cpansproutOn Mon Jul 22 14:59:51 2013, perl.p5p@rjbs.manxome.org wrote:
This is currently blocked by Test::Builder. If we are to have this Would it be acceptable to break the usual rule and patch Test::Builder -- Father Chrysostomos |
From @rjbs* Father Chrysostomos via RT <perlbug-followup@perl.org> [2013-08-20T11:51:46]
I've just poked Schwern both via GitHub and another channel. Let's give him a -- |
From @rjbs* Ricardo Signes <perl.p5p@rjbs.manxome.org> [2013-08-22T22:17:24]
FWIW, Schwern is now AFK for a week or so. -- |
From @cpansproutOn Sun Aug 25 21:28:46 2013, perl.p5p@rjbs.manxome.org wrote:
What does AFK stand for? Asking for kippers? -- Father Chrysostomos |
From @TuxOn Mon, 26 Aug 2013 00:09:12 -0700, "Father Chrysostomos via RT"
Away From Keyboard http://www.acronymfinder.com/Away-From-Keyboard-(AFK).html -- |
From @rurbanOn Tue, Aug 20, 2013 at 10:51 AM, Father Chrysostomos via RT
All possible CPAN bugs have already been reported by smoking See http://blogs.perl.org/users/rurban/2013/07/smoking-cpan.html
-- |
From @cpansproutOn Thu Aug 22 19:17:59 2013, perl.p5p@rjbs.manxome.org wrote:
I have applied Niels’ warning patch now as 9da2d04 (thank you). I have opened ticket #119825 to track this. -- Father Chrysostomos |
@cpansprout - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#59802 (status was 'resolved')
Searchable as RT59802$
The text was updated successfully, but these errors were encountered: