AddCase(TTestBasicClasses);
  // *)
  AddCase(TTestClientServerAccess); // (*
  AddCase(TTestServiceOrientedArchitecture);
  AddCase(TTestBidirectionalRemoteConnection);
  AddCase(TTestExternalDatabase);
  AddCase(TTestMultiThreadProcess);
  AddCase(TTestDDDSharedUnits);
  //exit; // *)
end;
{$endif DELPHI5OROLDER}

procedure SQLite3ConsoleTests;
begin
  {$ifdef MSWINDOWS}

  AddCase(TTestBasicClasses);
  // *)
  AddCase(TTestClientServerAccess); // (*
  AddCase(TTestServiceOrientedArchitecture);
  AddCase(TTestBidirectionalRemoteConnection);
  AddCase(TTestExternalDatabase);
  AddCase(TTestMultiThreadProcess);
  AddCase([TTestDDDSharedUnits,TTestDDDMultiThread]);
  //exit; // *)
end;
{$endif DELPHI5OROLDER}

procedure SQLite3ConsoleTests;
begin
  {$ifdef MSWINDOWS}

    procedure AuthenticationModel;
    /// test the Email validation process
    procedure EmailValidationProcess;
    /// test the CQRS Repository for TUser persistence
    procedure UserCQRSRepository;
  end;



























  /// a test class, used by TTestServiceOrientedArchitecture
  // - to test TPersistent objects used as parameters for remote service calls
  TComplexNumber = class(TPersistent)
  private
    fReal: Double;
    fImaginary: Double;
................................................................................
  TPersonContactable.RegressionTests(self);
end;

procedure TTestDDDSharedUnits.UserCQRSRepository;
begin
  TInfraRepoUserFactory.RegressionTests(self);
end;























































































































































































































































































































{$endif DELPHI5OROLDER}



initialization
  _uE0 := WinAnsiToUtf8(@UTF8_E0_F4_BYTES[0],1);

    procedure AuthenticationModel;
    /// test the Email validation process
    procedure EmailValidationProcess;
    /// test the CQRS Repository for TUser persistence
    procedure UserCQRSRepository;
  end;

  /// a test case for aggressive multi-threaded DDD ORM test
  TTestDDDMultiThread = class(TSynTestCase)
  private
    // Rest server
    fRestServer: TSQLRestServerDB;
    // Http server
    fHttpServer: TSQLHttpServer;
    /// Will create as many Clients as specified by aClient.
    // - Each client will perform as many Requests as specified by aRequests.
    // - This function will wait for all Clients until finished.
    function ClientTest(const aClients, aRequests: integer): boolean;
  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 SingleClientTest;
    /// Test concurrent access with multiple clients
    procedure MultiThreadedClientsTest;
  end;


  /// a test class, used by TTestServiceOrientedArchitecture
  // - to test TPersistent objects used as parameters for remote service calls
  TComplexNumber = class(TPersistent)
  private
    fReal: Double;
    fImaginary: Double;
................................................................................
  TPersonContactable.RegressionTests(self);
end;

procedure TTestDDDSharedUnits.UserCQRSRepository;
begin
  TInfraRepoUserFactory.RegressionTests(self);
end;

