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

Merged revisions 6786,6804,6812,6899,6911,6938,6940,6948,6969 via svnmerge from
http://svn.freepascal.org/svn/fpc/trunk

r6786 (florian)
* check used fpu type properly


r6804 (florian)
* handle interfaces et al. correctly in Set/GetOrdProp, resolves #8510


r6812 (florian)
* use section smartlinking on arm-linux, experimental


r6899 (florian)
* several packed array and varset related ies on sparc fixed


r6911 (florian)
* big set test


r6938 (florian)
* WinCE compilation fixed


r6940 (florian)
* fixed x86-64 compilation


r6948 (florian)
* experimental fix for #8210


r6969 (florian)
* TCFileStream.Seek should return the new position

git-svn-id: branches/fixes_2_2@6974 -

florian 18 éve
szülő
commit
2a374bc997

+ 2 - 0
.gitattributes

@@ -6716,6 +6716,7 @@ tests/test/tintfdef.pp svneol=native#text/plain
 tests/test/tintuint.pp svneol=native#text/plain
 tests/test/tintuint.pp svneol=native#text/plain
 tests/test/tlibrary1.pp svneol=native#text/plain
 tests/test/tlibrary1.pp svneol=native#text/plain
 tests/test/tlibrary2.pp svneol=native#text/plain
 tests/test/tlibrary2.pp svneol=native#text/plain
+tests/test/tlibrary3.pp svneol=native#text/plain
 tests/test/tmacbool.pp svneol=native#text/plain
 tests/test/tmacbool.pp svneol=native#text/plain
 tests/test/tmacfunret.pp svneol=native#text/plain
 tests/test/tmacfunret.pp svneol=native#text/plain
 tests/test/tmaclocalprocparam.pp svneol=native#text/plain
 tests/test/tmaclocalprocparam.pp svneol=native#text/plain
@@ -6806,6 +6807,7 @@ tests/test/tset3.pp svneol=native#text/plain
 tests/test/tset4.pp svneol=native#text/plain
 tests/test/tset4.pp svneol=native#text/plain
 tests/test/tset5.pp svneol=native#text/plain
 tests/test/tset5.pp svneol=native#text/plain
 tests/test/tset5a.pp svneol=native#text/plain
 tests/test/tset5a.pp svneol=native#text/plain
+tests/test/tset6.pp svneol=native#text/plain
 tests/test/tstack.pp svneol=native#text/plain
 tests/test/tstack.pp svneol=native#text/plain
 tests/test/tstprocv.pp svneol=native#text/plain
 tests/test/tstprocv.pp svneol=native#text/plain
 tests/test/tstring1.pp svneol=native#text/plain
 tests/test/tstring1.pp svneol=native#text/plain

+ 5 - 2
compiler/cstreams.pas

@@ -417,7 +417,10 @@ begin
   {$I-}
   {$I-}
    case Origin of
    case Origin of
      soFromBeginning :
      soFromBeginning :
-       System.Seek(FHandle,Offset);
+       begin
+         System.Seek(FHandle,Offset);
+         l:=Offset;
+       end;
      soFromCurrent :
      soFromCurrent :
        begin
        begin
          l:=System.FilePos(FHandle);
          l:=System.FilePos(FHandle);
@@ -435,7 +438,7 @@ begin
    end;
    end;
   {$I+}
   {$I+}
   CStreamError:=IOResult;
   CStreamError:=IOResult;
-  Result:=CStreamError;
+  Result:=l;
 end;
 end;
 
 
 
 

+ 7 - 6
compiler/ncgadd.pas

@@ -232,11 +232,11 @@ interface
     procedure tcgaddnode.second_opsmallset;
     procedure tcgaddnode.second_opsmallset;
       begin
       begin
         { when a setdef is passed, it has to be a smallset }
         { when a setdef is passed, it has to be a smallset }
