paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 13:30:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Improved fix for bug #10233 for better Delphi compatibility and efficiency:

Browse Source 
- Explicit typecasts like LongBool(byte_value) do not change ordinal value.
  - Explicit typecasts like ByteBool(longint_value) do not change ordinal value and can lead to data loss if longint_value is outside of ByteBool range.
  - Explicit typecasts like ByteBool(LongBool) handle type ranges correctly.
  - Updated test tw10233.pp. It is passed by Delphi as well.

git-svn-id: trunk@10672 -
This commit is contained in:
yury 2008-04-15 22:19:29 +00:00
parent 683f59a70c
commit 771479e65c
7 changed files with 29 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
compiler/arm/narmcnv.pas
View File

@ -194,7 +194,6 @@ implementation
{ Explicit typecasts from any ordinal type to a boolean type }
{ must not change the ordinal value }
if (nf_explicit in flags) and
(left.resultdef.size=resultdef.size) and
not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
begin
location_copy(location,left.location);

1
compiler/m68k/n68kcnv.pas
View File

@ -168,7 +168,6 @@ implementation
{ Explicit typecasts from any ordinal type to a boolean type }
{ must not change the ordinal value }
if (nf_explicit in flags) and
(left.resultdef.size=resultdef.size) and
not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
begin
location_copy(location,left.location);

6
compiler/ncgcnv.pas
View File

@ -446,7 +446,11 @@ interface
is_cbool(left.resultdef)) then
second_bool_to_int
else
second_int_to_bool
begin
{ remove nf_explicit to perform full conversion }
exclude(flags, nf_explicit);
second_int_to_bool;
end;
end;

1
compiler/ppcgen/ngppccnv.pas
View File

@ -89,7 +89,6 @@ implementation
{ Explicit typecasts from any ordinal type to a boolean type }
{ must not change the ordinal value }
if (nf_explicit in flags) and
(left.resultdef.size=resultdef.size) and
not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
begin
location_copy(location,left.location);

1
compiler/sparc/ncpucnv.pas
View File

@ -237,7 +237,6 @@ implementation
{ Explicit typecasts from any ordinal type to a boolean type }
{ must not change the ordinal value }
if (nf_explicit in flags) and
(left.resultdef.size=resultdef.size) and
not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
begin
location_copy(location,left.location);

1
compiler/x86/nx86cnv.pas
View File

@ -106,7 +106,6 @@ implementation
{ Explicit typecasts from any ordinal type to a boolean type }
{ must not change the ordinal value }
if (nf_explicit in flags) and
(left.resultdef.size=resultdef.size) and
not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
begin
location_copy(location,left.location);

35
tests/webtbs/tw10233.pp
View File

@ -2,29 +2,42 @@ var
i: Byte;
w: word;
l: cardinal;
{$ifdef FPC}
g: qword;
{$endif FPC}
begin
i := 128;
if Byte(ByteBool(i))<>128 then
i := $80;
if Byte(ByteBool(i))<>$80 then
halt(1);
w := 32768;
if Word(WordBool(w))<>32768 then
if Word(WordBool(i))<>$80 then
halt(11);
if LongInt(LongBool(i))<>$80 then
halt(12);
w := $8000;
if Word(WordBool(w))<>$8000 then
halt(2);
l := $80000000;
if Cardinal(LongBool(l))<>$80000000 then
halt(3);
{$ifdef FPC}
g := qword($8000000000000000);
if qword(qwordBool(g))<>qword($8000000000000000) then
halt(4);
{$endif FPC}
if Byte(ByteBool(w))<>high(byte) then
if Byte(ByteBool(WordBool(w)))<>high(byte) then
halt(5);
if Word(WordBool(l))<>high(word) then
if Byte(ByteBool(w))<>0 then
halt(51);
if Word(WordBool(LongBool(l)))<>high(word) then
halt(6);
l := $80000000;
if Cardinal(LongBool(g))<>high(cardinal) then
if Word(WordBool(l))<>0 then
halt(61);
{$ifdef FPC}
if Cardinal(LongBool(qwordBool(g)))<>high(cardinal) then
halt(7);
g := qword($8000000000000000);
if qword(qwordBool(i))<>high(qword) then
halt(8);
if Cardinal(LongBool(g))<>0 then
halt(7);
{$endif FPC}
writeln('Test OK.');
end.