diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas
index 96987e733..3131a9b77 100644
--- a/wst/trunk/base_service_intf.pas
+++ b/wst/trunk/base_service_intf.pas
@@ -92,6 +92,7 @@ type
IItemFactoryEx = interface(IItemFactory)
['{66B77926-7E45-4780-8FFB-FB78625EDC1D}']
procedure ReleaseInstance(const AInstance : IInterface);
+ procedure DiscardInstance(const AInstance : IInterface);
function GetPropertyManager(
const APropertyGroup : string;
const ACreateIfNotExists : Boolean
@@ -1042,7 +1043,7 @@ type
FMin : PtrInt;
FMax : PtrInt;
private
- function CreateNew() : TIntfPoolItem;
+ function CreateNew(const AUsed : Boolean) : TIntfPoolItem;
function TryGet(const AIndex : PtrInt) : Boolean;
public
constructor Create(
@@ -1052,6 +1053,8 @@ type
destructor Destroy();override;
function Get(const ATimeOut : Cardinal) : IInterface;
procedure Release(const AItem : IInterface);
+ procedure Discard(const AItem : IInterface);
+ function GetInstancesCount() : PtrInt;
property Min : PtrInt read FMin;
property Max : PtrInt read FMax;
end;
@@ -1075,6 +1078,7 @@ type
protected
function CreateInstance():IInterface;override;
procedure ReleaseInstance(const AInstance : IInterface);virtual;
+ procedure DiscardInstance(const AInstance : IInterface);virtual;
function GetPropertyManager(
const APropertyGroup : string;
const ACreateIfNotExists : Boolean
@@ -2153,6 +2157,12 @@ begin
end;
end;
+procedure TSimpleItemFactoryEx.DiscardInstance(const AInstance : IInterface);
+begin
+ if Pooled then
+ FPool.Discard(AInstance);
+end;
+
function TSimpleItemFactoryEx.GetPropertyManager(
const APropertyGroup : string;
const ACreateIfNotExists : Boolean
@@ -4303,7 +4313,7 @@ end;
constructor TIntfPoolItem.Create(AIntf: IInterface; const AUsed: Boolean);
begin
- FIntf := AIntf;
+ FIntf := AIntf as IInterface;
FUsed := AUsed;
end;
@@ -4315,11 +4325,11 @@ end;
{ TIntfPool }
-function TIntfPool.CreateNew(): TIntfPoolItem;
+function TIntfPool.CreateNew(const AUsed : Boolean): TIntfPoolItem;
begin
FCS.Acquire();
try
- Result := TIntfPoolItem.Create(FFactory.CreateInstance(),True);
+ Result := TIntfPoolItem.Create(FFactory.CreateInstance(),AUsed);
FList.Add(Result);
finally
FCS.Release();
@@ -4349,7 +4359,8 @@ constructor TIntfPool.Create(
var
i : PtrInt;
begin
- Assert( ( AMin >= 0 ) and ( AMax >= AMin ) and ( AFactory <> nil ) );
+ if not ( ( AMin >= 0 ) and ( AMax >= AMin ) and ( AFactory <> nil ) ) then
+ raise Exception.CreateFmt('Invalid pool arguments Min = %d; Max = %d .',[AMin,AMax]);
FMax := AMax;
FMin := AMin;
FFactory := AFactory;
@@ -4357,7 +4368,7 @@ begin
FList := TObjectList.Create(True);
FCS := TCriticalSection.Create();
for i := 0 to Pred(AMin) do begin
- CreateNew();
+ CreateNew(False);
end;
end;
@@ -4383,7 +4394,7 @@ begin
end;
end;
if ( Result = nil ) then begin
- Result := CreateNew().Intf;
+ Result := CreateNew(True).Intf;
end;
end else begin
raise EServiceException.Create('Unable to create the object : Timeout expired.');
@@ -4393,9 +4404,11 @@ end;
procedure TIntfPool.Release(const AItem: IInterface);
var
i : PtrInt;
+ a : IInterface;
begin
+ a := AItem as IInterface;
for i := 0 to Pred(FList.Count) do begin
- if ( TIntfPoolItem(FList[i]).Intf = AItem ) then begin
+ if ( TIntfPoolItem(FList[i]).Intf = a ) then begin
TIntfPoolItem(FList[i]).Used := False;
FLock.Release();
Break;
@@ -4403,6 +4416,34 @@ begin
end;
end;
+procedure TIntfPool.Discard(const AItem : IInterface);
+var
+ i : PtrInt;
+ a : IInterface;
+ itm : TIntfPoolItem;
+begin
+ a := AItem as IInterface;
+ for i := 0 to Pred(FList.Count) do begin
+ if ( TIntfPoolItem(FList[i]).Intf = a ) then begin
+ itm := TIntfPoolItem(FList[i]);
+ itm.FIntf := FFactory.CreateInstance() as IInterface;
+ itm.Used := False;
+ FLock.Release();
+ Break;
+ end;
+ end;
+end;
+
+function TIntfPool.GetInstancesCount() : PtrInt;
+begin
+ FCS.Acquire();
+ try
+ Result := FList.Count;
+ finally
+ FCS.Release();
+ end;
+end;
+
{ TStringBufferRemotable }
class procedure TStringBufferRemotable.Save (
diff --git a/wst/trunk/samples/http_server/http_server.lpi b/wst/trunk/samples/http_server/http_server.lpi
index dd6e93ab1..70e580307 100644
--- a/wst/trunk/samples/http_server/http_server.lpi
+++ b/wst/trunk/samples/http_server/http_server.lpi
@@ -12,7 +12,7 @@
-
+
@@ -34,15 +34,15 @@
-
+
-
-
+
+
-
+
@@ -50,15 +50,15 @@
-
+
-
-
+
+
-
+
@@ -67,7 +67,7 @@
-
+
@@ -75,34 +75,34 @@
-
+
-
+
-
+
-
-
+
+
-
+
-
+
-
+
@@ -111,23 +111,23 @@
-
+
-
-
-
+
+
+
-
-
+
+
-
+
@@ -135,171 +135,171 @@
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
@@ -307,20 +307,20 @@
-
+
-
+
-
+
@@ -328,7 +328,7 @@
-
+
@@ -336,7 +336,7 @@
-
+
@@ -344,14 +344,14 @@
-
+
-
+
@@ -361,7 +361,7 @@
-
+
@@ -370,7 +370,7 @@
-
+
@@ -380,7 +380,7 @@
-
+
@@ -388,7 +388,7 @@
-
+
@@ -396,44 +396,171 @@
-
+
-
+
-
+
-
+
-
+
-
-
+
+
-
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wst/trunk/server_service_intf.pas b/wst/trunk/server_service_intf.pas
index 079c95dd3..faae0f0d6 100644
--- a/wst/trunk/server_service_intf.pas
+++ b/wst/trunk/server_service_intf.pas
@@ -191,6 +191,7 @@ Type
IServiceImplementationFactory
)
protected
+ procedure ReleaseInstance(const AInstance : IInterface);override;
procedure RegisterExtension(
const AExtensionList : array of string
);
@@ -679,6 +680,20 @@ end;
{ TImplementationFactory }
const sSERVICES_EXTENSIONS = 'extensions';sLIST = 'list';
+procedure TImplementationFactory.ReleaseInstance(const AInstance : IInterface);
+var
+ objCtrl : IObjectControl;
+begin
+ if Pooled and
+ Supports(AInstance,IObjectControl,objCtrl) and
+ ( not objCtrl.CanBePooled() )
+ then begin
+ DiscardInstance(AInstance);
+ end else begin
+ inherited ReleaseInstance(AInstance);
+ end;
+end;
+
procedure TImplementationFactory.RegisterExtension(
const AExtensionList : array of string
);
diff --git a/wst/trunk/tests/test_suite/test_utilities.pas b/wst/trunk/tests/test_suite/test_utilities.pas
new file mode 100644
index 000000000..8693ecd1a
--- /dev/null
+++ b/wst/trunk/tests/test_suite/test_utilities.pas
@@ -0,0 +1,448 @@
+unit test_utilities;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, fpcunit, testutils, testregistry,
+ TypInfo,
+ base_service_intf, server_service_intf;
+
+type
+
+ ITest = interface
+ ['{61442DCF-0F6B-490F-AA33-FF856C07A757}']
+ procedure SayHello();
+ procedure DontPool();
+ end;
+
+ { TTestClass }
+
+ TTestClass = class(TActivableServiceImplementation,IObjectControl,ITest)
+ private
+ FPooled : Boolean;
+ protected
+ procedure SayHello();
+ function CanBePooled() : Boolean;
+ procedure DontPool();
+ public
+ constructor Create();override;
+ end;
+
+
+ { TTest_TIntfPool }
+
+ TTest_TIntfPool= class(TTestCase)
+ published
+ procedure Create_ZEROS();
+ procedure Create_NON_ZERO_MIN();
+ procedure Release();
+ procedure Release_NON();
+ procedure Discard();
+ end;
+
+ { TTest_TSimpleItemFactoryEx }
+
+ TTest_TSimpleItemFactoryEx = class(TTestCase)
+ published
+ procedure NOT_Pooled();
+ procedure POOLED_Create_ZEROS();
+ procedure POOLED_Release();
+ procedure POOLED_Release_NON();
+ procedure POOLED_Discard();
+ end;
+
+ { TTest_TImplementationFactory }
+
+ TTest_TImplementationFactory = class(TTestCase)
+ published
+ procedure POOLED_Discard();
+ end;
+
+implementation
+
+{ TTestClass }
+
+procedure TTestClass.SayHello();
+begin
+
+end;
+
+function TTestClass.CanBePooled() : Boolean;
+begin
+ Result := FPooled;
+end;
+
+procedure TTestClass.DontPool();
+begin
+ FPooled := False;
+end;
+
+constructor TTestClass.Create();
+begin
+ inherited Create();
+ FPooled := True;
+ _AddRef(); // not to allow the rtl to reuse the same memory for another instance of the same class!!
+end;
+
+{ TTest_TIntfPool }
+
+procedure TTest_TIntfPool.Create_ZEROS();
+var
+ ok : Boolean;
+ obj : TIntfPool;
+begin
+ ok := False;
+ try
+ obj := TIntfPool.Create(0,0,TSimpleItemFactory.Create(TTestClass));
+ except
+ ok := True;
+ end;
+ Check(ok);
+end;
+
+procedure TTest_TIntfPool.Create_NON_ZERO_MIN();
+const MIN_A = Integer(1); MAX_A = Integer(5);
+var
+ obj : TIntfPool;
+begin
+ obj := TIntfPool.Create(MIN_A,MAX_A,TSimpleItemFactory.Create(TTestClass));
+ CheckEquals(MIN_A,obj.Min);
+ CheckEquals(MAX_A,obj.Max);
+ CheckEquals(MIN_A,obj.GetInstancesCount());
+end;
+
+procedure TTest_TIntfPool.Release();
+const MIN_A = Integer(1); MAX_A = Integer(5); MIN_B = Integer(0);
+var
+ obj : TIntfPool;
+ elt : ITest;
+ i : Integer;
+begin
+ obj := TIntfPool.Create(MIN_A,MAX_A,TSimpleItemFactory.Create(TTestClass));
+ for i := 0 to 300 do begin
+ elt := obj.Get(0) as ITest;
+ elt.SayHello();
+ obj.Release(elt);
+ end;
+
+ FreeAndNil(obj);
+ obj := TIntfPool.Create(MIN_B,MAX_A,TSimpleItemFactory.Create(TTestClass));
+ for i := 0 to 300 do begin
+ elt := obj.Get(0) as ITest;
+ elt.SayHello();
+ obj.Release(elt);
+ end;
+
+ FreeAndNil(obj);
+ obj := TIntfPool.Create(MAX_A,MAX_A,TSimpleItemFactory.Create(TTestClass));
+ for i := 0 to 300 do begin
+ elt := obj.Get(0) as ITest;
+ elt.SayHello();
+ obj.Release(elt);
+ end;
+end;
+
+procedure TTest_TIntfPool.Release_NON();
+const MIN_A = Integer(1); MAX_A = Integer(5); MIN_B = Integer(0);
+var
+ obj : TIntfPool;
+ elt : ITest;
+ i : Integer;
+ ok : Boolean;
+ il : IInterfaceList;
+begin
+ il := TInterfaceList.Create();
+ obj := TIntfPool.Create(MIN_A,MAX_A,TSimpleItemFactory.Create(TTestClass));
+ for i := 1 to MAX_A do begin
+ elt := obj.Get(100) as ITest;
+ elt.SayHello();
+ il.Add(elt);
+ //obj.Release(elt); do not release
+ end;
+ ok := False;
+ try
+ elt := obj.Get(100) as ITest;
+ except
+ ok := True;
+ end;
+ Check(ok);
+ CheckEquals(MAX_A,obj.GetInstancesCount());
+ for i := 0 to Pred(MAX_A) do begin
+ obj.Release(il[0]);
+ il.Delete(0);
+ end;
+
+ for i := 1 to 100 do begin
+ elt := obj.Get(100) as ITest;
+ elt.SayHello();
+ il.Add(elt);
+ obj.Release(elt);
+ end;
+end;
+
+procedure TTest_TIntfPool.Discard();
+const MIN_A = Integer(1); MAX_A = Integer(5); MIN_B = Integer(0);
+var
+ obj : TIntfPool;
+ oldElt, elt : ITest;
+begin
+ obj := TIntfPool.Create(MIN_A,MIN_A,TSimpleItemFactory.Create(TTestClass));
+ elt := obj.Get(10) as ITest;
+ oldElt := elt;
+ obj.Release(elt);
+ elt := obj.Get(10) as ITest;
+ Check(oldElt = elt);
+ obj.Discard(elt);
+ elt := obj.Get(10) as ITest;
+ Check(oldElt <> elt );
+
+ FreeAndNil(obj);oldElt := nil; elt := nil;
+ obj := TIntfPool.Create(MIN_A,MAX_A,TSimpleItemFactory.Create(TTestClass));
+ elt := obj.Get(10) as ITest;
+ oldElt := elt;
+ obj.Release(elt);
+ elt := obj.Get(10) as ITest;
+ Check(oldElt = elt);
+ obj.Discard(elt);
+ elt := obj.Get(10) as ITest;
+ Check(oldElt <> elt );
+
+ FreeAndNil(obj);oldElt := nil; elt := nil;
+ obj := TIntfPool.Create(MIN_B,MIN_A,TSimpleItemFactory.Create(TTestClass));
+ elt := obj.Get(10) as ITest;
+ oldElt := elt;
+ obj.Release(elt);
+ elt := obj.Get(10) as ITest;
+ Check(oldElt = elt);
+ obj.Discard(elt);
+ elt := obj.Get(10) as ITest;
+ Check(oldElt <> elt );
+
+ FreeAndNil(obj);oldElt := nil; elt := nil;
+ obj := TIntfPool.Create(MIN_B,MAX_A,TSimpleItemFactory.Create(TTestClass));
+ elt := obj.Get(10) as ITest;
+ oldElt := elt;
+ obj.Release(elt);
+ elt := obj.Get(10) as ITest;
+ Check(oldElt = elt);
+ obj.Discard(elt);
+ elt := obj.Get(10) as ITest;
+ Check(oldElt <> elt );
+end;
+
+{ TTest_TSimpleItemFactoryEx }
+
+procedure TTest_TSimpleItemFactoryEx.NOT_Pooled();
+const MIN_A = Integer(1); MAX_A = Integer(5); MIN_B = Integer(0);
+var
+ obj : IItemFactoryEx;
+ elt : ITest;
+ i : Integer;
+begin
+ obj := TSimpleItemFactoryEx.Create(TTestClass);
+ for i := 0 to 300 do begin
+ elt := obj.CreateInstance() as ITest;
+ elt.SayHello();
+ end;
+
+ obj := TSimpleItemFactoryEx.Create(TTestClass,'');
+ for i := 0 to 300 do begin
+ elt := obj.CreateInstance() as ITest;
+ elt.SayHello();
+ end;
+end;
+
+procedure TTest_TSimpleItemFactoryEx.POOLED_Create_ZEROS();
+var
+ ok : Boolean;
+ obj : IItemFactoryEx;
+begin
+ ok := False;
+ try
+ obj := TSimpleItemFactoryEx.Create(TTestClass,Format('PoolMin=%d;PoolMax=%d;Pooled=True',[0,0]));
+ except
+ ok := True;
+ end;
+ Check(ok);
+end;
+
+procedure TTest_TSimpleItemFactoryEx.POOLED_Release();
+const MIN_A = Integer(1); MAX_A = Integer(5); MIN_B = Integer(0);
+var
+ obj : IItemFactoryEx;
+ elt : ITest;
+ i : Integer;
+begin
+ obj := TSimpleItemFactoryEx.Create(TTestClass,Format('PoolMin=%d;PoolMax=%d;Pooled=True',[MIN_A,MAX_A]));
+ for i := 0 to 300 do begin
+ elt := obj.CreateInstance() as ITest;
+ elt.SayHello();
+ obj.ReleaseInstance(elt);
+ end;
+
+ obj := TSimpleItemFactoryEx.Create(TTestClass,Format('PoolMin=%d;PoolMax=%d;Pooled=True',[MIN_B,MAX_A]));
+ for i := 0 to 300 do begin
+ elt := obj.CreateInstance() as ITest;
+ elt.SayHello();
+ obj.ReleaseInstance(elt);
+ end;
+
+ obj := TSimpleItemFactoryEx.Create(TTestClass,Format('PoolMin=%d;PoolMax=%d;Pooled=True',[MAX_A,MAX_A]));
+ for i := 0 to 300 do begin
+ elt := obj.CreateInstance() as ITest;
+ elt.SayHello();
+ obj.ReleaseInstance(elt);
+ end;
+end;
+
+procedure TTest_TSimpleItemFactoryEx.POOLED_Release_NON();
+const MIN_A = Integer(1); MAX_A = Integer(5); MIN_B = Integer(0);
+var
+ obj : IItemFactoryEx;
+ elt : ITest;
+ i : Integer;
+ ok : Boolean;
+ il : IInterfaceList;
+begin
+ il := TInterfaceList.Create();
+ obj := TSimpleItemFactoryEx.Create(TTestClass,Format('PoolMin=%d;PoolMax=%d;TimeOut=100;Pooled=True',[MIN_A,MAX_A]));
+ for i := 1 to MAX_A do begin
+ elt := obj.CreateInstance() as ITest;
+ elt.SayHello();
+ il.Add(elt);
+ //obj.Release(elt); do not release
+ end;
+ ok := False;
+ try
+ elt := obj.CreateInstance() as ITest;
+ except
+ ok := True;
+ end;
+ Check(ok);
+ for i := 0 to Pred(MAX_A) do begin
+ obj.ReleaseInstance(il[0]);
+ il.Delete(0);
+ end;
+
+ for i := 1 to 100 do begin
+ elt := obj.CreateInstance() as ITest;
+ elt.SayHello();
+ il.Add(elt);
+ obj.ReleaseInstance(elt);
+ end;
+end;
+
+procedure TTest_TSimpleItemFactoryEx.POOLED_Discard();
+const MIN_A = Integer(1); MAX_A = Integer(5); MIN_B = Integer(0);
+var
+ obj : IItemFactoryEx;
+ oldElt, elt : ITest;
+begin
+ obj := TSimpleItemFactoryEx.Create(TTestClass,Format('PoolMin=%d;PoolMax=%d;TimeOut=100;Pooled=True',[MIN_A,MIN_A]));
+ elt := obj.CreateInstance() as ITest;
+ oldElt := elt;
+ obj.ReleaseInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt = elt,'1.1');
+ obj.DiscardInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt <> elt, '1.2' );
+
+ oldElt := nil; elt := nil;
+ obj := TSimpleItemFactoryEx.Create(TTestClass,Format('PoolMin=%d;PoolMax=%d;TimeOut=100;Pooled=True',[MIN_A,MAX_A]));
+ elt := obj.CreateInstance() as ITest;
+ oldElt := elt;
+ obj.ReleaseInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt = elt,'2.1');
+ obj.DiscardInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt <> elt ,'2.2');
+
+ oldElt := nil; elt := nil;
+ obj := TSimpleItemFactoryEx.Create(TTestClass,Format('PoolMin=%d;PoolMax=%d;TimeOut=100;Pooled=True',[MIN_B,MIN_A]));
+ elt := obj.CreateInstance() as ITest;
+ oldElt := elt;
+ obj.ReleaseInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt = elt,'3.1');
+ obj.DiscardInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt <> elt ,'3.2');
+
+ oldElt := nil; elt := nil;
+ obj := TSimpleItemFactoryEx.Create(TTestClass,Format('PoolMin=%d;PoolMax=%d;TimeOut=100;Pooled=True',[MIN_B,MAX_A]));
+ elt := obj.CreateInstance() as ITest;
+ oldElt := elt;
+ obj.ReleaseInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt = elt,'4.1');
+ obj.DiscardInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt <> elt,'4.2');
+end;
+
+{ TTest_TImplementationFactory }
+
+procedure TTest_TImplementationFactory.POOLED_Discard();
+const MIN_A = Integer(1); MAX_A = Integer(5); MIN_B = Integer(0);
+var
+ obj : IItemFactoryEx;
+ oldElt, elt : ITest;
+begin
+ obj := TImplementationFactory.Create(TTestClass,Format('PoolMin=%d;PoolMax=%d;TimeOut=100;Pooled=True',[MIN_A,MIN_A]));
+ elt := obj.CreateInstance() as ITest;
+ oldElt := elt;
+ obj.ReleaseInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt = elt,'1.1');
+ elt.DontPool();
+ obj.ReleaseInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt <> elt, '1.2' );
+
+ oldElt := nil; elt := nil;
+ obj := TImplementationFactory.Create(TTestClass,Format('PoolMin=%d;PoolMax=%d;TimeOut=100;Pooled=True',[MIN_A,MAX_A]));
+ elt := obj.CreateInstance() as ITest;
+ oldElt := elt;
+ obj.ReleaseInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt = elt,'2.1');
+ elt.DontPool();
+ obj.ReleaseInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt <> elt ,'2.2');
+
+ oldElt := nil; elt := nil;
+ obj := TImplementationFactory.Create(TTestClass,Format('PoolMin=%d;PoolMax=%d;TimeOut=100;Pooled=True',[MIN_B,MIN_A]));
+ elt := obj.CreateInstance() as ITest;
+ oldElt := elt;
+ obj.ReleaseInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt = elt,'3.1');
+ elt.DontPool();
+ obj.ReleaseInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt <> elt ,'3.2');
+
+ oldElt := nil; elt := nil;
+ obj := TImplementationFactory.Create(TTestClass,Format('PoolMin=%d;PoolMax=%d;TimeOut=100;Pooled=True',[MIN_B,MAX_A]));
+ elt := obj.CreateInstance() as ITest;
+ oldElt := elt;
+ obj.ReleaseInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt = elt,'4.1');
+ elt.DontPool();
+ obj.ReleaseInstance(elt);
+ elt := obj.CreateInstance() as ITest;
+ Check(oldElt <> elt,'4.2');
+end;
+
+initialization
+ RegisterTest(TTest_TIntfPool);
+ RegisterTest(TTest_TSimpleItemFactoryEx);
+ RegisterTest(TTest_TImplementationFactory);
+
+end.
diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpi b/wst/trunk/tests/test_suite/wst_test_suite.lpi
index 2f40d1349..33d141e88 100644
--- a/wst/trunk/tests/test_suite/wst_test_suite.lpi
+++ b/wst/trunk/tests/test_suite/wst_test_suite.lpi
@@ -7,7 +7,7 @@
-
+
@@ -27,7 +27,7 @@
-
+
@@ -40,9 +40,9 @@
-
-
-
+
+
+
@@ -60,9 +60,7 @@
-
-
@@ -70,21 +68,19 @@
-
-
-
-
+
+
-
-
+
+
@@ -94,9 +90,7 @@
-
-
@@ -112,12 +106,10 @@
-
-
@@ -125,9 +117,7 @@
-
-
@@ -141,9 +131,9 @@
-
-
-
+
+
+
@@ -153,9 +143,7 @@
-
-
@@ -175,7 +163,7 @@
-
+
@@ -184,59 +172,61 @@
-
+
-
+
-
-
+
+
+
+
-
+
-
+
-
+
-
+
-
+
-
+
@@ -245,41 +235,41 @@
-
+
-
+
-
+
-
+
-
+
-
+
@@ -287,41 +277,39 @@
-
+
-
+
-
-
-
+
-
+
-
+
-
+
@@ -329,125 +317,121 @@
-
-
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
-
+
+
+
-
+
-
+
-
+
-
-
-
+
-
+
-
+
-
+
@@ -455,27 +439,168 @@
-
-
-
+
-
-
-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpr b/wst/trunk/tests/test_suite/wst_test_suite.lpr
index d0ca38a62..2d48456d0 100644
--- a/wst/trunk/tests/test_suite/wst_test_suite.lpr
+++ b/wst/trunk/tests/test_suite/wst_test_suite.lpr
@@ -9,7 +9,7 @@ uses
base_service_intf, base_soap_formatter, binary_formatter, binary_streamer,
server_binary_formatter, metadata_repository,
metadata_generator, parserdefs, server_service_intf, metadata_wsdl,
- test_parserdef, base_xmlrpc_formatter, wst_fpc_xml;
+ test_parserdef, base_xmlrpc_formatter, wst_fpc_xml, test_utilities;
Const
ShortOpts = 'alh';