Переглянути джерело

--- Merging r30038 into '.':
U compiler/ncgvmt.pas
--- Merging r30217 into '.':
U compiler/comprsrc.pas
--- Merging r30261 into '.':
A tests/webtbs/tw27691.pp
U compiler/pmodules.pas
--- Merging r30265 into '.':
U compiler/fmodule.pas
G compiler/pmodules.pas
--- Merging r30272 into '.':
A tests/webtbs/tw27517.pp
U compiler/pexpr.pas
--- Merging r30427 into '.':
U compiler/x86/cpubase.pas
--- Merging r30465 into '.':
U compiler/utils/ppuutils/ppudump.pp
--- Merging r30487 into '.':
U rtl/inc/cgenstr.inc
--- Merging r30502 into '.':
U compiler/x86/nx86inl.pas
U compiler/arm/narminl.pas
U compiler/ppcgen/ngppcinl.pas
A tests/webtbs/tw27811.pp
--- Merging r30656 into '.':
U compiler/psub.pas
--- Merging r30765 into '.':
U compiler/arm/narmcnv.pas
U compiler/sparc/ncpucnv.pas
U compiler/m68k/n68kcnv.pas
U compiler/mips/ncpucnv.pas
U compiler/ppcgen/ngppccnv.pas
C compiler/aarch64/ncpucnv.pas
A tests/webtbs/tw28007.pp

git-svn-id: branches/fixes_3_0@32665 -

Jonas Maebe 9 роки тому
батько
коміт
e0ca083cce

+ 4 - 0
.gitattributes

@@ -14254,21 +14254,25 @@ tests/webtbs/tw2737.pp svneol=native#text/plain
 tests/webtbs/tw2738.pp svneol=native#text/plain
 tests/webtbs/tw2739.pp svneol=native#text/plain
 tests/webtbs/tw27424.pp svneol=native#text/pascal
+tests/webtbs/tw27517.pp svneol=native#text/pascal
 tests/webtbs/tw2758.pp svneol=native#text/plain
 tests/webtbs/tw2763.pp svneol=native#text/plain
 tests/webtbs/tw2765.pp svneol=native#text/plain
 tests/webtbs/tw27658.pp svneol=native#text/pascal
 tests/webtbs/tw2767.pp svneol=native#text/plain
+tests/webtbs/tw27691.pp svneol=native#text/plain
 tests/webtbs/tw2771.pp svneol=native#text/plain
 tests/webtbs/tw2772.pp svneol=native#text/plain
 tests/webtbs/tw2776.pp svneol=native#text/plain
 tests/webtbs/tw2778.pp svneol=native#text/plain
 tests/webtbs/tw2779.pp svneol=native#text/plain
 tests/webtbs/tw2780.pp svneol=native#text/plain
+tests/webtbs/tw27811.pp svneol=native#text/plain
 tests/webtbs/tw27832.pp svneol=native#text/plain
 tests/webtbs/tw2788.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/arm/narmcnv.pas

@@ -313,6 +313,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 :

+ 1 - 1
compiler/arm/narminl.pas

@@ -372,7 +372,7 @@ implementation
                   current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_PLD,ref));
                 end;
               else
-                internalerror(200402021);
+                { nothing to prefetch };
             end;
           end;
       end;

+ 2 - 2
compiler/comprsrc.pas

@@ -283,10 +283,10 @@ begin
       Replace(s,'$OBJ',maybequoted(OutName));
       subarch:='all';
       arch:=cpu2str[target_cpu];
-      if (source_info.cpu=systems.cpu_arm) then
+      if (target_info.cpu=systems.cpu_arm) then
         begin
           //Differentiate between arm and armeb
-          if (source_info.endian=endian_big) then
+          if (target_info.endian=endian_big) then
             arch:=arch+'eb';
         end;
       Replace(s,'$ARCH',arch);

+ 1 - 0
compiler/fmodule.pas

