paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 07:39:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* when comparing two boolean values, convert both to pasbool8 so

Browse Source 
that in case of byte/word/long/qwordbool, different "true"
    values all get mapped to true (mantis #20257)

git-svn-id: trunk@19737 -
This commit is contained in:
Jonas Maebe 2011-12-03 22:31:21 +00:00
parent f62e118f8e
commit e2b5ba756d
2 changed files with 95 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
compiler/nadd.pas
View File

@ -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,14 +1225,21 @@ implementation
end;
case nodetype of
xorn,
ltn,
lten,
gtn,
gten,
andn,
orn:
begin
end;
ltn,
lten,
gtn,
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:
begin
@ -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

91
tests/webtbs/tw20257.pp
View File

@ -1,14 +1,81 @@
program bool_compare_bug;
{$APPTYPE CONSOLE}
{$IFDEF FPC}
{$MODESWITCH RESULT} // to avoid "BOOL(constant)" typecasts and stay compilable by Delphi & FPC
{$ENDIF}
program fpc_vs_delphi_bool_compatibility;
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);
//
(**********************************************************
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.