Browse Source

* 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 -

Jonas Maebe 13 years ago
parent
commit
d1acb76df8
4 changed files with 126 additions and 7 deletions
  1. 1 0
      .gitattributes
  2. 6 3
      compiler/nadd.pas
  3. 7 4
      compiler/ncon.pas
  4. 112 0
      tests/webtbs/tw21255.pp

+ 1 - 0
.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

+ 6 - 3
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

+ 7 - 4
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;
 
 

+ 112 - 0
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.