Merged revisions 7747-7750,7755,7757-7762 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r7747 | yury | 2007-06-20 21:11:05 +0300 (Ср, 20 июн 2007) | 1 line
  
  * skip test for wince.
........
  r7748 | yury | 2007-06-20 23:11:33 +0300 (Ср, 20 июн 2007) | 1 line
  
  * fixed test.
........
  r7749 | yury | 2007-06-20 23:31:06 +0300 (Ср, 20 июн 2007) | 2 lines
  
  * for ARM CPU records must be aligned in stack depending of record size to prevent misaligned error when the record is passed as parameter in registers. It fixes tcalext* tests for ARM.
........
  r7750 | yury | 2007-06-20 23:35:44 +0300 (Ср, 20 июн 2007) | 1 line
  
  * this test not for wince.
........
  r7755 | yury | 2007-06-21 16:46:35 +0300 (Чт, 21 июн 2007) | 1 line
  
  * adapted test for slow cpus like arm.
........
  r7757 | yury | 2007-06-21 17:08:58 +0300 (Чт, 21 июн 2007) | 1 line
  
  * Fixed integer to single conversion for arm-wince. It fixes tw8055.pp test.
........
  r7758 | yury | 2007-06-21 18:06:43 +0300 (Чт, 21 июн 2007) | 1 line
  
  * Fixed passing variant parameters by value for ARM. It fixes tw7806.pp.
........
  r7759 | yury | 2007-06-21 18:50:08 +0300 (Чт, 21 июн 2007) | 1 line
  
  * Removed $E- directive from tests to fix compilation for arm-wince.
........
  r7760 | yury | 2007-06-21 20:13:39 +0300 (Чт, 21 июн 2007) | 1 line
  
  * Delete temporary files used by tests. It is important when remotely run testsuite at Pocket PC. Temp files are created in root folder and it is not good if the files are left.
........
  r7761 | yury | 2007-06-21 20:23:13 +0300 (Чт, 21 июн 2007) | 1 line
  
  * Fixed test to be locale independent.
........
  r7762 | yury | 2007-06-21 20:32:35 +0300 (Чт, 21 июн 2007) | 1 line
  
  * Activated safecall support for ARM CPU.
........

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

compiler/arm/cpuinfo.pas

@@ -58,6 +58,7 @@ Const
    { calling conventions supported by the code generator }
    supported_calling_conventions : tproccalloptions = [
      pocall_internproc,
+     pocall_safecall,
      pocall_stdcall,
      { same as stdcall only different name mangling }
      pocall_cdecl,

compiler/arm/cpupara.pas

@@ -161,10 +161,11 @@ unit cpupara;
           end;
         case def.typ of
           objectdef,
-          variantdef,
-          formaldef,
           recorddef:
             result:=(varspez=vs_const) or (def.size=0);
+          variantdef,
+          formaldef:
+            result:=true;
           arraydef:
             result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
                              is_open_array(def) or

compiler/ncnv.pas

@@ -1990,19 +1990,23 @@ implementation
                 if is_currency(left.resultdef) then
                   left.resultdef := s64inttype;
                 if is_signed(left.resultdef) then
-                  fname:='I64TOD'
+                  fname:='I64TO'
                 else
-                  fname:='UI64TOD';
+                  fname:='UI64TO';
               end
             else
               { other integers are supposed to be 32 bit }
               begin
                 if is_signed(left.resultdef) then
-                  fname:='ITOD'
+                  fname:='ITO'
                 else
-                  fname:='UTOD';
+                  fname:='UTO';
                 firstpass(left);
               end;
+            if tfloatdef(resultdef).floattype=s64real then
+              fname:=fname+'D'
+            else
+              fname:=fname+'S';
             result:=ccallnode.createintern(fname,ccallparanode.create(
               left,nil));
             left:=nil;

compiler/tgobj.pas

@@ -116,7 +116,8 @@ implementation
     uses
        cutils,
        systems,verbose,
-       procinfo
+       procinfo,
+       symconst
        ;
 
 
@@ -620,7 +621,17 @@ implementation
 
     procedure ttgobj.getlocal(list: TAsmList; size : longint; alignment : shortint; def:tdef;var ref : treference);
       begin
+{$ifdef arm}
+        { for ARM CPU records must be aligned in stack depending of record size           }
+        { to prevent misaligned error when the record is passed as parameter in registers }
+        if def.typ=recorddef then
+          if size>2 then
+            alignment:=current_settings.alignment.localalignmax
+          else
+            alignment:=size;
+{$else}
         alignment:=used_align(alignment,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax);
+{$endif arm}
         { can't use reference_reset_base, because that will let tgobj depend
           on cgobj (PFV) }
         fillchar(ref,sizeof(ref),0);

rtl/wince/system.pp

@@ -174,6 +174,18 @@ function ui64tod(i : qword) : double; compilerproc;
 
 function i64tod(i : int64) : double; compilerproc;
    cdecl;external 'coredll' name '__i64tod';
+   
+function utos(i : dword) : single; compilerproc;
+   cdecl;external 'coredll' name '__utos';
+
+function itos(i : longint) : single; compilerproc;
+   cdecl;external 'coredll' name '__itos';
+
+function ui64tos(i : qword) : single; compilerproc;
+   cdecl;external 'coredll' name '__u64tos';
+
+function i64tos(i : int64) : single; compilerproc;
+   cdecl;external 'coredll' name '__i64tos';
 
 function adds(s1,s2 : single) : single; compilerproc;
 function subs(s1,s2 : single) : single; compilerproc;

tests/tbs/tb0084.pp

@@ -52,4 +52,5 @@ typecasting thing.}
  ReadLn(F,S);                          { Show that it worked, the same }
  WriteLn('That line again:',S);        { line readed again! }
  Close(F);                             { Close it }