-        if ((left.resultdef.typ=setdef) and
-            (tsetdef(left.resultdef).settype<>smallset)) or
-           ((right.resultdef.typ=setdef) and
-            (tsetdef(right.resultdef).settype<>smallset)) then
-          internalerror(200203301);
+        if is_varset(left.resultdef) or
+          is_normalset(left.resultdef) or
+          is_varset(right.resultdef) or
+          is_normalset(right.resultdef) then
+          internalerror(200203302);
 
 
         if nodetype in [equaln,unequaln,gtn,gten,lten,ltn] then
         if nodetype in [equaln,unequaln,gtn,gten,lten,ltn] then
           second_cmpsmallset
           second_cmpsmallset
@@ -769,7 +769,8 @@ interface
             begin
             begin
               {Normalsets are already handled in pass1 if mmx
               {Normalsets are already handled in pass1 if mmx
                should not be used.}
                should not be used.}
-              if (tsetdef(left.resultdef).settype<>smallset) then
+              if is_varset(tsetdef(left.resultdef)) or
+                is_normalset(tsetdef(left.resultdef)) then
                 begin
                 begin
 {$ifdef SUPPORT_MMX}
 {$ifdef SUPPORT_MMX}
                 {$ifdef i386}
                 {$ifdef i386}

+ 11 - 5
compiler/options.pas

@@ -2145,10 +2145,6 @@ begin
       def_system_macro('FPC_ABI_AIX');
       def_system_macro('FPC_ABI_AIX');
   end;
   end;
 
 
-  { CPU Define }
-  def_system_macro('CPU'+Cputypestr[init_settings.cputype]);
-
-  def_system_macro('FPU'+fputypestr[init_settings.fputype]);
 { Check file to compile }
 { Check file to compile }
   if param_file='' then
   if param_file='' then
    begin
    begin
@@ -2288,7 +2284,17 @@ begin
     or (init_settings.fputype=fpu_soft)
     or (init_settings.fputype=fpu_soft)
 {$endif arm}
 {$endif arm}
   then
   then
-    include(init_settings.moduleswitches,cs_fp_emulation);
+    begin
+      include(init_settings.moduleswitches,cs_fp_emulation);
+      { cs_fp_emulation and fpu_soft are equal on arm }
+      init_settings.fputype:=fpu_soft;
+    end;
+
+
+  { now we can defined cpu and cpu type }
+  def_system_macro('CPU'+Cputypestr[init_settings.cputype]);
+
+  def_system_macro('FPU'+fputypestr[init_settings.fputype]);
 
 
 {$ifdef ARM}
 {$ifdef ARM}
   { define FPC_DOUBLE_HILO_SWAPPED if needed to properly handle doubles in RTL }
   { define FPC_DOUBLE_HILO_SWAPPED if needed to properly handle doubles in RTL }

+ 4 - 1
compiler/sparc/ncpumat.pas

@@ -308,7 +308,10 @@ implementation
                   location_copy(location,left.location);
                   location_copy(location,left.location);
                   inverse_flags(location.resflags);
                   inverse_flags(location.resflags);
                 end;
                 end;
-              LOC_REGISTER, LOC_CREGISTER, LOC_REFERENCE, LOC_CREFERENCE :
+              LOC_REGISTER, LOC_CREGISTER,
+              LOC_REFERENCE, LOC_CREFERENCE,
+              LOC_SUBSETREG, LOC_CSUBSETREG,
+              LOC_SUBSETREF, LOC_CSUBSETREF:
                 begin
                 begin
                   location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),true);
                   location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),true);
                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_const_reg(A_SUBcc,left.location.register,0,NR_G0));
                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_const_reg(A_SUBcc,left.location.register,0,NR_G0));

+ 2 - 1
compiler/systems/i_linux.pas

@@ -524,7 +524,8 @@ unit i_linux;
             system       : system_arm_Linux;
             system       : system_arm_Linux;
             name         : 'Linux for ARM';
             name         : 'Linux for ARM';
             shortname    : 'Linux';
             shortname    : 'Linux';
