En/na Luca Olivetti ha escrit:
En/na L ha escrit:
Found the problem using my brute force writeln('') skills. It is an
issue with freepascal's stack or something to do with buggy threads
methinks. As it is when you call lasterror within another procedure
with local variables.. they are corrupted or something.
Aha.. I changed the by Value parameter to a CONST parameter in the
error procedure (Perror).. And this solves the issue..
So something to do with calling by Value within a thread versus a
const (pointer?).
This seriously worries me, since I use threads extensively, and I mostly
use call by value parameters.
I finally had time to test this (do you remember that dilber strip where
he asks his PHB which one of the 3 projects he's juggling should be
finished on schedule, and the PHB replies he should finish them all on
schedule? well, I'm pretty much in the same situation now).
Changing my "procedure PError(msg:string)" to "procedure PError(const
msg:string)" in TSocketThread.Execute in project2 also fixes the problem.
This smells like a bug somewhere in fpc/rtl, since I don't think it
should make a difference.
Anyway, this gives me no clue on how to "fix" synapse.
Synapse does this:
function TBlockSocket.SockCheck(SockResult: Integer): Integer;
begin
ResetLastError;
if SockResult = integer(SOCKET_ERROR) then
begin
FLastError := synsock.WSAGetLastError;
FLastErrorDesc := GetErrorDescEx;
end;
Result := FLastError;
end;
then in a connect it wraps the connect call in SockCheck:
procedure TBlockSocket.Connect(IP, Port: string);
var
Sin: TVarSin;
begin
SetSin(Sin, IP, Port);
if FLastError = 0 then
begin
if FSocket = INVALID_SOCKET then
InternalCreateSocket(Sin);
SockCheck(synsock.Connect(FSocket, Sin));
if FLastError = 0 then
GetSins;
FBuffer := '';
FLastCR := False;
FLastLF := False;
end;
ExceptCheck;
DoStatus(HR_Connect, IP + ':' + Port);
end;
Changing
function TBlockSocket.SockCheck(SockResult: Integer): Integer;
to
function TBlockSocket.SockCheck(const SockResult: Integer): Integer;
does nothing.
Moreover, something really fishy is going on: look at the attached
project4 (now using synapse).
First I try outside a thread, and it correctly reports error 10060, then
inside a thread, where it reports 0, then again outside the thread (same
procedure) and this time it reports 0!
What's going on?
Bye
--
Luca
program project4;
{$mode objfpc}{$H+}
uses
blcksock, Classes;
type
{ TInlineSocketThread }
TNotifyError = procedure (m:string;n:integer) of object;
TSocketThread = class(TThread)
private
FAddress:string;
FPort:string;
FErrMessage:string;
FErrNum:integer;
FUseSynchronize:boolean;
FFinished:boolean;
FOnError:TNotifyError;
procedure SyncProcError;
procedure ErrMsg(m:string;n:integer);
public
constructor Create(Address, Port:string; UseSynchronize:boolean);
destructor Destroy;override;
procedure Execute;override;
property OnError:TNotifyError read FOnError write FOnError;
property Finished:boolean read FFinished;
end;
{ TSocketThread }
procedure TSocketThread.SyncProcError;
begin
if Assigned(FOnError) then FOnError(FErrMessage,FErrNum);
end;
procedure TSocketThread.ErrMsg(m: string;n:integer);
begin
if not Assigned(FOnError) then exit;
FErrMessage:=m;
FErrNum:=n;
if FUseSynchronize then Synchronize(@SyncProcError) else SyncProcError;
end;
constructor TSocketThread.Create(Address,Port:string; UseSynchronize: boolean);
begin
FAddress:=Address;
FPort:=Port;
FUseSynchronize:=UseSynchronize;
inherited create(true); //create suspended
end;
destructor TSocketThread.Destroy;
begin
terminate;
while not FFinished do
CheckSynchronize(100);
inherited Destroy;
end;
procedure TSocketThread.Execute;
var s:TTCPBlockSocket;
Connected:boolean;
procedure PError(const msg:string);
var e:integer;
begin
e:=s.LastError;
if Connected then s.CloseSocket;
Connected:=false;
ErrMsg(msg,e);
end;
begin
Connected:=false;
S:=TTCPBlockSocket.create;
S.Connect(FAddress,FPort);
if S.LastError=0 then
begin
connected:=true;
ErrMsg('connected',0);
end else
begin
Perror('connect');
end;
if Connected then
S.CloseSocket;
FFinished:=True;
end;
procedure SocketNoThread(FAddress,FPort:string);
var s:TTcpBlockSocket;
Connected:boolean;
procedure PError(msg:string);
var e:integer;
begin
e:=s.LastError;
if Connected then s.CloseSocket;
Connected:=false;
Writeln(msg,' ',e);
end;
begin
Connected:=false;
S:=TTCPBlockSocket.create;
S.Connect(FAddress,FPort);
if S.LastError=0 then
begin
writeln('connected');
end else
begin
PError('connect');
end;
if Connected then S.CloseSocket;
end;
{ TTest }
type
TTest=class
FSocketThread:TsocketThread;
procedure SockError(m:string;n:integer);
constructor Create;
destructor Destroy;override;
end;
{ TTest }
procedure TTest.SockError(m: string;n:integer);
begin
writeln(m,' ',n);
end;
constructor TTest.Create;
begin
FSocketThread:=TSocketThread.Create('1.2.3.4','1000',true);
FSocketThread.OnError:[EMAIL PROTECTED];
FSocketThread.Resume;
writeln('Thread started');
end;
destructor TTest.Destroy;
begin
FSocketThread.Free;
inherited Destroy;
end;
var Test:TTest;
begin
Writeln('Each try should report "connect 10060"');
Writeln('First try, no thread');
SocketNoThread('1.2.3.4','1000');
Writeln('Second try, in thread');
Test:=TTest.Create;
while not Test.FSocketThread.Finished do CheckSynchronize(100);
Writeln('thread finished');
Writeln('Third try, no thread');
SocketNoThread('1.2.3.4','1000');
end.
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
