Browse Source

Merged revisions 1614,1618,1625-1626,1630-1633 via svnmerge from
http://[email protected]/svn/fpc/trunk

........
r1614 | marco | 2005-10-31 16:16:50 +0100 (Mon, 31 Oct 2005) | 2 lines

* streams freed to fix 4478

........
r1618 | tom_at_work | 2005-11-01 22:08:07 +0100 (Tue, 01 Nov 2005) | 1 line

- fixed TFDSet type for 64 bit compatibility
........
r1625 | tom_at_work | 2005-11-01 23:40:23 +0100 (Tue, 01 Nov 2005) | 2 lines

* fixed some typecasts of pointers to Longint for 64 bit architectures (Linux and generic parts of the RTL only)
* 64 bit sockets unit fixes
........
r1626 | florian | 2005-11-01 23:41:25 +0100 (Tue, 01 Nov 2005) | 2 lines

* started to fix var. array -> dyn. array

........
r1630 | marco | 2005-11-02 15:52:05 +0100 (Wed, 02 Nov 2005) | 2 lines

* stacksize fixes for freebsd

........
r1631 | jonas | 2005-11-02 16:11:17 +0100 (Wed, 02 Nov 2005) | 2 lines

+ test for new inlining (fails currently)

........
r1632 | tom_at_work | 2005-11-02 20:55:57 +0100 (Wed, 02 Nov 2005) | 1 line

* fixes error introduced in sscanf() when looking for 64 bit unsafe pointer casts
........
r1633 | tom_at_work | 2005-11-02 20:59:17 +0100 (Wed, 02 Nov 2005) | 1 line

* fixed webbug 4201 which does not properly clean up all threads, causing (program) freeze
........

git-svn-id: branches/fixes_2_0@1634 -

peter 20 years ago
parent
commit
f16581d9d1

+ 1 - 0
.gitattributes

@@ -5065,6 +5065,7 @@ tests/test/tinline1.pp svneol=native#text/plain
 tests/test/tinline2.pp svneol=native#text/plain
 tests/test/tinline2.pp svneol=native#text/plain
 tests/test/tinline3.pp svneol=native#text/plain
 tests/test/tinline3.pp svneol=native#text/plain
 tests/test/tinline4.pp svneol=native#text/plain
 tests/test/tinline4.pp svneol=native#text/plain
+tests/test/tinline5.pp -text
 tests/test/tint641.pp svneol=native#text/plain
 tests/test/tint641.pp svneol=native#text/plain
 tests/test/tint642.pp svneol=native#text/plain
 tests/test/tint642.pp svneol=native#text/plain
 tests/test/tint643.pp svneol=native#text/plain
 tests/test/tint643.pp svneol=native#text/plain

+ 5 - 0
fcl/tests/testz.pp

@@ -18,6 +18,9 @@ begin
    writeln ('End of write');
    writeln ('End of write');
    C.Free;
    C.Free;
    writeln ('freed CompressionStream');
    writeln ('freed CompressionStream');
+   F.Free;
+   writeln ('freed FileStream');
+
    Writeln ('Start Reading');
    Writeln ('Start Reading');
    F:=TFileStream.Create('ztest.dat',FMOpenRead);
    F:=TFileStream.Create('ztest.dat',FMOpenRead);
    Writeln ('Created filestream');
    Writeln ('Created filestream');
@@ -31,4 +34,6 @@ begin
    writeln ('End of Read');
    writeln ('End of Read');
    D.Free;
    D.Free;
    writeln ('freed CompressionStream');
    writeln ('freed CompressionStream');
+   F.Free;
+   writeln ('freed FileStream');
 end.
 end.

+ 4 - 3
rtl/freebsd/tthread.inc

@@ -185,7 +185,8 @@ begin
 end;
 end;
 
 
 { TThread }
 { TThread }
-constructor TThread.Create(CreateSuspended: Boolean);
+constructor TThread.Create(CreateSuspended: Boolean;
+                           const StackSize: DWord = DefaultStackSize);
 begin
 begin
   // lets just hope that the user doesn't create a thread
   // lets just hope that the user doesn't create a thread
   // via BeginThread and creates the first TThread Object in there!
   // via BeginThread and creates the first TThread Object in there!
