Ticket Hash: | 954f1acf79c66c29d88c7eebdf6d352786231833 | |||
Title: | MemLeak issue with TJSONSerializer.RegisterObjArrayForJSON | |||
Status: | Fixed | Type: | Code_Defect | |
Severity: | Critical | Priority: | Immediate | |
Subsystem: | mORMot | Resolution: | Fixed | |
Last Modified: | 2016-10-06 16:58:38 | |||
Version Found In: | ||||
User Comments: | ||||
anonymous added on 2016-10-05 10:10:21:
There is an MemLeak issue with TJSONSerializer.RegisterObjArrayForJSON. It looks like if there is a limitation to RegisterObjArrayForJSON. When adding too many T*ObjArray<->T* pairs, all T*ObjArray out params in SOA Services start leaking memory on server side. I've attached a demo program to reproduce the issue below this description. Compile and run the program, everything works as expected. Enable conditional define {$DEFINE SHOWBUG} and .GetAll(TTestObjArray) leaks memory. 1000 instances of TTest are not destroyed, because TJSONSerrializer is broken. In mORMot.pas, "procedure TServiceMethodExecute.AfterExecute;" the function "fDynArrays(i).Wrapper.Clear;" is called, but in "TDynArray.InternalSetLength" the method "GetIsObjArray" returns false for those arrays if registered via RegisterObjArrayForJSON. This means that class destructors are not called -> memory leak. All my tests are done using latest trunk version and Delphi 7. TestCode: ======================================================================== program ShowMemLeakBug; {$APPTYPE CONSOLE} {$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER {$R *.res} {$DEFINE DEBUG} {$DEFINE SHOWBUG} // Enable to force mem leaks uses FastMM4, SysUtils, Classes, Windows, SynSqlite3Static, SynSqlite3, SynCommons, SynLog, SynTests, SynMustache, mORMot, mORMotHttpServer, mORMotHttpClient, mORMotSqlite3, mORMotDDD; const HTTP_PORT = '8888'; WEBSOCKET_KEY = 'key'; type TMy0=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy0ObjArray=array of TMy0; TMy1=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy1ObjArray=array of TMy1; TMy2=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy2ObjArray=array of TMy2; TMy3=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy3ObjArray=array of TMy3; TMy4=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy4ObjArray=array of TMy4; TMy5=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy5ObjArray=array of TMy5; TMy6=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy6ObjArray=array of TMy6; TMy7=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy7ObjArray=array of TMy7; TMy8=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy8ObjArray=array of TMy8; TMy9=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy9ObjArray=array of TMy9; TMy10=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy10ObjArray=array of TMy10; TMy11=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy11ObjArray=array of TMy11; TMy12=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy12ObjArray=array of TMy12; TMy13=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy13ObjArray=array of TMy13; TMy14=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy14ObjArray=array of TMy14; TMy15=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy15ObjArray=array of TMy15; TMy16=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy16ObjArray=array of TMy16; TMy17=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy17ObjArray=array of TMy17; TMy18=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy18ObjArray=array of TMy18; TMy19=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy19ObjArray=array of TMy19; TMy20=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy20ObjArray=array of TMy20; TMy21=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy21ObjArray=array of TMy21; TMy22=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy22ObjArray=array of TMy22; TMy23=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy23ObjArray=array of TMy23; TMy24=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy24ObjArray=array of TMy24; TMy25=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy25ObjArray=array of TMy25; TMy26=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy26ObjArray=array of TMy26; TMy27=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy27ObjArray=array of TMy27; TMy28=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy28ObjArray=array of TMy28; TMy29=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy29ObjArray=array of TMy29; TMy30=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy30ObjArray=array of TMy30; TMy31=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy31ObjArray=array of TMy31; TMy32=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy32ObjArray=array of TMy32; TMy33=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy33ObjArray=array of TMy33; TMy34=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy34ObjArray=array of TMy34; TMy35=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy35ObjArray=array of TMy35; TMy36=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy36ObjArray=array of TMy36; TMy37=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy37ObjArray=array of TMy37; TMy38=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy38ObjArray=array of TMy38; TMy39=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy39ObjArray=array of TMy39; TMy40=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy40ObjArray=array of TMy40; TMy41=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy41ObjArray=array of TMy41; TMy42=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy42ObjArray=array of TMy42; TMy43=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy43ObjArray=array of TMy43; TMy44=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy44ObjArray=array of TMy44; TMy45=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy45ObjArray=array of TMy45; TMy46=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy46ObjArray=array of TMy46; TMy47=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy47ObjArray=array of TMy47; TMy48=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy48ObjArray=array of TMy48; TMy49=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy49ObjArray=array of TMy49; TMy50=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy50ObjArray=array of TMy50; TMy51=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy51ObjArray=array of TMy51; TMy52=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy52ObjArray=array of TMy52; TMy53=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy53ObjArray=array of TMy53; TMy54=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy54ObjArray=array of TMy54; TMy55=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy55ObjArray=array of TMy55; TMy56=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy56ObjArray=array of TMy56; TMy57=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy57ObjArray=array of TMy57; TMy58=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy58ObjArray=array of TMy58; TMy59=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy59ObjArray=array of TMy59; TMy60=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy60ObjArray=array of TMy60; TMy61=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy61ObjArray=array of TMy61; TMy62=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy62ObjArray=array of TMy62; TMy63=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy63ObjArray=array of TMy63; TMy64=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy64ObjArray=array of TMy64; TMy65=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy65ObjArray=array of TMy65; TMy66=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy66ObjArray=array of TMy66; TMy67=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy67ObjArray=array of TMy67; TMy68=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy68ObjArray=array of TMy68; TMy69=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy69ObjArray=array of TMy69; TMy70=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy70ObjArray=array of TMy70; TMy71=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy71ObjArray=array of TMy71; TMy72=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy72ObjArray=array of TMy72; TMy73=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy73ObjArray=array of TMy73; TMy74=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy74ObjArray=array of TMy74; TMy75=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy75ObjArray=array of TMy75; TMy76=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy76ObjArray=array of TMy76; TMy77=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy77ObjArray=array of TMy77; TMy78=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy78ObjArray=array of TMy78; TMy79=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy79ObjArray=array of TMy79; TMy80=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy80ObjArray=array of TMy80; TMy81=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy81ObjArray=array of TMy81; TMy82=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy82ObjArray=array of TMy82; TMy83=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy83ObjArray=array of TMy83; TMy84=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy84ObjArray=array of TMy84; TMy85=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy85ObjArray=array of TMy85; TMy86=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy86ObjArray=array of TMy86; TMy87=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy87ObjArray=array of TMy87; TMy88=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy88ObjArray=array of TMy88; TMy89=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy89ObjArray=array of TMy89; TMy90=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy90ObjArray=array of TMy90; TMy91=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy91ObjArray=array of TMy91; TMy92=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy92ObjArray=array of TMy92; TMy93=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy93ObjArray=array of TMy93; TMy94=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy94ObjArray=array of TMy94; TMy95=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy95ObjArray=array of TMy95; TMy96=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy96ObjArray=array of TMy96; TMy97=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy97ObjArray=array of TMy97; TMy98=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy98ObjArray=array of TMy98; TMy99=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy99ObjArray=array of TMy99; TMy100=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy100ObjArray=array of TMy100; TMy101=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy101ObjArray=array of TMy101; TMy102=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy102ObjArray=array of TMy102; TMy103=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy103ObjArray=array of TMy103; TMy104=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy104ObjArray=array of TMy104; TMy105=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy105ObjArray=array of TMy105; TMy106=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy106ObjArray=array of TMy106; TMy107=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy107ObjArray=array of TMy107; TMy108=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy108ObjArray=array of TMy108; TMy109=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy109ObjArray=array of TMy109; TMy110=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy110ObjArray=array of TMy110; TMy111=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy111ObjArray=array of TMy111; TMy112=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy112ObjArray=array of TMy112; TMy113=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy113ObjArray=array of TMy113; TMy114=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy114ObjArray=array of TMy114; TMy115=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy115ObjArray=array of TMy115; TMy116=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy116ObjArray=array of TMy116; TMy117=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy117ObjArray=array of TMy117; TMy118=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy118ObjArray=array of TMy118; TMy119=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy119ObjArray=array of TMy119; TMy120=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy120ObjArray=array of TMy120; TMy121=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy121ObjArray=array of TMy121; TMy122=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy122ObjArray=array of TMy122; TMy123=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy123ObjArray=array of TMy123; TMy124=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy124ObjArray=array of TMy124; TMy125=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy125ObjArray=array of TMy125; TMy126=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy126ObjArray=array of TMy126; TMy127=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy127ObjArray=array of TMy127; TMy128=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy128ObjArray=array of TMy128; TMy129=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy129ObjArray=array of TMy129; TMy130=class(TSynPersistent) private fTest: RawUTF8; published property Test: RawUTF8 read fTest write fTest; end; TMy130ObjArray=array of TMy130; // This is our simple Test data class. Will be mapped to TSQLRecordTest. TTest = class(TSynAutoCreateFields) private fDescription: RawUTF8; published property Description: RawUTF8 read fDescription write fDescription; end; TTestObjArray = array of TTest; // The corresponding TSQLRecord for TTest. TSQLRecordTest = class(TSQLRecord) protected fDescription: RawUTF8; // RawUTF8 published /// maps TTest.Description property Description: RawUTF8 read fDescription write fDescription; end; // CQRS Query Interface fo TTest IMyQuery = interface(ICQRSService) ['{DD402806-39C2-4921-98AA-A575DD1117D6}'] function SelectByDescription(const aDescription: RawUTF8): TCQRSResult; function SelectAll: TCQRSResult; function Get(out aAggregate: TTest): TCQRSResult; function GetAll(out aAggregates: TTestObjArray): TCQRSResult; function GetNext(out aAggregate: TTest): TCQRSResult; function GetCount: integer; end; // CQRS Command Interface for TTest IMyCommand = interface(IMyQuery) ['{F0E4C64C-B43A-491B-85E9-FD136843BFCB}'] function Add(const aAggregate: TTest): TCQRSResult; function Update(const aUpdatedAggregate: TTest): TCQRSResult; function Delete: TCQRSResult; function DeleteAll: TCQRSResult; function Commit: TCQRSResult; function Rollback: TCQRSResult; end; // The infratructure REST class implementing the Query and Command Interfaces for TTest TTestRest = class(TDDDRepositoryRestCommand,IMyCommand,IMyQuery) public function SelectByDescription(const aDescription: RawUTF8): TCQRSResult; function SelectAll: TCQRSResult; function Get(out aAggregate: TTest): TCQRSResult; function GetAll(out aAggregates: TTestObjArray): TCQRSResult; function GetNext(out aAggregate: TTest): TCQRSResult; function Add(const aAggregate: TTest): TCQRSResult; function Update(const aUpdatedAggregate: TTest): TCQRSResult; end; // REST Factory for TTestRest instances TTestRestFactory = class(TDDDRepositoryRestFactory) public constructor Create(aRest: TSQLRest; aOwner: TDDDRepositoryRestManager=nil); reintroduce; end; // Test container TMyTests = class(TSynTestsLogged) published procedure MyTests; end; // Test case doing the actual work TMyTestCase = class(TSynTestCase) private // Rest server fRestServer: TSQLRestServerDB; // Http server fHttpServer: TSQLHttpServer; protected // Cleaning up the test procedure CleanUp; override; published // Delete any old Test database on start procedure DeleteOldDatabase; // Start the whole DDD Server (http and rest) procedure StartServer; // Test straight-forward access using 1 thread and 1 client procedure MemLeakTest; end; // Custom TSQLHttpClient encapsulating the remote IMyCommand interface. TMyHttpClient=class(TSQLHttpClientWebsockets) private // Internal Model fModel: TSQLModel; // IMyCommand interface. Will be assigned inside SetUser fMyCommand: IMyCommand; public constructor Create(const aServer,aPort: RawUTF8); //overload; destructor Destroy; override; function SetUser(const aUserName, aPassword: RawUTF8; aHashedPassword: Boolean=false): boolean; reintroduce; property MyCommand: IMyCommand read fMyCommand; end; { TTestRest } function TTestRest.SelectByDescription( const aDescription: RawUTF8): TCQRSResult; begin result := ORMSelectOne('Description=?',[aDescription],(aDescription='')); end; function TTestRest.SelectAll: TCQRSResult; begin result := ORMSelectAll('',[]); end; function TTestRest.Get(out aAggregate: TTest): TCQRSResult; begin result := ORMGetAggregate(aAggregate); end; function TTestRest.GetAll( out aAggregates: TTestObjArray): TCQRSResult; begin result := ORMGetAllAggregates(aAggregates); end; function TTestRest.GetNext(out aAggregate: TTest): TCQRSResult; begin result := ORMGetNextAggregate(aAggregate); end; function TTestRest.Add(const aAggregate: TTest): TCQRSResult; begin result := ORMAdd(aAggregate); end; function TTestRest.Update(const aUpdatedAggregate: TTest): TCQRSResult; begin result := ORMUpdate(aUpdatedAggregate); end; { TInfraRepoUserFactory } constructor TTestRestFactory.Create(aRest: TSQLRest; aOwner: TDDDRepositoryRestManager); begin inherited Create(IMyCommand,TTestRest,TTest,aRest,TSQLRecordTest,aOwner); end; { TMyTests } procedure TMyTests.MyTests; begin AddCase([TMyTestCase]); end; { TMyTestCase } procedure TMyTestCase.CleanUp; begin if Assigned(fHttpServer) then FreeAndNil(fHttpServer); if Assigned(fRestServer) then FreeAndNil(fRestServer); end; procedure TMyTestCase.DeleteOldDatabase; begin if FileExists(ChangeFileExt(ParamStr(0), '.db3')) then SysUtils.DeleteFile(ChangeFileExt(ParamStr(0), '.db3')); CheckNot(FileExists(ChangeFileExt(ParamStr(0), '.db3'))); end; procedure TMyTestCase.StartServer; begin fRestServer:=TSQLRestServerDB.CreateWithOwnModel([TSQLRecordTest], ChangeFileExt(ParamStr(0), '.db3'), true); with fRestServer do begin DB.Synchronous := smNormal; DB.LockingMode := lmExclusive; CreateMissingTables(); TInterfaceFactory.RegisterInterfaces([TypeInfo(IMyQuery),TypeInfo(IMyCommand)]); ServiceContainer.InjectResolver([TTestRestFactory.Create(fRestServer)],true); ServiceDefine(TTestRest,[IMyCommand],sicClientDriven); end; fHttpServer:=TSQLHttpServer.Create(HTTP_PORT, fRestServer, '+', useBidirSocket); fHttpServer.WebSocketsEnable(fRestServer, WEBSOCKET_KEY); end; procedure TMyTestCase.MemLeakTest; var HttpClient: TMyHttpClient; test: TTest; i: integer; testarr: TTestObjArray; count: integer; const MAX = 1000; begin HttpClient:=TMyHttpClient.Create('localhost', HTTP_PORT); try Check(HttpClient.SetUser('Admin', 'synopse')); test:=TTest.Create; try for i:=0 to MAX-1 do begin test.Description:=FormatUTF8('test-%',[i]); Check(HttpClient.MyCommand.Add(test)=cqrsSuccess); end; Check(HttpClient.MyCommand.Commit=cqrsSuccess); Check(HttpClient.MyCommand.SelectAll=cqrsSuccess); count:=HttpClient.MyCommand.GetCount; Check(count=MAX,Format('Count is %d but should be %d.',[count,MAX])); Check(HttpClient.MyCommand.GetAll(testarr)=cqrsSuccess); Check(Length(testarr)=MAX,Format('Count is %d but should be %d.',[Length(testarr),MAX])); for i:=0 to MAX-1 do Check(testarr[i].Description=FormatUTF8('test-%',[i]),Format('Description: "%s"',[testarr[i].Description])); ObjArrayClear(testarr); finally test.Free; end; finally HttpClient.Free; end; end; { TMyHttpClient } constructor TMyHttpClient.Create(const aServer,aPort: RawUTF8); begin fModel:=TSQLModel.Create([TSQLRecordTest]); inherited Create(aServer, aPort, fModel); end; destructor TMyHttpClient.Destroy; begin fMyCommand:=nil; inherited; fModel.Free; end; function TMyHttpClient.SetUser(const aUserName, aPassword: RawUTF8; aHashedPassword: Boolean=false): boolean; begin result := inherited SetUser(aUserName, aPassword, aHashedPassword); WebSocketsUpgrade(WEBSOCKET_KEY); if result then begin ServiceDefine([IMyCommand],sicClientDriven); Services.Resolve(IMyCommand, fMyCommand); end; end; begin ReportMemoryLeaksOnShutdown:=true; TJSONSerializer.RegisterObjArrayForJSON([ TypeInfo(TTestObjArray), TTest, TypeInfo(TMy0ObjArray), TMy0, TypeInfo(TMy1ObjArray), TMy1, TypeInfo(TMy2ObjArray), TMy2, TypeInfo(TMy3ObjArray), TMy3, TypeInfo(TMy4ObjArray), TMy4, TypeInfo(TMy5ObjArray), TMy5, TypeInfo(TMy6ObjArray), TMy6, TypeInfo(TMy7ObjArray), TMy7, TypeInfo(TMy8ObjArray), TMy8, TypeInfo(TMy9ObjArray), TMy9, TypeInfo(TMy10ObjArray), TMy10, TypeInfo(TMy11ObjArray), TMy11, TypeInfo(TMy12ObjArray), TMy12, TypeInfo(TMy13ObjArray), TMy13, TypeInfo(TMy14ObjArray), TMy14, TypeInfo(TMy15ObjArray), TMy15, TypeInfo(TMy16ObjArray), TMy16, TypeInfo(TMy17ObjArray), TMy17, TypeInfo(TMy18ObjArray), TMy18, TypeInfo(TMy19ObjArray), TMy19, TypeInfo(TMy20ObjArray), TMy20, TypeInfo(TMy21ObjArray), TMy21, TypeInfo(TMy22ObjArray), TMy22, TypeInfo(TMy23ObjArray), TMy23, TypeInfo(TMy24ObjArray), TMy24, TypeInfo(TMy25ObjArray), TMy25, TypeInfo(TMy26ObjArray), TMy26, TypeInfo(TMy27ObjArray), TMy27, TypeInfo(TMy28ObjArray), TMy28, TypeInfo(TMy29ObjArray), TMy29, TypeInfo(TMy30ObjArray), TMy30, TypeInfo(TMy31ObjArray), TMy31, TypeInfo(TMy32ObjArray), TMy32, TypeInfo(TMy33ObjArray), TMy33, TypeInfo(TMy34ObjArray), TMy34, TypeInfo(TMy35ObjArray), TMy35, TypeInfo(TMy36ObjArray), TMy36, TypeInfo(TMy37ObjArray), TMy37, TypeInfo(TMy38ObjArray), TMy38, TypeInfo(TMy39ObjArray), TMy39, TypeInfo(TMy40ObjArray), TMy40, TypeInfo(TMy41ObjArray), TMy41, TypeInfo(TMy42ObjArray), TMy42, TypeInfo(TMy43ObjArray), TMy43, TypeInfo(TMy44ObjArray), TMy44, TypeInfo(TMy45ObjArray), TMy45, TypeInfo(TMy46ObjArray), TMy46, TypeInfo(TMy47ObjArray), TMy47, TypeInfo(TMy48ObjArray), TMy48, TypeInfo(TMy49ObjArray), TMy49, TypeInfo(TMy50ObjArray), TMy50, TypeInfo(TMy51ObjArray), TMy51, TypeInfo(TMy52ObjArray), TMy52, TypeInfo(TMy53ObjArray), TMy53, TypeInfo(TMy54ObjArray), TMy54, TypeInfo(TMy55ObjArray), TMy55, TypeInfo(TMy56ObjArray), TMy56, TypeInfo(TMy57ObjArray), TMy57, TypeInfo(TMy58ObjArray), TMy58, TypeInfo(TMy59ObjArray), TMy59, TypeInfo(TMy60ObjArray), TMy60, TypeInfo(TMy61ObjArray), TMy61, TypeInfo(TMy62ObjArray), TMy62, TypeInfo(TMy63ObjArray), TMy63, TypeInfo(TMy64ObjArray), TMy64, TypeInfo(TMy65ObjArray), TMy65, TypeInfo(TMy66ObjArray), TMy66, TypeInfo(TMy67ObjArray), TMy67, TypeInfo(TMy68ObjArray), TMy68, TypeInfo(TMy69ObjArray), TMy69, TypeInfo(TMy70ObjArray), TMy70, TypeInfo(TMy71ObjArray), TMy71, TypeInfo(TMy72ObjArray), TMy72, TypeInfo(TMy73ObjArray), TMy73, TypeInfo(TMy74ObjArray), TMy74, TypeInfo(TMy75ObjArray), TMy75, TypeInfo(TMy76ObjArray), TMy76, TypeInfo(TMy77ObjArray), TMy77, TypeInfo(TMy78ObjArray), TMy78, TypeInfo(TMy79ObjArray), TMy79, TypeInfo(TMy80ObjArray), TMy80, TypeInfo(TMy81ObjArray), TMy81, TypeInfo(TMy82ObjArray), TMy82, TypeInfo(TMy83ObjArray), TMy83, TypeInfo(TMy84ObjArray), TMy84, TypeInfo(TMy85ObjArray), TMy85, TypeInfo(TMy86ObjArray), TMy86, TypeInfo(TMy87ObjArray), TMy87, TypeInfo(TMy88ObjArray), TMy88, TypeInfo(TMy89ObjArray), TMy89, TypeInfo(TMy90ObjArray), TMy90, TypeInfo(TMy91ObjArray), TMy91, TypeInfo(TMy92ObjArray), TMy92, TypeInfo(TMy93ObjArray), TMy93, TypeInfo(TMy94ObjArray), TMy94, TypeInfo(TMy95ObjArray), TMy95, TypeInfo(TMy96ObjArray), TMy96, TypeInfo(TMy97ObjArray), TMy97, TypeInfo(TMy98ObjArray), TMy98, TypeInfo(TMy99ObjArray), TMy99, TypeInfo(TMy100ObjArray), TMy100, TypeInfo(TMy101ObjArray), TMy101, TypeInfo(TMy102ObjArray), TMy102, TypeInfo(TMy103ObjArray), TMy103, TypeInfo(TMy104ObjArray), TMy104, TypeInfo(TMy105ObjArray), TMy105, TypeInfo(TMy106ObjArray), TMy106, TypeInfo(TMy107ObjArray), TMy107, TypeInfo(TMy108ObjArray), TMy108, TypeInfo(TMy109ObjArray), TMy109, TypeInfo(TMy110ObjArray), TMy110, TypeInfo(TMy111ObjArray), TMy111, TypeInfo(TMy112ObjArray), TMy112, TypeInfo(TMy113ObjArray), TMy113, TypeInfo(TMy114ObjArray), TMy114, TypeInfo(TMy115ObjArray), TMy115, TypeInfo(TMy116ObjArray), TMy116, TypeInfo(TMy117ObjArray), TMy117, TypeInfo(TMy118ObjArray), TMy118, TypeInfo(TMy119ObjArray), TMy119 {$IFDEF SHOWBUG} (* ,TypeInfo(TMy120ObjArray), TMy120, TypeInfo(TMy121ObjArray), TMy121, TypeInfo(TMy122ObjArray), TMy122,// Problem starts here TypeInfo(TMy123ObjArray), TMy123, TypeInfo(TMy124ObjArray), TMy124, TypeInfo(TMy125ObjArray), TMy125, TypeInfo(TMy126ObjArray), TMy126, TypeInfo(TMy127ObjArray), TMy127, TypeInfo(TMy128ObjArray), TMy128, TypeInfo(TMy129ObjArray), TMy129, TypeInfo(TMy130ObjArray), TMy130 *) {$ENDIF} ]); TJSONSerializer.RegisterObjArrayForJSON(TypeInfo(TMy120ObjArray),TMy120); TJSONSerializer.RegisterObjArrayForJSON(TypeInfo(TMy121ObjArray),TMy121); TJSONSerializer.RegisterObjArrayForJSON(TypeInfo(TMy122ObjArray),TMy122); //TJSONSerializer.RegisterObjArrayForJSON(TypeInfo(TMy123ObjArray),TMy123); with TMyTests.Create('mORMot DDD Test') do try Run; finally Free; end; WriteLn(#13#10'Done - Press ENTER to Exit'); ReadLn; end. ab added on 2016-10-06 16:58:38: Fixed TDynArrayHashed as used in TPointerClassHash for T*ObjArray registration... |