@@ -983,6 +983,7 @@ implementation
                 { Give a note when the unit is not referenced, skip
                   this is for units with an initialization/finalization }
                 if (unitmap[pu.u.moduleid].refs=0) and
+                   pu.in_uses and
                    ((pu.u.flags and (uf_init or uf_finalize))=0) then
                   CGMessagePos2(pu.unitsym.fileinfo,sym_n_unit_not_used,pu.u.realmodulename^,realmodulename^);
               end;

+ 4 - 0
compiler/m68k/n68kcnv.pas

@@ -201,6 +201,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

+ 10 - 10
compiler/ncgvmt.pas

@@ -246,9 +246,9 @@ implementation
            writestrentry(list,p^.l);
 
          { write name label }
-         list.concat(cai_align.create(const_align(sizeof(pint))));
+         list.concat(cai_align.create(sizeof(pint)));
          list.concat(Tai_const.Create_sym(p^.nl));
-         list.concat(cai_align.create(const_align(sizeof(pint))));
+         list.concat(cai_align.create(sizeof(pint)));
          list.concat(Tai_const.Createname(p^.data.mangledname,AT_FUNCTION,0));
 
          if assigned(p^.r) then
@@ -271,11 +271,11 @@ implementation
 
          { now start writing of the message string table }
          current_asmdata.getlabel(result,alt_data);
-         list.concat(cai_align.create(const_align(sizeof(pint))));
+         list.concat(cai_align.create(sizeof(pint)));
          list.concat(Tai_label.Create(result));
-         list.concat(cai_align.create(const_align(sizeof(longint))));
+         list.concat(cai_align.create(sizeof(longint)));
          list.concat(Tai_const.Create_32bit(count));
-         list.concat(cai_align.create(const_align(sizeof(pint))));
+         list.concat(cai_align.create(sizeof(pint)));
          if assigned(root) then
            begin
               writestrentry(list,root);
@@ -290,9 +290,9 @@ implementation
            writeintentry(list,p^.l);
 
          { write name label }
-         list.concat(cai_align.create(const_align(sizeof(longint))));
+         list.concat(cai_align.create(sizeof(longint)));
          list.concat(Tai_const.Create_32bit(p^.data.messageinf.i));
-         list.concat(cai_align.create(const_align(sizeof(pint))));
+         list.concat(cai_align.create(sizeof(pint)));
          list.concat(Tai_const.Createname(p^.data.mangledname,AT_FUNCTION,0));
 
          if assigned(p^.r) then
@@ -312,12 +312,12 @@ implementation
 
          { now start writing of the message string table }
          current_asmdata.getlabel(r,alt_data);
-         list.concat(cai_align.create(const_align(sizeof(pint))));
+         list.concat(cai_align.create(sizeof(pint)));
          list.concat(Tai_label.Create(r));
          genintmsgtab:=r;
-         list.concat(cai_align.create(const_align(sizeof(longint))));
+         list.concat(cai_align.create(sizeof(longint)));
          list.concat(Tai_const.Create_32bit(count));
-         list.concat(cai_align.create(const_align(sizeof(pint))));
+         list.concat(cai_align.create(sizeof(pint)));
          if assigned(root) then
            begin
               writeintentry(list,root);

+ 3 - 6
compiler/pexpr.pas

@@ -3260,12 +3260,9 @@ implementation
                  if try_to_consume(_LKLAMMER) then
                   begin
                     p1:=factor(true,false);
-                    if token in postfixoperator_tokens then
-                     begin
-                       again:=true;
-                       postfixoperators(p1,again,getaddr);
-                     end
-                    else
+                    { inside parentheses a full expression is allowed, see also tests\webtbs\tb27517.pp }
+                    if token<>_RKLAMMER then
+                      p1:=sub_expr(opcompare,true,false,p1);
                     consume(_RKLAMMER);
                   end
                  else

+ 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

+ 1 - 1
compiler/ppcgen/ngppcinl.pas

@@ -227,7 +227,7 @@ implementation
                  end;
              end;
            else
-             internalerror(200402021);
+             { nothing to prefetch };
          end;
        end;
 