@@ -196,8 +197,8 @@ begin
   FSuspendedExternal := false;
   FSuspendedExternal := false;
   FInitialSuspended := CreateSuspended;
   FInitialSuspended := CreateSuspended;
   FFatalException := nil;
   FFatalException := nil;
-  WRITE_DEBUG('creating thread, self = ',longint(self));
-  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
+  WRITE_DEBUG('creating thread, self = ',PtrInt(self));
+  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID,StackSize);
   WRITE_DEBUG('TThread.Create done');
   WRITE_DEBUG('TThread.Create done');
 end;
 end;
 
 

+ 1 - 1
rtl/inc/cgeneric.inc

@@ -73,7 +73,7 @@ begin
   { unsigned)                                                       }
   { unsigned)                                                       }
   res := memchr(buf,longint(b),cardinal(len));
   res := memchr(buf,longint(b),cardinal(len));
   if (res <> nil) then
   if (res <> nil) then
-    IndexChar := longint(res-@buf)
+    IndexChar := SizeInt(res-@buf)
   else
   else
     IndexChar := -1;
     IndexChar := -1;
 end;
 end;

+ 5 - 5
rtl/inc/getopts.pp

@@ -97,16 +97,16 @@ begin
   repeat
   repeat
   { skip leading spaces }
   { skip leading spaces }
     while cmdline^ in [' ',#9,#13] do
     while cmdline^ in [' ',#9,#13] do
-     inc(longint(cmdline));
+     inc(PtrInt(cmdline));
     case cmdline^ of
     case cmdline^ of
       #0 : break;
       #0 : break;
      '"' : begin
      '"' : begin
              quote:=['"'];
              quote:=['"'];
-             inc(longint(cmdline));
+             inc(PtrInt(cmdline));
            end;
            end;
     '''' : begin
     '''' : begin
              quote:=[''''];
              quote:=[''''];
-             inc(longint(cmdline));
+             inc(PtrInt(cmdline));
            end;
            end;
     else
     else
      quote:=[' ',#9,#13];
      quote:=[' ',#9,#13];
@@ -114,7 +114,7 @@ begin
   { scan until the end of the argument }
   { scan until the end of the argument }
     argstart:=cmdline;
     argstart:=cmdline;
     while (cmdline^<>#0) and not(cmdline^ in quote) do
     while (cmdline^<>#0) and not(cmdline^ in quote) do
-     inc(longint(cmdline));
+     inc(PtrInt(cmdline));
   { reserve some memory }
   { reserve some memory }
     arglen:=cmdline-argstart;
     arglen:=cmdline-argstart;
     getmem(argsbuf[count],arglen+1);
     getmem(argsbuf[count],arglen+1);
@@ -122,7 +122,7 @@ begin
     argsbuf[count][arglen]:=#0;
     argsbuf[count][arglen]:=#0;
   { skip quote }
   { skip quote }
     if cmdline^ in quote then
     if cmdline^ in quote then
-     inc(longint(cmdline));
+     inc(PtrInt(cmdline));
     inc(count);
     inc(count);
   until false;
   until false;
 { create argc }
 { create argc }

+ 1 - 0
rtl/inc/variant.inc

@@ -120,6 +120,7 @@ procedure fpc_vararray_put(var d : variant;const s : variant;indices : psizeint;
 
 
 function fpc_variant_to_dynarray(const v : variant;typeinfo : pointer) : pointer;compilerproc;
 function fpc_variant_to_dynarray(const v : variant;typeinfo : pointer) : pointer;compilerproc;
   begin
   begin
+    result:=nil;
     variantmanager.vartodynarray(result,v,typeinfo);
     variantmanager.vartodynarray(result,v,typeinfo);
   end;
   end;
 
 

+ 1 - 1
rtl/linux/ostypes.inc

@@ -207,7 +207,7 @@ type
    TTms      = tms;
    TTms      = tms;
    PTms      = ^tms;
    PTms      = ^tms;
 
 
- TFDSet    = ARRAY[0..(FD_MAXFDSET div 32)-1] of Cardinal;
+ TFDSet    = ARRAY[0..(FD_MAXFDSET div BITSINWORD)-1] of cLong;
  pFDSet    = ^TFDSet;
  pFDSet    = ^TFDSet;
 
 
   timezone = packed record
   timezone = packed record

+ 1 - 1
rtl/linux/tthread.inc

@@ -197,7 +197,7 @@ begin
   FSuspendedExternal := false;
   FSuspendedExternal := false;
   FInitialSuspended := CreateSuspended;
   FInitialSuspended := CreateSuspended;
   FFatalException := nil;
   FFatalException := nil;
-  WRITE_DEBUG('creating thread, self = ',longint(self));
+  WRITE_DEBUG('creating thread, self = ', PtrInt(self));
   FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID, StackSize);
   FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID, StackSize);
   WRITE_DEBUG('TThread.Create done');
   WRITE_DEBUG('TThread.Create done');
 end;
 end;

+ 4 - 4
rtl/linux/unixsock.inc

@@ -48,9 +48,9 @@ Const
   Socket_Sys_RECVMSG     = 17;
   Socket_Sys_RECVMSG     = 17;
 
 
 
 
-Function SocketCall(SockCallNr,a1,a2,a3,a4,a5,a6:longint):longint;
+Function SocketCall(SockCallNr,a1,a2,a3,a4,a5,a6:TSysParam):longint;
 var
 var
-  Args:array[1..6] of longint;
+  Args:array[1..6] of TSysParam;
 begin
 begin
   args[1]:=a1;
   args[1]:=a1;
   args[2]:=a2;
   args[2]:=a2;
@@ -58,7 +58,7 @@ begin
   args[4]:=a4;
   args[4]:=a4;
   args[5]:=a5;
   args[5]:=a5;
   args[6]:=a6;
   args[6]:=a6;
-  SocketCall:=do_Syscall(syscall_nr_socketcall,sockcallnr,longint(@args));
+  SocketCall:=do_Syscall(syscall_nr_socketcall,sockcallnr,TSysParam(@args));
   If SocketCall<0 then
   If SocketCall<0 then
    SocketError:=fpgetErrno
    SocketError:=fpgetErrno
   else
   else
@@ -66,7 +66,7 @@ begin
 end;
 end;
 
 
 
 
-function SocketCall(SockCallNr,a1,a2,a3:longint):longint;
+function SocketCall(SockCallNr,a1,a2,a3:TSysParam):longint;
 begin
 begin
   SocketCall:=SocketCall(SockCallNr,a1,a2,a3,0,0,0);
   SocketCall:=SocketCall(SockCallNr,a1,a2,a3,0,0,0);
 end;
 end;

+ 1 - 1
rtl/objpas/sysutils/sysstr.inc

@@ -2217,7 +2217,7 @@ function sscanf(const s: string; const fmt : string;const Pointers : array of Po
             begin
             begin
               if GetInt>0 then
               if GetInt>0 then
                 begin
                 begin
-                  plongint(Pointers[i])^:=StrToInt(s1);
+                  pLongint(Pointers[i])^:=StrToInt(s1);
                   inc(Result);
                   inc(Result);
                 end
                 end
               else
               else

+ 43 - 0
tests/test/tinline5.pp

@@ -0,0 +1,43 @@
+{$inline on}
+{$mode objfpc}
+
+type
+  tc = class
+    lf: longint;
+    procedure t(const l: longint); inline;
+  end;
+
+var
+  a: longint;
+
+procedure tc.t(const l: longint); inline;
+begin
+  lf := 10;
+  if (l <> 5) then
+    begin
+      writeln('error class');
+      halt(1);
+    end;
+end;
+
+
+procedure t(const l: longint); inline;
+begin
+  a := 10;
+  if (l <> 5) then
+    begin
+      writeln('error proc');
+      halt(1);
+    end;
+end;
+
+var
+  c: tc;
+
+begin
+  c := tc.create;
+  c.lf := 5;
+  c.t(c.lf);
+  a := 5;
+  t(a);
+end.

+ 2 - 0
tests/webtbs/tw4201.pp

@@ -72,4 +72,6 @@ begin
   t:= TBuggedThread.Create;
   t:= TBuggedThread.Create;
 
 
   t.Execute;
   t.Execute;
+  
+  t.Free();
 end.
 end.