Related to thread: "Strange ICS application issue (MadExcept report)"
http://marc.info/?l=twsocket&m=129137495622903&w=2
{code}
program SslContextFreeNotificationTest;
{ Test case thread-safe TSslContext.FreeNotification and
TSslContext.RemoveFreeNotification.
Requires at least ICSv7 SVN revision #642 (December 07, 2010).
See comments in source code below. }
{$APPTYPE CONSOLE}
{$IFNDEF USE_SSL}
{$MESSAGE ERROR 'Define "USE_SSL" in the project options!'}
{$ENDIF}
uses
SysUtils, Classes, OverbyteIcsWSocket;
{$IF WSocketVersion < 754}
{$MESSAGE ERROR 'This test requires at least ICSv7 SVN revision #642'}
{$IFEND}
type
TTestThread = class(TThread)
protected
procedure Execute; override;
end;
var
SharedSslContext : TSslContext;
{ TTestThread }
procedure TTestThread.Execute;
var
I, J: Integer;
SslWSockets: array [0..19] of TSslWSocket;
begin
inherited;
for I := 1 to 200 do
begin
FillChar(SslWSockets, SizeOf(SslWSockets), 0);
try
for J := Low(SslWSockets) to High(SslWSockets) do
begin
SslWSockets[J] := TSslWSocket.Create(nil);
SslWSockets[J].SslContext := SharedSslContext;
end;
finally
for J := Low(SslWSockets) to High(SslWSockets) do
SslWSockets[J].Free;
end;
end;
end;
var
I: Integer;
Threads: array [0..19] of TTestThread;
begin
try
FillChar(Threads, SizeOf(Threads), 0);
SharedSslContext := nil;
try
{ Provided that the shared SslContext will NEVER be freed while
SslWSockets in a different thread context hold a reference to it
FreeNotification and RemoveFreeNotification of TSslContext should
work across multiple threads safely. }
SharedSslContext := TSslContext.Create(nil);
for I := Low(Threads) to High(Threads) do
Threads[I] := TTestThread.Create(False);
WriteLn('Waiting for threads to finish, this may take some seconds..');
finally
for I := Low(Threads) to High(Threads) do
Threads[I].Free;
{ Make sure that the shared SslContext is only ever freed after all
threads are finished. }
SharedSslContext.Free;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
{code}
--
To unsubscribe or change your settings for TWSocket mailing list
please goto http://lists.elists.org/cgi-bin/mailman/listinfo/twsocket
Visit our website at http://www.overbyte.be