type
  // This is our simple Test data class. Will be mapped to TSQLRecordDDDTest.
  TDDDTest = class(TSynPersistent)
  private
    fDescription: RawUTF8;
  published
    property Description: RawUTF8 read fDescription write fDescription;
  end;

  TDDDTestObjArray = array of TDDDTest;

  // The corresponding TSQLRecord for TDDDTest.
  TSQLRecordDDDTest = class(TSQLRecord)
  private
    fDescription: RawUTF8;
  published
    property Description: RawUTF8 read fDescription write fDescription;
  end;

  // CQRS Query Interface fo TTest
  IDDDThreadsQuery = interface(ICQRSService)
    ['{DD402806-39C2-4921-98AA-A575DD1117D6}']
    function SelectByDescription(const aDescription: RawUTF8): TCQRSResult;
    function SelectAll: TCQRSResult;
    function Get(out aAggregate: TDDDTest): TCQRSResult;
    function GetAll(out aAggregates: TDDDTestObjArray): TCQRSResult;
    function GetNext(out aAggregate: TDDDTest): TCQRSResult;
    function GetCount: integer;
  end;

  // CQRS Command Interface for TTest
  IDDDThreadsCommand = interface(IDDDThreadsQuery)
    ['{F0E4C64C-B43A-491B-85E9-FD136843BFCB}']
    function Add(const aAggregate: TDDDTest): TCQRSResult;
    function Update(const aUpdatedAggregate: TDDDTest): 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
  TDDDThreadsTestRest = class(TDDDRepositoryRestCommand, IDDDThreadsCommand)
  public
    function SelectByDescription(const aDescription: RawUTF8): TCQRSResult;
    function SelectAll: TCQRSResult;
    function Get(out aAggregate: TDDDTest): TCQRSResult;
    function GetAll(out aAggregates: TDDDTestObjArray): TCQRSResult;
    function GetNext(out aAggregate: TDDDTest): TCQRSResult;
    function Add(const aAggregate: TDDDTest): TCQRSResult;
    function Update(const aUpdatedAggregate: TDDDTest): TCQRSResult;
  end;

  // REST Factory for TDDDThreadsTestRest instances
  TDDDThreadsTestRestFactory = class(TDDDRepositoryRestFactory)
  public
    constructor Create(aRest: TSQLRest; aOwner: TDDDRepositoryRestManager = nil); reintroduce;
  end;

  // Custom TSQLHttpClient encapsulating the remote IDDDThreadsCommand interface.
  TDDDThreadsHttpClient = class(TSQLHttpClient)
  private
    // Internal Model
    fModel: TSQLModel;
    // IDDDThreadsCommand interface. Will be assigned inside SetUser
    fMyCommand: IDDDThreadsCommand;
  public
    constructor Create(const aServer, aPort: AnsiString); 
    destructor Destroy; override;
    function SetUser(const aUserName, aPassword: RawUTF8; aHashedPassword: Boolean = false): boolean; reintroduce;
    property MyCommand: IDDDThreadsCommand read fMyCommand;
  end;

  // The thread used by TTestDDDMultiThread.ClientTest
  TDDDThreadsThread = class(TSynThread)
  private
    fHttpClient: TDDDThreadsHttpClient;
    fRequestCount: integer;
    fId: integer;
    fIsError: boolean;
  protected
    procedure Execute; override;
  public
    constructor Create(const aId, aRequestCount: integer);
    destructor Destroy; override;
    property IsError: boolean read fIsError;
  end;

{ TDDDThreadsTestRest }

function TDDDThreadsTestRest.SelectByDescription(const aDescription: RawUTF8): TCQRSResult;
begin
  result := ORMSelectOne('Description=?', [aDescription], (aDescription = ''));
end;

function TDDDThreadsTestRest.SelectAll: TCQRSResult;
begin
  result := ORMSelectAll('', []);
end;

function TDDDThreadsTestRest.Get(out aAggregate: TDDDTest): TCQRSResult;
begin
  result := ORMGetAggregate(aAggregate);
end;

function TDDDThreadsTestRest.GetAll(out aAggregates: TDDDTestObjArray): TCQRSResult;
begin
  result := ORMGetAllAggregates(aAggregates);
end;

function TDDDThreadsTestRest.GetNext(out aAggregate: TDDDTest): TCQRSResult;
begin
  result := ORMGetNextAggregate(aAggregate);
end;

function TDDDThreadsTestRest.Add(const aAggregate: TDDDTest): TCQRSResult;
begin
  result := ORMAdd(aAggregate);
end;

function TDDDThreadsTestRest.Update(const aUpdatedAggregate: TDDDTest): TCQRSResult;
begin
  result := ORMUpdate(aUpdatedAggregate);
end;


{ TInfraRepoUserFactory }

constructor TDDDThreadsTestRestFactory.Create(aRest: TSQLRest; aOwner: TDDDRepositoryRestManager);
begin
  inherited Create(IDDDThreadsCommand, TDDDThreadsTestRest, TDDDTest, aRest, TSQLRecordDDDTest, aOwner);
end;


{ TTestDDDMultiThread }

procedure TTestDDDMultiThread.CleanUp;
begin
  if Assigned(fHttpServer) then
    FreeAndNil(fHttpServer);
  if Assigned(fRestServer) then
    FreeAndNil(fRestServer);
end;

procedure TTestDDDMultiThread.DeleteOldDatabase;
begin
  if FileExists(ChangeFileExt(ParamStr(0), '.db3')) then
    SysUtils.DeleteFile(ChangeFileExt(ParamStr(0), '.db3'));
  CheckNot(FileExists(ChangeFileExt(ParamStr(0), '.db3')));
end;

procedure TTestDDDMultiThread.StartServer;
begin
  fRestServer := TSQLRestServerDB.CreateWithOwnModel([TSQLRecordDDDTest], ChangeFileExt(ParamStr(0), '.db3'), true);
  with fRestServer do begin
    DB.Synchronous := smNormal;
    DB.LockingMode := lmExclusive;
    CreateMissingTables();
    TInterfaceFactory.RegisterInterfaces([TypeInfo(IDDDThreadsQuery), TypeInfo(IDDDThreadsCommand)]);
    ServiceContainer.InjectResolver([TDDDThreadsTestRestFactory.Create(fRestServer)], true);
    ServiceDefine(TDDDThreadsTestRest, [IDDDThreadsCommand], sicClientDriven);
  end;
  fHttpServer := TSQLHttpServer.Create(HTTP_DEFAULTPORT, fRestServer, '+',
    {$ifdef ONLYUSEHTTPSOCKET}useHttpSocket{$else}useHttpApiRegisteringURI{$endif});
  Check(fHttpServer.DBServerCount>0);
