From d1acb76df8f93ce3f9a1de483ea096180367852c Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Fri, 9 Mar 2012 20:26:32 +0000
Subject: [PATCH] * don't replace "expr1 or expr1" or "expr1 and expr1" with
just "expr1" if expr1 has sideeffects. This can't be done safely even in
case of short boolean evaluation, because expr1 may return the inverse
the second time its called (and "0 or 1" is not the same as "0", and
neither is "1 and 0"), based on comment by Michael Karcher * perform a full
string compare when comparing stringconstnodes before the string constant
labels have been generated (patch by Michael Karcher, mantis #21255)
git-svn-id: trunk@20485 -
---
.gitattributes | 1 +
compiler/nadd.pas | 9 ++--
compiler/ncon.pas | 11 ++--
tests/webtbs/tw21255.pp | 112 ++++++++++++++++++++++++++++++++++++++++
4 files changed, 126 insertions(+), 7 deletions(-)
create mode 100644 tests/webtbs/tw21255.pp
diff --git a/.gitattributes b/.gitattributes
index a3b98e9593..a7d574e239 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -12233,6 +12233,7 @@ tests/webtbs/tw21146.pp svneol=native#text/pascal
tests/webtbs/tw21151.pp svneol=native#text/plain
tests/webtbs/tw21177.pp svneol=native#text/plain
tests/webtbs/tw21179.pp svneol=native#text/pascal
+tests/webtbs/tw21255.pp svneol=native#text/plain
tests/webtbs/tw2128.pp svneol=native#text/plain
tests/webtbs/tw2129.pp svneol=native#text/plain
tests/webtbs/tw2129b.pp svneol=native#text/plain
diff --git a/compiler/nadd.pas b/compiler/nadd.pas
index 328f3512c7..33f8478158 100644
--- a/compiler/nadd.pas
+++ b/compiler/nadd.pas
@@ -833,9 +833,12 @@ implementation
this simplification always
}
if is_boolean(left.resultdef) and is_boolean(right.resultdef) and
- { since the expressions might have sideeffects, we may only remove them
- if short boolean evaluation is turned on }
- (nf_short_bool in flags) then
+ { even when short circuit boolean evaluation is active, this
+ optimization cannot be performed in case the node has
+ side effects, because this can change the result (e.g., in an
+ or-node that calls the same function twice and first returns
+ false and then true because of a global state change }
+ not might_have_sideeffects(left) then
begin
if left.isequal(right) then
begin
diff --git a/compiler/ncon.pas b/compiler/ncon.pas
index ee8d1723b2..e25b9ff445 100644
--- a/compiler/ncon.pas
+++ b/compiler/ncon.pas
@@ -968,10 +968,13 @@ implementation
docompare :=
inherited docompare(p) and
(len = tstringconstnode(p).len) and
- { Don't compare the pchars, since they may contain null chars }
- { Since all equal constant strings are replaced by the same }
- { label, the following compare should be enough (JM) }
- (lab_str = tstringconstnode(p).lab_str);
+ (lab_str = tstringconstnode(p).lab_str) and
+ { This is enough as soon as labels are allocated, otherwise }
+ { fall back to content compare. }
+ (assigned(lab_str) or
+ (cst_type = tstringconstnode(p).cst_type) and
+ (fullcompare(tstringconstnode(p)) = 0))
+ ;
end;
diff --git a/tests/webtbs/tw21255.pp b/tests/webtbs/tw21255.pp
new file mode 100644
index 0000000000..9c0cb56f91
--- /dev/null
+++ b/tests/webtbs/tw21255.pp
@@ -0,0 +1,112 @@
+Program fpcbugcheck;
+
+{$mode macpas} { for | }
+
+Var
+ FrobCounter : Integer;
+
+const
+ ok: boolean = true;
+
+Function Frob : Boolean;
+begin
+ Inc(FrobCounter);
+ Frob := False;
+end;
+
+{
+ This program tests whether "Frob or Frob" is contracted to a single
+ "Frob" call, in different contexts:
+ - without shortcut evaluation (no contraction allowed)
+ - with shortcut evaluation enabled
+ - using the MacPas "|" instead of "or"
+ It prints the number of Frob calls for each variant.
+}
+
+{
+ The second test this program does is related to the first one,
+ it exercises a bug in fpc deeming all compares with string constants
+ to be equal at the stage of compilation the elision of duplicate expression
+ in bools is performed.
+
+ This bug has been active since the introduction of the boolean shortcut
+ optimization (r14714), but as that optimization only applies to the
+ explicit shortcut form (in form of the MacPas operators), that bug
+ didn't show.
+}
+
+{$B+}
+Procedure CountFrobsBoolFull;
+begin
+ FrobCounter := 0;
+ if Frob or Frob then
+ begin
+ WriteLn('Complete: Huh');
+ ok:=false;
+ end
+ else
+ begin
+ WriteLn('Complete: Frobbed ', FrobCounter, ' times');
+ if FrobCounter<>2 then
+ ok:=false;
+ end;
+end;
+
+{$B-}
+Procedure CountFrobsBoolShort;
+begin
+ FrobCounter := 0;
+ if Frob or Frob then
+ begin
+ WriteLn('Short: Huh');
+ ok:=false;
+ end
+ else
+ begin
+ WriteLn('Short: Frobbed ', FrobCounter, ' times');
+ if FrobCounter<>2 then
+ ok:=false;
+ end;
+end;
+
+Procedure CountFrobsMac;
+begin
+ FrobCounter := 0;
+ if Frob | Frob then
+ begin
+ WriteLn('Mac: Huh');
+ ok:=false;
+ end
+ else
+ begin
+ WriteLn('Mac: Frobbed ', FrobCounter, ' times');
+ if FrobCounter<>2 then
+ ok:=false;
+ end;
+end;
+
+var
+ test: String;
+{$B-}
+begin
+ ok:=true;
+ { test conditions for application of boolean contraction }
+ CountFrobsBoolFull;
+ CountFrobsBoolShort;
+ CountFrobsMac;
+ { test for faulty boolean contraction }
+ test:='b';
+ if (test='a') | (test='b') then
+ test := 'OK'
+ else
+ ok:=false;
+ if test <> 'OK' then WriteLn('Mac: fpc failed!');
+ test:='b';
+ if (test='a') or (test='b') then
+ test := 'OK'
+ else
+ ok:=false;
+ if test <> 'OK' then WriteLn('Short: fpc failed!');
+ if not ok then
+ halt(1);
+end.