Browse Source

* when comparing two boolean values, convert both to pasbool8 so
that in case of byte/word/long/qwordbool, different "true"
values all get mapped to true (mantis #20257)

git-svn-id: trunk@19737 -

Jonas Maebe 13 years ago
parent
commit
e2b5ba756d
2 changed files with 95 additions and 18 deletions
  1. 15 5
      compiler/nadd.pas
  2. 80 13
      tests/webtbs/tw20257.pp

+ 15 - 5
compiler/nadd.pas

@@ -1207,8 +1207,7 @@ implementation
                 end;
 
              { 2 booleans? Make them equal to the largest boolean }
-             if (is_boolean(ld) and is_boolean(rd)) or
-                (nf_short_bool in flags) then
+             if (is_boolean(ld) and is_boolean(rd)) then
               begin
                 if (torddef(left.resultdef).size>torddef(right.resultdef).size) or
                    (is_cbool(left.resultdef) and not is_cbool(right.resultdef)) then
@@ -1226,13 +1225,20 @@ implementation
                  end;
                 case nodetype of
                   xorn,
+                  andn,
+                  orn:
+                    begin
+                    end;
                   ltn,
                   lten,
                   gtn,
-                  gten,
-                  andn,
-                  orn:
+                  gten:
                     begin
+                      { convert both to pasbool to perform the comparison (so
+                        that longbool(4) = longbool(2), since both represent
+                        "true" }
+                      inserttypeconv(left,pasbool8type);
+                      inserttypeconv(right,pasbool8type);
                     end;
                   unequaln,
                   equaln:
@@ -1274,6 +1280,10 @@ implementation
                             exit;
                           end;
                        end;
+                      { Delphi-compatibility: convert both to pasbool to
+                        perform the equality comparison }
+                      inserttypeconv(left,pasbool8type);
+                      inserttypeconv(right,pasbool8type);
                     end;
                   else
                     begin

+ 80 - 13
tests/webtbs/tw20257.pp

@@ -1,14 +1,81 @@
-program bool_compare_bug;
-
-var test_for_0:integer;
-      expect:bytebool;
-begin // test 1 -- passed
-      test_for_0:=1;
-      expect:=false;
-      if (test_for_0=0)=expect then writeln('> pass')else halt(1);
-      // test 2 -- FAILED! [bug]
-      test_for_0:=0;
-      expect:=true;
-      if (test_for_0=0)=expect then writeln('> pass')else halt(2);
-      //
+{$APPTYPE CONSOLE}
+{$IFDEF FPC}
+ {$MODESWITCH RESULT} // to avoid "BOOL(constant)" typecasts and stay compilable by Delphi & FPC
+{$ENDIF}
+program fpc_vs_delphi_bool_compatibility;
+
+(**********************************************************
+ 
+  TEST STUB for the real function from Windows API
+
+ **********************************************************)
+type  BOOL = longbool; {to avoid linking to WINDOWS unit}
+      INT  = longint;  {to avoid linking to WINDOWS unit}
+      TExpectedResult=(R_VISIBLE,R_INVISIBLE,R_BAD_PARAM);
+
+function PtVisible(test_return:TExpectedResult):BOOL;
+(*
+
+ MSDN definition:
+~~~~~~~~~~~~~~~~~~
+ The PtVisible function determines whether the specified point is within the clipping region of a device context. 
+ 
+ BOOL PtVisible(
+   HDC hdc, // handle to DC
+   int X,   // x-coordinate of point
+   int Y    // y-coordinate of point
+ );
+
+ Return Values:
+
+ If the specified point is within the clipping region of the device context, the return value is TRUE(1).
+
+ If the specified point is not within the clipping region of the device context, the return value is FALSE(0).
+
+ If the hdc is not valid, the return value is (BOOL)-1. 
+
+*)
+begin
+  case test_return of
+    R_VISIBLE   :
+      INT(result):= 1;
+    R_INVISIBLE :
+      INT(result):= 0;
+    else
+      INT(result):=-1;
+  end;
+end;
+
+(**********************************************************
+ 
+  Real test
+
+ **********************************************************)
+type  TBool = BOOL;
+   (* TBool = boolean; {-- doesn't matter, in FPC fails as well..}*)
+
+function test_visible(test_return:TExpectedResult;expected_result:TBool):TBool;
+begin
+  result:=(PtVisible(test_return)=expected_result);
+end;
+
+begin
+  if test_visible(R_VISIBLE,true) then
+    writeln('pass')
+  else
+    begin
+      writeln('fail');
+      halt(1);
+    end;
+    { Delphi: pass
+      FPC:    fail }
+  if (PtVisible(R_VISIBLE)>PtVisible(R_BAD_PARAM)) or
+     (PtVisible(R_VISIBLE)<PtVisible(R_BAD_PARAM)) then
+    begin
+      { don't treat two different values for longbool as
+        different if both mean "true" }
+      writeln('fail 2');
+      halt(2);
+    end;
 end.
+