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

Reply via email to