+ 6 - 1
compiler/psub.pas

@@ -1293,7 +1293,12 @@ implementation
         { there's always a call to FPC_INITIALIZEUNITS/FPC_DO_EXIT in the main program }
         if (procdef.localst.symtablelevel=main_program_level) and
            (not current_module.is_unit) then
-          include(flags,pi_do_call);
+          begin
+            include(flags,pi_do_call);
+            { the main program never returns due to the do_exit call }
+            if not(DLLsource) then
+              include(procdef.procoptions,po_noreturn);
+          end;
 
         { set implicit_finally flag when there are locals/paras to be finalized }
         procdef.parast.SymList.ForEachCall(@check_finalize_paras,nil);

+ 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

+ 1 - 2
compiler/utils/ppuutils/ppudump.pp

@@ -3117,8 +3117,7 @@ begin
 
              writeln([space,' Abstract methods : ',getlongint]);
 
-             if (tobjecttyp(b)=odt_helper) or
-                 (oo_is_classhelper in current_objectoptions) then
+             if tobjecttyp(b)=odt_helper then
                begin
                  write([space,'    Helper parent : ']);
                  readderef('',objdef.HelperParent);

+ 2 - 1
compiler/x86/cpubase.pas

@@ -116,9 +116,10 @@ uses
       RS_ST5        = $05;
       RS_ST6        = $06;
       RS_ST7        = $07;
+      RS_ST         = $08;
 
       { Number of first imaginary register }
-      first_fpu_imreg     = $08;
+      first_fpu_imreg     = $09;
 
       { MM Super registers }
       RS_XMM0        = $00;

+ 1 - 1
compiler/x86/nx86inl.pas

@@ -595,7 +595,7 @@ implementation
                    current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_PREFETCHNTA,S_NO,ref));
                  end;
                else
-                 internalerror(200402021);
+                 { nothing to prefetch };
              end;
            end;
        end;

+ 2 - 2
rtl/inc/cgenstr.inc

@@ -108,7 +108,7 @@
 
 {$ifndef FPC_UNIT_HAS_STRLCOMP}
 {$define FPC_UNIT_HAS_STRLCOMP}
- function libc_strncmp(const str1,str2: pchar; l: Cardinal): longint; cdecl; external 'c' name 'strncmp';
+ function libc_strncmp(const str1,str2: pchar; l: sizeint): longint; cdecl; external 'c' name 'strncmp';
 
  function StrLComp(Str1, Str2 : PChar; L: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
    Begin
@@ -119,7 +119,7 @@
 
 {$ifndef FPC_UNIT_HAS_STRLICOMP}
 {$define FPC_UNIT_HAS_STRLICOMP}
- function libc_strncasecmp(const str1,str2: pchar; l: Cardinal): longint; cdecl; external 'c' name 'strncasecmp';
+ function libc_strncasecmp(const str1,str2: pchar; l: sizeint): longint; cdecl; external 'c' name 'strncasecmp';
 
  function StrLIComp(Str1, Str2 : PChar; L: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
    Begin

+ 11 - 0
tests/webtbs/tw27517.pp

@@ -0,0 +1,11 @@
+program Project1;
+
+{$mode objfpc}{$H+}
+
+var
+  pTyped: PInteger;
+  p: Pointer;
+begin
+  p := nil;
+  pTyped := @(PByte(p)+1)^; //project1.lpr(21,23) Fatal: Syntax error, ")" expected but "+" found
+end.

+ 6 - 0
tests/webtbs/tw27691.pp

@@ -0,0 +1,6 @@
+{ %opt=-Seh -vh }
+
+{$modeswitch unicodestrings}
+
+begin
+end.

+ 13 - 0
tests/webtbs/tw27811.pp

@@ -0,0 +1,13 @@
+{ %norun }
+
+{$optimization regvar on}
+procedure test;
+var m,n: integer;
+begin
+  for m := 100 downto 0 do begin
+    prefetch (m);
+  end;
+end;
+
+begin
+end.

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