From 771479e65c8a966b6b9ed6c1639ccac78e405272 Mon Sep 17 00:00:00 2001 From: yury Date: Tue, 15 Apr 2008 22:19:29 +0000 Subject: [PATCH] * Improved fix for bug #10233 for better Delphi compatibility and efficiency: - 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 - --- compiler/arm/narmcnv.pas | 1 - compiler/m68k/n68kcnv.pas | 1 - compiler/ncgcnv.pas | 6 +++++- compiler/ppcgen/ngppccnv.pas | 1 - compiler/sparc/ncpucnv.pas | 1 - compiler/x86/nx86cnv.pas | 1 - tests/webtbs/tw10233.pp | 35 ++++++++++++++++++++++++----------- 7 files changed, 29 insertions(+), 17 deletions(-) diff --git a/compiler/arm/narmcnv.pas b/compiler/arm/narmcnv.pas index fa17de0fc6..bee3c7683f 100644 --- a/compiler/arm/narmcnv.pas +++ b/compiler/arm/narmcnv.pas @@ -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); diff --git a/compiler/m68k/n68kcnv.pas b/compiler/m68k/n68kcnv.pas index 72856f3ad6..dfcf07c0a1 100644 --- a/compiler/m68k/n68kcnv.pas +++ b/compiler/m68k/n68kcnv.pas @@ -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); diff --git a/compiler/ncgcnv.pas b/compiler/ncgcnv.pas index 8820e01d66..6807363b72 100644 --- a/compiler/ncgcnv.pas +++ b/compiler/ncgcnv.pas @@ -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; diff --git a/compiler/ppcgen/ngppccnv.pas b/compiler/ppcgen/ngppccnv.pas index d8c0af1fb9..2dc96db408 100644 --- a/compiler/ppcgen/ngppccnv.pas +++ b/compiler/ppcgen/ngppccnv.pas @@ -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); diff --git a/compiler/sparc/ncpucnv.pas b/compiler/sparc/ncpucnv.pas index 501f5f90b4..5814c143ad 100644 --- a/compiler/sparc/ncpucnv.pas +++ b/compiler/sparc/ncpucnv.pas @@ -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); diff --git a/compiler/x86/nx86cnv.pas b/compiler/x86/nx86cnv.pas index cb5b04a9b5..b5f6085ade 100644 --- a/compiler/x86/nx86cnv.pas +++ b/compiler/x86/nx86cnv.pas @@ -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); diff --git a/tests/webtbs/tw10233.pp b/tests/webtbs/tw10233.pp index bdfbaf9fc1..edd3c9b0b6 100644 --- a/tests/webtbs/tw10233.pp +++ b/tests/webtbs/tw10233.pp @@ -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.