-            flags        : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive,tf_use_function_relative_addresses];
+            flags        : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive,
+                            tf_use_function_relative_addresses,tf_smartlink_sections];
             cpu          : cpu_arm;
             cpu          : cpu_arm;
             unit_env     : 'LINUXUNITS';
             unit_env     : 'LINUXUNITS';
             extradefines : 'UNIX;HASUNIX';
             extradefines : 'UNIX;HASUNIX';

+ 26 - 4
compiler/systems/t_linux.pas

@@ -425,10 +425,22 @@ begin
       { try to add crti and crtbegin if linking to C }
       { try to add crti and crtbegin if linking to C }
       if linklibc then
       if linklibc then
        begin
        begin
-         if librarysearchpath.FindFile('crtbegin.o',false,s) then
-          AddFileName(s);
+         { x86_64 requires this to use entry/exit code with pic,
+           see also issue #8210 regarding a discussion
+           no idea about the other non i386 CPUs (FK)
+         }
+{$ifdef x86_64}
+         if current_module.islibrary then
+           begin
+             if librarysearchpath.FindFile('crtbeginS.o',false,s) then
+               AddFileName(s);
+           end
+         else
+{$endif x86_64}
+           if librarysearchpath.FindFile('crtbegin.o',false,s) then
+             AddFileName(s);
          if librarysearchpath.FindFile('crti.o',false,s) then
          if librarysearchpath.FindFile('crti.o',false,s) then
-          AddFileName(s);
+           AddFileName(s);
        end;
        end;
       { main objectfiles }
       { main objectfiles }
       while not ObjectFiles.Empty do
       while not ObjectFiles.Empty do
@@ -490,7 +502,17 @@ begin
       { objects which must be at the end }
       { objects which must be at the end }
       if linklibc and (libctype<>uclibc) then
       if linklibc and (libctype<>uclibc) then
        begin
        begin
-         found1:=librarysearchpath.FindFile('crtend.o',false,s1);
+         { x86_64 requires this to use entry/exit code with pic,
+           see also issue #8210 regarding a discussion
+           no idea about the other non i386 CPUs (FK)
+         }
+{$ifdef x86_64}
+         if current_module.islibrary then
+           found1:=librarysearchpath.FindFile('crtendS.o',false,s1)
+         else
+{$else x86_64}
+           found1:=librarysearchpath.FindFile('crtend.o',false,s1);
+{$endif x86_64}
          found2:=librarysearchpath.FindFile('crtn.o',false,s2);
          found2:=librarysearchpath.FindFile('crtn.o',false,s2);
          if found1 or found2 then
          if found1 or found2 then
           begin
           begin

+ 2 - 0
compiler/x86_64/cpuinfo.pas

@@ -45,6 +45,7 @@ Type
 
 
    tfputype =
    tfputype =
      (fpu_none,
      (fpu_none,
+      fpu_soft,  { generic }
       fpu_sse64
       fpu_sse64
      );
      );
 
 
@@ -73,6 +74,7 @@ Const
    );
    );
 
 
    fputypestr : array[tfputype] of string[6] = ('',
    fputypestr : array[tfputype] of string[6] = ('',
+     'SOFT',
      'SSE64'
      'SSE64'
    );
    );
 
 

+ 2 - 2
rtl/arm/math.inc

@@ -14,7 +14,7 @@
 
 
  **********************************************************************}
  **********************************************************************}
 
 
-{$ifndef WINCE}
+{$if defined(FPUFPA) or defined(FPUFPA10) or defined(FPUFPA11)}
     {$define FPC_SYSTEM_HAS_ABS}
     {$define FPC_SYSTEM_HAS_ABS}
     function fpc_abs_real(d : ValReal) : ValReal;compilerproc;
     function fpc_abs_real(d : ValReal) : ValReal;compilerproc;
     begin
     begin