end;

procedure TTestDDDMultiThread.MultiThreadedClientsTest;
begin
  ClientTest(20, 50);
end;

procedure TTestDDDMultiThread.SingleClientTest;
var
  HttpClient: TDDDThreadsHttpClient;
  test: TDDDTest;
  i: integer;
const
  MAX = 1000;
begin
  HttpClient := TDDDThreadsHttpClient.Create('localhost', HTTP_DEFAULTPORT);
  try
    Check(HttpClient.SetUser('Admin', 'synopse'));
    test := TDDDTest.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);
    finally
      test.Free;
    end;
  finally
    HttpClient.Free;
  end;
end;

function TTestDDDMultiThread.ClientTest(const aClients, aRequests: integer): boolean;
var
  i,count: integer;
  arrThreads: array of TDDDThreadsThread;
  arrHandles: array of THandle;
  rWait: Cardinal;
begin
  result := false;
  count := fRestServer.TableRowCount(TSQLRecordDDDTest);
  SetLength(arrThreads, aClients);
  SetLength(arrHandles, aClients);
  for i := Low(arrThreads) to High(arrThreads) do begin
    arrThreads[i] := TDDDThreadsThread.Create(i, aRequests);
    {$ifdef MSWINDOWS}
    arrHandles[i] := arrThreads[i].Handle;
    {$endif}
    arrThreads[i].Start;
  end;
  try
    {$ifdef MSWINDOWS}
    repeat
      rWait := WaitForMultipleObjects(aClients, @arrHandles[0], True, INFINITE);
    until rWait <> WAIT_TIMEOUT;
    {$else}
    repeat
      Sleep(10);
      rWait := 0;
      for i := Low(arrThreads) to High(arrThreads) do
        if not arrThreads[i].Terminated then
          inc(rWait);
    until rWait=0;
    {$endif}
  finally
    for i := Low(arrThreads) to High(arrThreads) do begin
      CheckNot(arrThreads[i].IsError);
      arrThreads[i].Free;
    end;
    Check(fRestServer.TableRowCount(TSQLRecordDDDTest)=count+aClients*aRequests);
  end;
end;

{ TDDDThreadsHttpClient }

constructor TDDDThreadsHttpClient.Create(const aServer, aPort: AnsiString);
begin
  fModel := TSQLModel.Create([TSQLRecordDDDTest]);
  fModel.Owner := self;
  inherited Create(aServer, aPort, fModel);
end;

destructor TDDDThreadsHttpClient.Destroy;
begin
  fMyCommand := nil;
  inherited;
end;

function TDDDThreadsHttpClient.SetUser(const aUserName, aPassword: RawUTF8; aHashedPassword: Boolean = false): boolean;
begin
  result := inherited SetUser(aUserName, aPassword, aHashedPassword);
  if result then begin
    ServiceDefine([IDDDThreadsCommand], sicClientDriven);
    Services.Resolve(IDDDThreadsCommand, fMyCommand);
  end;
end;


{ TDDDThreadsThread }

constructor TDDDThreadsThread.Create(const aID, aRequestCount: integer);
begin
  inherited Create(true);
  fRequestCount := aRequestCount;
  fId := aId;
  fIsError := false;
  fHttpClient := TDDDThreadsHttpClient.Create('localhost', HTTP_DEFAULTPORT);
  fHttpClient.SetUser('Admin', 'synopse');
end;

destructor TDDDThreadsThread.Destroy;
begin
  fHttpClient.Free;
  inherited;
end;

procedure TDDDThreadsThread.Execute;
var
  i: integer;
  test: TDDDTest;
  success: boolean;
begin
  test := TDDDTest.Create;
  try
    success := true;
    for i := 0 to fRequestCount - 1 do begin
      test.Description := FormatUTF8('test-%-%', [fID, i]);
      success := success and (fHttpClient.MyCommand.Add(test) = cqrsSuccess);
      if not success then
        break;
    end;
    if success then
      success := fHttpClient.MyCommand.Commit = cqrsSuccess;
    if not success then begin
      fIsError := true;
      raise Exception.Create('Something went wrong!');
    end;
  finally
    test.Free;
    Terminate;
  end;
end;


{$endif DELPHI5OROLDER}



initialization
  _uE0 := WinAnsiToUtf8(@UTF8_E0_F4_BYTES[0],1);

'1.18.1859'

'1.18.1860'