Forráskód Böngészése

* correctly handle LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF in second_int_to_bool, resolves issue #28007

git-svn-id: trunk@30765 -
florian 10 éve
szülő
commit
b222d0b663

+ 1 - 0
.gitattributes

@@ -14417,6 +14417,7 @@ tests/webtbs/tw2788.pp svneol=native#text/plain
 tests/webtbs/tw27880.pp svneol=native#text/plain
 tests/webtbs/tw2789.pp svneol=native#text/plain
 tests/webtbs/tw2794.pp svneol=native#text/plain
+tests/webtbs/tw28007.pp svneol=native#text/pascal
 tests/webtbs/tw2803.pp svneol=native#text/plain
 tests/webtbs/tw2806.pp svneol=native#text/plain
 tests/webtbs/tw2807.pp svneol=native#text/plain

+ 4 - 0
compiler/aarch64/ncpucnv.pas

@@ -163,6 +163,10 @@ implementation
        exit;
 
       case left.location.loc of
+        LOC_SUBSETREG,
+        LOC_CSUBSETREG,
+        LOC_SUBSETREF,
+        LOC_CSUBSETREF,
         LOC_CREFERENCE,
         LOC_REFERENCE,
         LOC_REGISTER,

+ 4 - 0
compiler/arm/narmcnv.pas

@@ -314,6 +314,10 @@ implementation
 
          { Load left node into flag F_NE/F_E }
          resflags:=F_NE;
+
+         if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then
+           hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+
          case left.location.loc of
             LOC_CREFERENCE,
             LOC_REFERENCE :

+ 4 - 0
compiler/m68k/n68kcnv.pas

@@ -199,6 +199,10 @@ implementation
 
          newsize:=def_cgsize(resultdef);
          opsize := def_cgsize(left.resultdef);
+
+        if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+
          case left.location.loc of
             LOC_CREFERENCE,LOC_REFERENCE :
               begin

+ 21 - 17
compiler/mips/ncpucnv.pas

@@ -207,26 +207,30 @@ begin
   if codegenerror then
     exit;
 
-         { Explicit typecasts from any ordinal type to a boolean type }
-         { must not change the ordinal value                          }
-         if (nf_explicit in flags) and
-            not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
-           begin
-              location_copy(location,left.location);
-              newsize:=def_cgsize(resultdef);
-              { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }
-              if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or
-                 ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
-                hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
-              else
-                location.size:=newsize;
-              current_procinfo.CurrTrueLabel:=oldTrueLabel;
-              current_procinfo.CurrFalseLabel:=oldFalseLabel;
-              exit;
-           end;
+  { Explicit typecasts from any ordinal type to a boolean type }
+  { must not change the ordinal value                          }
+  if (nf_explicit in flags) and
+     not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
+    begin
+       location_copy(location,left.location);
+       newsize:=def_cgsize(resultdef);
+       { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }
+       if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or
+          ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
+         hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
+       else
+         location.size:=newsize;
+       current_procinfo.CurrTrueLabel:=oldTrueLabel;
+       current_procinfo.CurrFalseLabel:=oldFalseLabel;
+       exit;
+    end;
 
   location_reset(location, LOC_REGISTER, def_cgsize(resultdef));
   opsize := def_cgsize(left.resultdef);
+
+  if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then
+    hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+
   case left.location.loc of
     LOC_CREFERENCE, LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER:
     begin

+ 4 - 0
compiler/ppcgen/ngppccnv.pas

@@ -110,6 +110,10 @@ implementation
          if (opsize in [OS_64,OS_S64]) then
            opsize:=OS_32;
 {$endif not cpu64bitalu}
+
+        if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+
          case left.location.loc of
             LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER :
               begin

+ 4 - 0
compiler/sparc/ncpucnv.pas

@@ -264,6 +264,10 @@ implementation
 
         location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
         opsize:=def_cgsize(left.resultdef);
+
+        if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+
         case left.location.loc of
           LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER:
             begin

+ 29 - 0
tests/webtbs/tw28007.pp

@@ -0,0 +1,29 @@
+program error_record;
+
+type
+
+  TPackedBool = bitpacked record
+    b0: Boolean;
+    b1: Boolean;
+    b2: Boolean;
+    b3: Boolean;
+    b4: Boolean;
+    b5: Boolean;
+    b6: Boolean;
+    b7: Boolean;
+  end;
+
+var
+  B: ByteBool;
+  PackedBool: TPackedBool;
+
+begin
+(*
+    - OK on x86, x86_64 compiler
+    - ERROR on cross arm compiler
+    - OK on cross arm compiler if we do typecast:
+        B := ByteBool(PackedBool.b0);
+                                                    *)
+
+  B := PackedBool.b0;
+end.