@@ -36,6 +36,7 @@
       runerror(207);
       runerror(207);
       result:=0;
       result:=0;
     end;
     end;
+{$endif}
     (* atn isn't supported by the linux fpe it seems
     (* atn isn't supported by the linux fpe it seems
     {$define FPC_SYSTEM_HAS_ARCTAN}
     {$define FPC_SYSTEM_HAS_ARCTAN}
     function fpc_arctan_real(d : extended) : extended;compilerproc;
     function fpc_arctan_real(d : extended) : extended;compilerproc;
@@ -72,4 +73,3 @@
       result:=0;
       result:=0;
     end;
     end;
     *)
     *)
-{$endif WINCE}

+ 6 - 0
rtl/objpas/typinfo.pp

@@ -744,6 +744,9 @@ begin
   DataSize := 4;
   DataSize := 4;
   case TypeInfo^.Kind of
   case TypeInfo^.Kind of
 {$ifdef cpu64}
 {$ifdef cpu64}
+    tkInterface,
+    tkInterfaceRaw,
+    tkDynArray,
     tkClass:
     tkClass:
       DataSize:=8;
       DataSize:=8;
 {$endif cpu64}
 {$endif cpu64}
@@ -836,6 +839,9 @@ begin
   if PropInfo^.PropType^.Kind in [tkInt64,tkQword
   if PropInfo^.PropType^.Kind in [tkInt64,tkQword
   { why do we have to handle classes here, see also below? (FK) }
   { why do we have to handle classes here, see also below? (FK) }
 {$ifdef cpu64}
 {$ifdef cpu64}
+    ,tkInterface,
+    ,tkInterfaceRaw,
+    ,tkDynArray,
     ,tkClass
     ,tkClass
 {$endif cpu64}
 {$endif cpu64}
     ] then
     ] then

+ 54 - 0
tests/test/tlibrary3.pp

@@ -0,0 +1,54 @@
+{ %NORUN }
+{ %SKIPTARGET=macos }
+
+{$ifdef CPUX86_64}
+{$ifndef WINDOWS}
+{$PIC+}
+{$endif WINDOWS}
+{$endif CPUX86_64}
+
+{ The .so of the library needs to be in the current dir when
+  testing the loading at runtime }
+
+{$ifdef mswindows}
+ {$define supported}
+ {$define supportidx}
+{$endif win32}
+{$ifdef Unix}
+ {$define supported}
+{$endif Unix}
+{$ifndef fpc}
+   {$define supported}
+{$endif}
+
+{$ifdef supported}
+
+library bug;
+
+uses
+  initc;
+
+const
+   publicname='TestName';
+   publicindex = 1234;
+
+procedure Test;export;
+
+ begin
+//   writeln('Hoi');
+ end;
+
+exports
+  Test name publicname;
+{$ifdef supportidx}
+exports
+  Test index publicindex;
+{$endif}
+
+begin
+end.
+{$else supported}
+begin
+  Writeln('No library for that target');
+end.
+{$endif supported}

+ 339 - 0
tests/test/tset6.pp

