Browse Source

* 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 -

yury 17 years ago
parent
commit
771479e65c

+ 0 - 1
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);

+ 0 - 1
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);

+ 5 - 1
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;
 
 

+ 0 - 1
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);

+ 0 - 1
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);

+ 0 - 1
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);

+ 24 - 11
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.