mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 12:49:09 +02:00
* 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 -
This commit is contained in:
parent
f62e118f8e
commit
e2b5ba756d
@ -1207,8 +1207,7 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
{ 2 booleans? Make them equal to the largest boolean }
|
{ 2 booleans? Make them equal to the largest boolean }
|
||||||
if (is_boolean(ld) and is_boolean(rd)) or
|
if (is_boolean(ld) and is_boolean(rd)) then
|
||||||
(nf_short_bool in flags) then
|
|
||||||
begin
|
begin
|
||||||
if (torddef(left.resultdef).size>torddef(right.resultdef).size) or
|
if (torddef(left.resultdef).size>torddef(right.resultdef).size) or
|
||||||
(is_cbool(left.resultdef) and not is_cbool(right.resultdef)) then
|
(is_cbool(left.resultdef) and not is_cbool(right.resultdef)) then
|
||||||
@ -1226,14 +1225,21 @@ implementation
|
|||||||
end;
|
end;
|
||||||
case nodetype of
|
case nodetype of
|
||||||
xorn,
|
xorn,
|
||||||
ltn,
|
|
||||||
lten,
|
|
||||||
gtn,
|
|
||||||
gten,
|
|
||||||
andn,
|
andn,
|
||||||
orn:
|
orn:
|
||||||
begin
|
begin
|
||||||
end;
|
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,
|
unequaln,
|
||||||
equaln:
|
equaln:
|
||||||
begin
|
begin
|
||||||
@ -1274,6 +1280,10 @@ implementation
|
|||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
{ Delphi-compatibility: convert both to pasbool to
|
||||||
|
perform the equality comparison }
|
||||||
|
inserttypeconv(left,pasbool8type);
|
||||||
|
inserttypeconv(right,pasbool8type);
|
||||||
end;
|
end;
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
|
@ -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 STUB for the real function from Windows API
|
||||||
test_for_0:=1;
|
|
||||||
expect:=false;
|
**********************************************************)
|
||||||
if (test_for_0=0)=expect then writeln('> pass')else halt(1);
|
type BOOL = longbool; {to avoid linking to WINDOWS unit}
|
||||||
// test 2 -- FAILED! [bug]
|
INT = longint; {to avoid linking to WINDOWS unit}
|
||||||
test_for_0:=0;
|
TExpectedResult=(R_VISIBLE,R_INVISIBLE,R_BAD_PARAM);
|
||||||
expect:=true;
|
|
||||||
if (test_for_0=0)=expect then writeln('> pass')else halt(2);
|
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.
|
end.
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user