Hello, before reporting a bug, I'm asking for support here since I'm not
sure I doing something wrong (and if so what am I doing wrong).
While using synapse in a thread, I saw that it didn't report an error on
connection, eventually I saw that the call to WSAGetLastError was
returning 0 even if it couldn't connect and the connect call returned an
error.
I found bug 10205 (http://bugs.freepascal.org/view.php?id=10205) but in
my case there is no direct writeln in sight (side note: why isn't it
possible to add a note to a closed bug?).
Oddly enough, a slightly modified threadwsagetlast (attached as
project3.lpr) from the one in the bug report works as expected, while my
thread (now using directly the sockets unit, not wrapped by synapse)
still reports 0.
The attached project2.lpr has a connection to a non existent host/port
in a thread and outside the thread, and it both cases it reports 0
(UseSynchronize true or false doesn't make a difference), and while
reduced to the minimum it has the same structure of the thread I'm
actually going to use.
project3.lpr is adapted from the bug report and correctly reports 10060
(connection timed out), but I cannot really see the difference between
one and the other (besides the fact that mine uses methods and the other
uses procedures defined outside the class, but that shouldn't really
matter, should it?)
Note that project3 uses deprecated sockets procedures, while mine uses
the "correc" fp prefixed ones, but I tried with the deprecated ones
before with the same result.
This is under windows with fpc 2.2.0 (coming from a lazarus snapshot),
the original problem with synapse was with a lazarus snapshot with 2.2.1
(hence I went back to 2.2.0 to see if it was a regression in 2.2.1).
Bye
--
Luca
program project2;
{$mode objfpc}{$H+}
uses
sockets, Classes;
type
{ TInlineSocketThread }
TNotifyError = procedure (m:string;n:integer) of object;
TSocketThread = class(TThread)
private
FAddress:string;
FPort:integer;
FErrMessage:string;
FErrNum:integer;
FUseSynchronize:boolean;
FFinished:boolean;
FOnError:TNotifyError;
procedure SyncProcError;
procedure ErrMsg(m:string;n:integer);
public
constructor Create(Address:string; Port:integer; 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:string; Port:integer; 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:LongInt;
SAddr:TInetSockAddr;
Connected:boolean;
procedure PError(msg:string);
var e:integer;
begin
e:=SocketError;
if Connected then fpShutdown(s,2);
CloseSocket(s);
Connected:=false;
ErrMsg(msg,e);
end;
begin
Connected:=false;
S:=fpSocket(AF_INET,SOCK_STREAM,0);
if SocketError=0 then
begin
SAddr.sin_family:=AF_INET;
Saddr.sin_port:=htons(FPort);
SAddr.sin_addr.s_addr:=StrToNetAddr(FAddress).s_addr;
if fpconnect(S,@SAddr,SizeOf(SAddr))=0 then
Connected:=true else
PError('connect');
end;
if Connected then fpShutdown(s,2);
CloseSocket(s);
FFinished:=True;
end;
procedure SocketNoThread(FAddress:string;FPort:integer);
var s:LongInt;
SAddr:TInetSockAddr;
Connected:boolean;
procedure PError(msg:string);
var e:integer;
begin
e:=SocketError;
if Connected then fpShutdown(s,2);
CloseSocket(s);
Connected:=false;
Writeln(msg,' ',e);
end;
begin
Connected:=false;
S:=fpSocket(AF_INET,SOCK_STREAM,0);
if SocketError=0 then
begin
SAddr.sin_family:=AF_INET;
Saddr.sin_port:=htons(FPort);
SAddr.sin_addr.s_addr:=StrToNetAddr(FAddress).s_addr;
if fpconnect(S,@SAddr,SizeOf(SAddr))=0 then
Connected:=true else
PError('connect');
end;
if Connected then fpShutdown(s,2);
CloseSocket(s);
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('begin');
Test:=TTest.Create;
while not Test.FSocketThread.Finished do CheckSynchronize(100);
Writeln('thread finished');
Writeln('Not in a thread');
SocketNoThread('1.2.3.4',1000);
end.
program test; {$mode objfpc} {$H+}
uses sockets, sysutils, classes;
procedure perror (const s: string);
var e:integer;
begin
// if cannot bind to port 80, should report 10048
e:=SocketError;
writeln ('ERROR: ', S, e);
end;
procedure socktest;
var
S : Longint;
SAddr : TInetSockAddr;
begin
S:=Socket (AF_INET,SOCK_STREAM,0);
if SocketError<>0 then Perror ('Socket : ');
SAddr.sin_family:=AF_INET;
{ port 80 in network order }
SAddr.sin_port:=htons(2000);
SAddr.sin_addr.s_addr:=StrToNetAddr('1.2.3.4').s_addr;
if not sockets.Connect(S,SAddr,sizeof(saddr)) then PError ('Connect : ') else
Writeln('Connected!');
end;
type
{ TTestThread }
TTestThread = class(TThread)
public
Finished:boolean;
procedure execute;override;
end;
{ TTestThread }
procedure TTestThread.execute;
begin
SockTest;
Finished:=true;
end;
procedure threadtest;
var t:array[1..3] of TTestThread;
i:integer;
finito:boolean;
begin
for i:=1 to 3 do
begin
T[i]:=TTestThread.Create(false);
writeln('Thread ',i,' created');
sleep(1000);
end;
finito:=false;
while not finito do
begin
finito:=true;
for i:=1 to 3 do finito:=finito and t[i].finished;
end;
end;
begin
writeln;
writeln('Testing WSAGetLastError inside thread...');
writeln;
ThreadTest(); // comment this line out and you do get 10048 further below
end.
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