+ Erase(F);
 end.

tests/tbs/tb0126.pp

@@ -25,6 +25,7 @@ begin
   reset(fin);
   read(fin,b1);
   close(fin);
+  erase(fin);
   if not b1[512*Mb]=1 then
    begin
       writeln('data err');

tests/tbs/tb0202.pp

@@ -35,4 +35,5 @@ begin
   reset(fileof);
   test;
   close(fileof);
+  erase(fileof);
 end.

tests/tbs/tb0317.pp

@@ -43,4 +43,5 @@ begin
    readln(f,st);
    if st<>'Invalid Opcode' then halt(1);
    close(f);
+   erase(f);
 end.

tests/tbs/tb0466.pp

@@ -9,4 +9,5 @@ begin
    w:=20;
    write(outf, w);
    close(outf);
+   erase(outf);
 end.

tests/tbs/tb0532.pp

@@ -1,3 +1,5 @@
+{%skiptarget=wince}
+
 program tb0532;
 
 {Append was the recommended way to open devices in TP.

tests/test/cg/tcalext.pp

@@ -512,12 +512,12 @@ begin
     failed := true;
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
+{$endif FPC_HAS_TYPE_EXTENDED}
 
   If failed then
    fail
   else
     WriteLn('Passed!');
-{$endif FPC_HAS_TYPE_EXTENDED}
 
   Write('External struct parameter testing...');
 

tests/test/targ1b.pp

@@ -1,3 +1,5 @@
+{%skiptarget=wince}
+
 { This file is to check if there is some memory corruption
   due to startup code with argument loading
   go32v2 target had this problem

tests/test/tint642.pp

@@ -724,6 +724,7 @@ procedure testioqword;
                do_error(2101);
             end;
        end;
+    erase(t);
   end;
 
 procedure teststringqword;

tests/test/units/objects/testobj.pp

@@ -72,6 +72,7 @@ Const S : String = '0123456789';
 Var Stream : TDosStream;
     Buf : String;
     L : word;
+    f : file;
 
 begin
   StreamError:= @StreamErrorProcedure;
@@ -119,4 +120,6 @@ begin
   Stream.Init('testobj.tmp',StOpenWrite);
   Stream.Truncate;
   Stream.Done;
+  Assign(f,'testobj.tmp');
+  Erase(f);
 end.

tests/test/units/objects/testobj1.pp

@@ -72,6 +72,7 @@ Const S : String = '0123456789';
 Var Stream : TBufStream;
     Buf : String;
     L : word;
+    f : file;
 
 begin
   StreamError:= @StreamErrorProcedure;
@@ -119,4 +120,6 @@ begin
   Stream.Init('testobj.tmp',StOpenWrite,8);
   Stream.Truncate;
   Stream.Done;
+  Assign(f,'testobj.tmp');
+  Erase(f);
 end.

tests/test/units/objects/testobj2.pp

@@ -17,6 +17,7 @@ var
   pStream2: PStream;
   lAux    : Longint;
   error : boolean;
+  f : file;
 begin
   error := false;
   Write('Error checking for object streams...');
@@ -35,6 +36,10 @@ begin
 
   pStream2^.Free;
   pStream1^.Free;
+
+  Assign(f,csFName1);
+  Erase(f);
+
   if error then
     Begin
       WriteLn('FAILED! Errors are mixed up!');

tests/test/units/sysutils/tfile1.pp

@@ -31,4 +31,10 @@ BEGIN
   dateTime := IncMonth(Now, -1);
   if FileSetDate('datetest.dat', DateTimeToFileDate(dateTime))<>0 then
     do_error(1002);
+
+  if FileExists('datetest.dat') then
+    begin
+      Assign(f,'datetest.dat');
+      Erase(f);
+    end;
 END.

tests/webtbf/tw0896.pp

@@ -14,4 +14,5 @@ begin
   { write should not be allowed for untyped files }
     write (dat,Buffer[j]);
   Close(dat);
+  Erase(dat);
 end.

tests/webtbf/tw0896a.pp

@@ -14,4 +14,5 @@ begin
   { writeln should not be allowed for typed files }
     writeln (dat,Buffer[j]);
   Close(dat);
+  Erase(dat);
 end.

tests/webtbs/tw0772.pp

@@ -36,4 +36,5 @@ begin
   if Foo.A<>4 then
    Halt(1);
   close(t);
+  erase(t);
 end.

tests/webtbs/tw0882.pp

@@ -1,4 +1,4 @@
-{$D+,E-,I+,L+,P-,Q+,R+,S+,T+,V+,X+,Y+}
+{$D+,I+,L+,P-,Q+,R+,S+,T+,V+,X+,Y+}
 {$M 8192,0,655360}
 PROGRAM TEST;
 CONST

tests/webtbs/tw0896.pp

@@ -31,4 +31,6 @@ begin
     end;
   Close(dat);
   close(dat2);
+  Erase(dat);
+  Erase(dat2);
 end.

tests/webtbs/tw1021.pp

@@ -52,4 +52,6 @@ begin
       Writeln('Error reading I value, should be one');
       Halt(1);
     end;
+  close(f);
+  erase(f);
 end.

tests/webtbs/tw1092.pp

@@ -18,4 +18,5 @@ BEGIN
      writeln('FSearch didn''t find file in the current dir!');
      halt(1);
    end;
+  erase(t);
 END.

tests/webtbs/tw1479.pp

@@ -24,4 +24,5 @@ begin
   writeln('found: ',fn);
   if fn<>ThisDir+fname then
    halt(1);
+  erase(f);
 end.

tests/webtbs/tw1658.pp

@@ -32,6 +32,7 @@ end;
 var
   pTempStream: PMyStream;
   mem : sizeint;
+  f : file;
 begin
   DoMem(mem);
   pTempStream := nil;
@@ -46,4 +47,6 @@ begin
       Writeln('Memory lost');
       Halt(1);
     end;
+  Assign(f,'tw1658.tmp');
+  Erase(f);
 end.

tests/webtbs/tw1896.pp

@@ -21,4 +21,6 @@ begin
      writeln('Error');
      halt(1);
    end;
+  close(fin);
+  erase(fin);
 end.

tests/webtbs/tw2678.pp

@@ -1,7 +1,7 @@
 { Source provided for Free Pascal Bug Report 2678 }
 { Submitted by "darek mazur" on  2003-09-13 }
 { e-mail: [email protected] }
-{$H-,I-,C-,D+,E-,L+,M-,P-,Q-,R-,S-,T-,X+,Z1}
+{$H-,I-,C-,D+,L+,M-,P-,Q-,R-,S-,T-,X+,Z1}
 {$Y+}
 unit tw2678;
 {$mode delphi}

tests/webtbs/tw2812.pp

@@ -1,3 +1,4 @@
+{%skiptarget=wince}
 var
   f:file;
   p:pointer;
@@ -10,6 +11,7 @@ begin
   p:=nil;
   BlockWrite(f,p^,12345);
   Close(f);
+  Erase(f);
   {$I+}
   i:=ioresult;
   writeln('IOResult: ',i);

tests/webtbs/tw3758.pp

@@ -56,5 +56,6 @@ begin
   stream2.free;
   testcomp1.free;
   testcomp2.free;
+  deletefile('test.txt');
  end;
 end.

tests/webtbs/tw3970.pp

@@ -26,4 +26,5 @@ begin
      ReadLn (f, s); // Warning!
 
      Close (f);
+     Erase (f);
 end.

tests/webtbs/tw3977.pp

@@ -13,5 +13,6 @@ begin
   assign(input,'tw3977.tmp');
   reset(input);
   readln(n);
-  close(output);
+  close(input);
+  erase(input);
 end.

tests/webtbs/tw5086.pp

@@ -24,6 +24,8 @@ begin
         reset(input);
 	readln(v, k);
 	readln(a1, a2, b1, b2, c1, c2);
+  close(input);
+  erase(input);
 end;
 
 procedure dfs(a, b, c, k1: Byte);

tests/webtbs/tw7391.pp

@@ -104,5 +104,6 @@ begin
     end;
   end;
   writeln('ok. done.');
+  DeleteFile('testfile.tmp');
 end.
 

tests/webtbs/tw8177.pp

@@ -6,6 +6,10 @@ program ValidateStrToInt;
   {$mode delphi}
 {$ENDIF}
 
+{$ifdef cpuarm}
+  {$define slowcpu}
+{$endif}
+
 uses
   SysUtils;
 
@@ -13,17 +17,17 @@ const
   AllowSlow = False;
 
 const
- VALIDATE8MIN : Integer = -80000;
- VALIDATE8MAX : Integer = 800000;
- VALIDATE9MAX : Integer = 200000;
- VALIDATE10MAX : Integer = 200000;
- VALIDATE13MIN : Integer = -1234678;
- VALIDATE13MAX : Integer = 123457;
- VALIDATE14MIN : Integer = -1234567;
- VALIDATE14MAX : Integer = 1234568;
- VALIDATE15MIN : Integer = -2235678;
- VALIDATE15MAX : Integer = 234578;
- VALIDATE16MIN : Integer = -1123478;
+ VALIDATE8MIN : Integer = {$ifdef slowcpu}-20000{$else}-80000{$endif};
+ VALIDATE8MAX : Integer = {$ifdef slowcpu}20000{$else}80000{$endif};
+ VALIDATE9MAX : Integer = {$ifdef slowcpu}50000{$else}200000{$endif};
+ VALIDATE10MAX : Integer = {$ifdef slowcpu}50000{$else}200000{$endif};
+ VALIDATE13MIN : Integer = {$ifdef slowcpu}-12345{$else}-1234678{$endif};
+ VALIDATE13MAX : Integer = {$ifdef slowcpu}12345{$else}123457{$endif};
+ VALIDATE14MIN : Integer = {$ifdef slowcpu}-12345{$else}-1234567{$endif};
+ VALIDATE14MAX : Integer = {$ifdef slowcpu}12345{$else}1234568{$endif};
+ VALIDATE15MIN : Integer = {$ifdef slowcpu}-22356{$else}-2235678{$endif};
+ VALIDATE15MAX : Integer = {$ifdef slowcpu}23457{$else}234578{$endif};
+ VALIDATE16MIN : Integer = {$ifdef slowcpu}-11234{$else}-1123478{$endif};
  VALIDATE16MAX : Integer = 45678;
  VALIDATE29OFFSETMAX : Integer = 400000;
  VALIDATE30OFFSETMAX : Integer = 400000;

tests/webtbs/tw8434.pp

@@ -3,6 +3,7 @@ uses sysutils;
 var
   x: double;
 begin
+  DecimalSeparator:='.';
   x := 0.099991;
   if (Format('%5.2f', [x]) <> ' 0.10') then
     halt(1);