@@ -0,0 +1,339 @@
+{ %opt=-Ooregvar }
+
+{$ifdef fpc}
+{$packset 1}
+{$endif fpc}
+{$z1}
+
+type
+  ta = set of 0..700;
+  tb = set of 0..1500;
+  tc = set of 0..2300;
+  td = set of 0..3100;
+  te = set of 0..12700;
+
+var
+  ve: te;
+  vd: td;
+  vc: tc;
+  vb: tb;
+  va: ta;
+  b1,b2,b3: byte;
+begin
+  b1 := $ff;
+  b2 := $ff;
+  b3 := $ff;
+  va := [];
+  vb := [];
+  vc := [];
+  vd := [];
+  ve := [];
+
+  va := [300..400];
+  vb := va;
+  if b1 <> $ff then
+    halt(1);
+  if va <> [300..400] then
+    halt(1);
+  if vb <> [300..400] then
+    halt(1);
+  if vc <> [] then
+    halt(1);
+  if vd <> [] then
+    halt(1);
+  if ve <> [] then
+    halt(1);
+  vc := va;
+  if b1 <> $ff then
+    halt(1);
+  if va <> [300..400] then
+    halt(1);
+  if vb <> [300..400] then
+    halt(1);
+  if vc <> [300..400] then
+    halt(1);
+  if vd <> [] then
+    halt(1);
+  if ve <> [] then
+    halt(1);
+  vd := va;
+  if b1 <> $ff then
+    halt(1);
+  if va <> [300..400] then
+    halt(1);
+  if vb <> [300..400] then
+    halt(1);
+  if vc <> [300..400] then
+    halt(1);
+  if vd <> [300..400] then
+    halt(1);
+  if ve <> [] then
+    halt(1);
+  ve := va;
+  if b1 <> $ff then
+    halt(1);
+  if va <> [300..400] then
+    halt(1);
+  if vb <> [300..400] then
+    halt(1);
+  if vc <> [300..400] then
+    halt(1);
+  if vd <> [300..400] then
+    halt(1);
+  if ve <> [300..400] then
+    halt(1);
+
+  b1 := $ff;
+  b2 := $ff;
+  b3 := $ff;
+  va := [];
+  vb := [];
+  vc := [];
+  vd := [];
+  ve := [];
+
+  vb := [0,200,300];
+  va := vb;
+  if b1 <> $ff then
+    halt(2);
+  if va <> [0,200,300] then
+    halt(2);
+  if vb <> [0,200,300] then
+    halt(2);
+  if vc <> [] then
+    halt(2);
+  if vd <> [] then
+    halt(2);
+  if ve <> [] then
+    halt(2);
+  vc := vb;
+  if b1 <> $ff then
+    halt(2);
+  if va <> [0,200,300] then
+    halt(2);
+  if vb <> [0,200,300] then
+    halt(2);
+  if vc <> [0,200,300] then
+    halt(2);
+  if vd <> [] then
+    halt(2);
+  if ve <> [] then
+    halt(2);
+  vd := vb;
+  if b1 <> $ff then
+    halt(2);
+  if va <> [0,200,300] then
+    halt(2);
+  if vb <> [0,200,300] then
+    halt(2);
+  if vc <> [0,200,300] then
+    halt(2);
+  if vd <> [0,200,300] then
+    halt(2);
+  if ve <> [] then
+    halt(2);
+  ve := vb;
+  if va <> [0,200,300] then
+    halt(2);
+  if vb <> [0,200,300] then
+    halt(2);
+  if vc <> [0,200,300] then
+    halt(2);
+  if vd <> [0,200,300] then
+    halt(2);
+  if ve <> [0,200,300] then
+    halt(2);
+
+
+  b1 := $ff;
+  b2 := $ff;
+  b3 := $ff;
+  va := [];
+  vb := [];
+  vc := [];
+  vd := [];
+  ve := [];
+
+  vc := [500,600,700];
+  va := vc;
+  if b1 <> $ff then
+    halt(3);
+  if va <> [500,600,700] then
+    halt(3);
+  if vc <> [500,600,700] then
+    halt(3);
+  if vb <> [] then
+    halt(3);
+  if vd <> [] then
+    halt(3);
+  if ve <> [] then
+    halt(3);
+  vb := vc;
+  if b1 <> $ff then
+    halt(3);
+  if va <> [500,600,700] then
+    halt(3);
+  if vb <> [500,600,700] then
+    halt(3);
+  if vc <> [500,600,700] then
+    halt(3);
+  if vd <> [] then
+    halt(3);
+  if ve <> [] then
+    halt(3);
+  vd := vc;
+  if b1 <> $ff then
+    halt(3);
+  if va <> [500,600,700] then
+    halt(3);
+  if vb <> [500,600,700] then
+    halt(3);
+  if vc <> [500,600,700] then
+    halt(3);
+  if vd <> [500,600,700] then
+    halt(3);
+  if ve <> [] then
+    halt(3);
+  ve := vc;
+  if b1 <> $ff then
+    halt(3);
+  if va <> [500,600,700] then
+    halt(3);
+  if vb <> [500,600,700] then
+    halt(3);
+  if vc <> [500,600,700] then
+    halt(3);
+  if vd <> [500,600,700] then
+    halt(3);
+  if ve <> [500,600,700] then
+    halt(3);
+
+
+  b1 := $ff;
+  b2 := $ff;
+  b3 := $ff;
+  va := [];
+  vb := [];
+  vc := [];
+  vd := [];
+  ve := [];
+
+  vd := [100,300,500];
+  va := vd;
+  if b1 <> $ff then
+    halt(4);
+  if va <> [100,300,500] then
+    halt(4);
+  if vd <> [100,300,500] then
+    halt(4);
+  if vc <> [] then
+    halt(4);
+  if vb <> [] then
+    halt(4);
+  if ve <> [] then
+    halt(4);
+  vb := vd;
+  if b1 <> $ff then
+    halt(4);
+  if va <> [100,300,500] then
+    halt(4);
+  if vb <> [100,300,500] then
+    halt(4);
+  if vd <> [100,300,500] then
+    halt(4);
+  if vc <> [] then
+    halt(4);
+  if ve <> [] then
+    halt(4);
+  vc := vd;
+  if b1 <> $ff then
+    halt(4);
+  if va <> [100,300,500] then
+    halt(4);
+  if vb <> [100,300,500] then
+    halt(4);
+  if vc <> [100,300,500] then
+    halt(4);
+  if vd <> [100,300,500] then
+    halt(4);
+  if ve <> [] then
+    halt(4);
+  ve := vd;
+  if b1 <> $ff then
+    halt(4);
+  if va <> [100,300,500] then
+    halt(4);
+  if vb <> [100,300,500] then
+    halt(4);
+  if vc <> [100,300,500] then
+    halt(4);
+  if vd <> [100,300,500] then
+    halt(4);
+  if ve <> [100,300,500] then
+    halt(4);
+
+
+  b1 := $ff;
+  b2 := $ff;
+  b3 := $ff;
+  va := [];
+  vb := [];
+  vc := [];
+  vd := [];
+  ve := [];
+
+  ve := [0,700];
+  va := ve;
+  if b1 <> $ff then
+    halt(5);
+  if va <> [0,700] then
+    halt(5);
+  if ve <> [0,700] then
+    halt(5);
+  if vc <> [] then
+    halt(5);
+  if vd <> [] then
+    halt(5);
+  if vb <> [] then
+    halt(5);
+  vb := ve;
+  if b1 <> $ff then
+    halt(5);
+  if va <> [0,700] then
+    halt(5);
+  if vb <> [0,700] then
+    halt(5);
+  if ve <> [0,700] then
+    halt(5);
+  if vd <> [] then
+    halt(5);
+  if vc <> [] then
+    halt(5);
+  vc := ve;
+  if b1 <> $ff then
+    halt(5);
+  if va <> [0,700] then
+    halt(5);
+  if vb <> [0,700] then
+    halt(5);
+  if vc <> [0,700] then
+    halt(5);
+  if ve <> [0,700] then
+    halt(5);
+  if vd <> [] then
+    halt(5);
+  vd := ve;
+  if b1 <> $ff then
+    halt(5);
+  if va <> [0,700] then
+    halt(5);
+  if vb <> [0,700] then
+    halt(5);
+  if vc <> [0,700] then
+    halt(5);
+  if vd <> [0,700] then
+    halt(5);
+  if ve <> [0,700] then
+    halt(5);
+  writeln('ok');
+end.