You are not logged in.
Pages: 1
I've wrote a unit which implements TSomeEntity/TSQLRecordSomeEntity/IDomEntityQuery/IDomEntityCommand/TInfraRepoEntity/TInfraRepoEntityFactory
following sample code of unit domUserType/domUserCQRS/infraRepoUser.
But this simple project fails on passing unit-test.
here is the code
Create a console project, add a unit named TestMain.pas, copy/paste these code. Then execute "RunTestProject" procedure in project source block. Exception occurs.
unit TestMain;
interface
uses
Classes, SysUtils,
SynCommons, mORMot, mORMotDDD,
SynTests;
type
TSomeEntity = class(TSynPersistent)
protected
fCaption: RawUTF8;
published
property Caption: RawUTF8 read fCaption write fCaption;
end;
TSomeEntityObjArray = array of TSomeEntity;
TSQLRecordSomeEntity = class(TSQLRecord)
protected
fCaption: RawUTF8;
published
property Caption: RawUTF8 read fCaption write fCaption;
end;
IDomEntityQuery = interface(ICQRSService)
['{74EA5045-2062-47D0-AE0F-E9163BBC731B}']
function SelectByCaption(const aCaption: RawUTF8): TCQRSResult;
function SelectAll: TCQRSResult;
function Get(out aAggregate: TSomeEntity): TCQRSResult;
function GetAll(out aAggretates: TSomeEntityObjArray): TCQRSResult;
function GetNext(out aAggregate: TSomeEntity): TCQRSResult;
function GetCount: Integer;
end;
IDomEntityCommand = interface(IDomEntityQuery)
['{FEC02E2A-A76F-4CDD-B378-E4E1EA6043F9}']
function Add(const aAggregate: TSomeEntity): TCQRSResult;
function Update(const aUpdatedAggregate: TSomeEntity): TCQRSResult;
function Delete: TCQRSResult;
function DeleteAll: TCQRSResult;
function Commit: TCQRSResult;
function Rollback: TCQRSResult;
end;
TInfraRepoEntity = class(TDDDRepositoryRestCommand, IDomEntityCommand, IDomEntityQuery)
public
function SelectByCaption(const aCaption: RawUTF8): TCQRSResult;
function SelectAll: TCQRSResult;
function Get(out aAggregate: TSomeEntity): TCQRSResult;
function GetAll(out aAggregates: TSomeEntityObjArray): TCQRSResult;
function GetNext(out aAggregate: TSomeEntity): TCQRSResult;
// function GetCount: Integer;
function Add(const aAggregate: TSomeEntity): TCQRSResult;
function Update(const aUpdatedAggregate: TSomeEntity): TCQRSResult;
// function Delete: TCQRSResult;
// function DeleteAll: TCQRSResult;
// function Commit: TCQRSResult;
// function Rollback: TCQRSResult;
end;
TInfraRepoEntityFactory = class(TDDDRepositoryRestFactory)
public
constructor Create(aRest: TSQLRest; aOwner: TDDDRepositoryRestManager=nil); reintroduce;
class procedure RegressionTests(test: TSynTestCase);
end;
TTestRepoEntity = class(TSynTestCase)
published
procedure TestSelf;
end;
TTestSuit = class(TSynTests)
published
procedure TestAll;
end;
procedure RunTestProject;
implementation
procedure RunTestProject;
begin
with TTestSuit.Create() do
try
Run;
ReadLn;
finally
Free;
end;
end;
{ TInfraRepoEntity }
function TInfraRepoEntity.Add(const aAggregate: TSomeEntity): TCQRSResult;
begin
Result := ORMAdd(aAggregate);
end;
function TInfraRepoEntity.Get(out aAggregate: TSomeEntity): TCQRSResult;
begin
Result := ORMGetAggregate(aAggregate);
end;
function TInfraRepoEntity.GetAll(out aAggregates: TSomeEntityObjArray): TCQRSResult;
begin
Result := ORMGetAllAggregates(aAggregates);
end;
function TInfraRepoEntity.GetNext(out aAggregate: TSomeEntity): TCQRSResult;
begin
Result := ORMGetNextAggregate(aAggregate);
end;
function TInfraRepoEntity.SelectAll: TCQRSResult;
begin
Result := ORMSelectAll('', []);
end;
function TInfraRepoEntity.SelectByCaption(const aCaption: RawUTF8): TCQRSResult;
begin
Result := ORMSelectAll('Caption=?', [aCaption], (''=aCaption));
end;
function TInfraRepoEntity.Update(
const aUpdatedAggregate: TSomeEntity): TCQRSResult;
begin
Result := ORMUpdate(aUpdatedAggregate);
end;
{ TInfraRepoEntityFactory }
constructor TInfraRepoEntityFactory.Create(aRest: TSQLRest;
aOwner: TDDDRepositoryRestManager);
begin
inherited Create(IDomEntityCommand,TInfraRepoEntity,TSomeEntity,aRest,TSQLRecordSomeEntity,aOwner);
AddFilterOrValidate(['*'], TSynFilterTrim.Create);
AddFilterOrValidate(['Caption'],TSynValidateNonVoidText.Create);
end;
class procedure TInfraRepoEntityFactory.RegressionTests(test: TSynTestCase);
procedure TestOne(Rest: TSQLRest);
const
MAX = 1000;
var
cmd: IDomEntityCommand;
qry: IDomEntityQuery;
entity: TSomeEntity;
entitys: TSomeEntityObjArray;
i,entityCount: Integer;
iText: RawUTF8;
begin
with test do
begin
entity := TSomeEntity.Create;
Check(Rest.Services.Resolve(IDomEntityCommand, cmd));
try
for i := 1 to MAX do
begin
UInt32ToUtf8(i,iText);
entity.Caption := ' ' + iText;
Check(cqrsSuccess = cmd.Add(entity));
end;
Check(cqrsSuccess = cmd.Commit);
for i := 1 to MAX do
begin
UInt32ToUtf8(i, iText);
Check(cqrsSuccess = cmd.SelectByCaption(iText));
Check(1 = cmd.GetCount); // error
Check(cqrsSuccess = cmd.Get(entity));
Check(iText = entity.Caption); // error. ' ' exists in entity.Caption
end;
finally
entity.Free;
end;
end;
end;
var
RestServer: TSQLRestServerFullMemory;
RestClient: TSQLRestClientURI;
begin
RestServer := TSQLRestServerFullMemory.CreateWithOwnModel([TSQLRecordSomeEntity]);
try // first try directly on server side
RestServer.ServiceContainer.InjectResolver([TInfraRepoEntityFactory.Create(RestServer)],true);
TestOne(RestServer); // sub function will ensure that all I*Command are released
finally
RestServer.Free;
end;
RestServer := TSQLRestServerFullMemory.CreateWithOwnModel([TSQLRecordSomeEntity]);
try // then try from a client-server process
RestServer.ServiceContainer.InjectResolver([TInfraRepoEntityFactory.Create(RestServer)],true);
RestServer.ServiceDefine(TInfraRepoEntity,[IDomEntityCommand,IDomEntityQuery],sicClientDriven);
test.Check(RestServer.ExportServer);
RestClient := TSQLRestClientURIDll.Create(TSQLModel.Create(RestServer.Model),@URIRequest);
try
RestClient.Model.Owner := RestClient;
RestClient.ServiceDefine([IDomEntityCommand],sicClientDriven);
TestOne(RestServer);
RestServer.DropDatabase;
USEFASTMM4ALLOC := true; // for slightly faster process
TestOne(RestClient);
finally
RestClient.Free;
end;
finally
RestServer.Free;
end;
end;
{ TTestRepoEntity }
procedure TTestRepoEntity.TestSelf;
begin
TInfraRepoEntityFactory.RegressionTests(Self);
end;
{ TTestSuit }
procedure TTestSuit.TestAll;
begin
AddCase([TTestRepoEntity]);
end;
initialization
TJSONSerializer.RegisterObjArrayForJSON([
TypeInfo(TSomeEntityObjArray), TSomeEntity]);
TInterfaceFactory.RegisterInterfaces([
TypeInfo(IDomEntityQuery), TypeInfo(IDomEntityCommand)]);
end.
any help?
Last edited by uian2000 (2016-02-18 03:52:31)
Offline
It seems like TSynFilterTrim doesn't work properly.
But why?
Offline
There was an issue with filtering.
It has been fixed by http://synopse.info/fossil/info/07fa32aee7
About your code, there was a small problem in your test.
Since you are making:
function TInfraRepoEntity.SelectByCaption(const aCaption: RawUTF8): TCQRSResult;
begin
Result := ORMSelectAll('Caption=?', [aCaption], (''=aCaption));
end;
The ORMSelectAll() expect you to use GetNext() and not plain Get() to retrieve the values:
Check(cqrsSuccess = cmd.SelectByCaption(iText));
Check(1 = cmd.GetCount);
Check(cqrsSuccess = cmd.GetNext(entity)); // and not cmd.Get()
Check(iText = entity.Caption);
I've added your nice sample to the source code repository.
See http://synopse.info/fossil/info/6e728e35bf
Thanks for the feedback, and sorry for the issue!
Offline
Thanks ab, it's very kind of you for making this efficient framework.
This patch works for me.
In what situation I should use Get() not GetNext()?
Offline
ORMSelect() expects Get()
Since it returns one item
whereas
ORMSelectAll() expects GetNext()
Since it returns one or several items, and you should loop over them.
See that.
I have tried cmd.Update(), which failed too.
entity := TSomeEntity.Create;
Check(Rest.Services.Resolve(IDomEntityCommand, cmd));
try
for i := 1 to MAX do
begin
UInt32ToUtf8(i,iText);
entity.Caption := ' ' + iText;
Check(cqrsSuccess = cmd.Add(entity));
end;
Check(cqrsSuccess = cmd.Commit);
for i := 1 to MAX do
begin
UInt32ToUtf8(i, iText);
Check(cqrsSuccess = cmd.SelectByCaption(iText));
Check(1 = cmd.GetCount);
Check(cqrsSuccess = cmd.GetNext(entity));
Check(iText = entity.Caption);
end;
[*================ new line below =======================*}
Check(cqrsSuccess = cmd.SelectByCaption('1'));
Check(1 = cmd.GetCount);
Check(cqrsSuccess = cmd.GetNext(entity));
entity.Caption := 'hello';
Check(cqrsSuccess = cmd.Update(entity));
Check(cqrsSuccess = cmd.Commit); // error.
finally
entity.Free;
end;
Is this another wrong way of using Update()?
Or I should make another SelectByXXX() using ORMSelect() instead ORMSelectAll() internally?
Offline
I've fixed regression in TSQLRestBatch.Update when boExtendedJSON was set.
See http://synopse.info/fossil/info/b29d909bc8
Offline
Thank you ab.
It works for me.
Offline
Hi ab,
I've update sample DDDPersistance, new conflict occurs.
I'm using 'stored AS_UNIQUE' property, and my update succeds, but following select operation failed.
here the code.
TSQLRecord definition
TSQLRecordSomeEntity = class(TSQLRecord)
protected
fCaption: RawUTF8;
published
property Caption: RawUTF8 read fCaption write fCaption [b]stored AS_UNIQUE[/b]; // changed here
end;
and the testcase
with test do
begin
entity := TSomeEntity.Create;
Check(Rest.Services.Resolve(IDomEntityCommand, cmd));
try
// test Add
for i := 1 to MAX do
begin
UInt32ToUtf8(i,iText);
entity.Caption := ' ' + iText;
Check(cqrsSuccess = cmd.Add(entity));
end;
Check(cqrsSuccess = cmd.Commit);
// test select
for i := 1 to MAX do
begin
UInt32ToUtf8(i, iText);
// testing SelectAllByCaption
Check(cqrsSuccess = cmd.SelectAllByCaption(iText));
Check(1 = cmd.GetCount);
Check(cqrsSuccess = cmd.GetNext(entity));
Check(iText = entity.Caption);
// testing SelectOneByCaption
Check(cqrsSuccess = cmd.SelectOneByCaption(iText));
Check(1 = cmd.GetCount);
Check(cqrsSuccess = cmd.Get(entity));
Check(iText = entity.Caption);
end;
// Check(cqrsSuccess = cmd.SelectAllByCaption('1'));
// Check(1 = cmd.GetCount);
// Check(cqrsSuccess = cmd.GetNext(entity));
// entity.Caption := 'hello';
// Check(cqrsSuccess = cmd.Update(entity));
// Check(cqrsSuccess = cmd.Commit);
// test update
for i := 1 to MAX do
begin
UInt32ToUtf8(i, iText);
Check(cqrsSuccess = cmd.SelectOneByCaption(iText));
Check(1 = cmd.GetCount);
Check(cqrsSuccess = cmd.Get(entity));
Check(iText = entity.Caption);
iText := PreFix + iText;
entity.Caption := iText;
Check(cqrsSuccess = cmd.Update(entity));
end;
Check(cqrsSuccess = cmd.Commit);
// check effect of update
for i := 1 to MAX do
begin
UInt32ToUtf8(i, iText);
iText := PreFix + iText;
Check(cqrsSuccess = cmd.SelectOneByCaption(iText)); // error occurs here
Check(1 = cmd.GetCount);
Check(cqrsSuccess = cmd.Get(entity));
Check(iText = entity.Caption);
end;
// test delete
Check(cqrsSuccess = cmd.SelectAll);
Check(cqrsSuccess = cmd.DeleteAll);
Check(cqrsSuccess = cmd.Commit);
Check(cqrsSuccess = cmd.SelectAll);
Check(0 = cmd.GetCount);
finally
entity.Free;
end;
end;
Last edited by uian2000 (2016-03-04 07:24:44)
Offline
Besides, I've added a new method SelectOneByCaption.
unit DDDPersistenceMain;
interface
uses
Classes, SysUtils,
SynCommons, mORMot, mORMotDDD,
SynTests;
type
TSomeEntity = class(TSynPersistent)
protected
fCaption: RawUTF8;
published
property Caption: RawUTF8 read fCaption write fCaption;
end;
TSomeEntityObjArray = array of TSomeEntity;
TSQLRecordSomeEntity = class(TSQLRecord)
protected
fCaption: RawUTF8;
published
property Caption: RawUTF8 read fCaption write fCaption stored AS_UNIQUE;
end;
IDomEntityQuery = interface(ICQRSService)
['{74EA5045-2062-47D0-AE0F-E9163BBC731B}']
function SelectOneByCaption(const aCaption: RawUTF8): TCQRSResult;
function SelectAllByCaption(const aCaption: RawUTF8): TCQRSResult;
function SelectAll: TCQRSResult;
function Get(out aAggregate: TSomeEntity): TCQRSResult;
function GetAll(out aAggretates: TSomeEntityObjArray): TCQRSResult;
function GetNext(out aAggregate: TSomeEntity): TCQRSResult;
function GetCount: Integer;
end;
IDomEntityCommand = interface(IDomEntityQuery)
['{FEC02E2A-A76F-4CDD-B378-E4E1EA6043F9}']
function Add(const aAggregate: TSomeEntity): TCQRSResult;
function Update(const aUpdatedAggregate: TSomeEntity): TCQRSResult;
function Delete: TCQRSResult;
function DeleteAll: TCQRSResult;
function Commit: TCQRSResult;
function Rollback: TCQRSResult;
end;
TInfraRepoEntity = class(TDDDRepositoryRestCommand, IDomEntityCommand, IDomEntityQuery)
public
function SelectOneByCaption(const aCaption: RawUTF8): TCQRSResult;
function SelectAllByCaption(const aCaption: RawUTF8): TCQRSResult;
function SelectAll: TCQRSResult;
function Get(out aAggregate: TSomeEntity): TCQRSResult;
function GetAll(out aAggregates: TSomeEntityObjArray): TCQRSResult;
function GetNext(out aAggregate: TSomeEntity): TCQRSResult;
// function GetCount: Integer;
function Add(const aAggregate: TSomeEntity): TCQRSResult;
function Update(const aUpdatedAggregate: TSomeEntity): TCQRSResult;
// function Delete: TCQRSResult;
// function DeleteAll: TCQRSResult;
// function Commit: TCQRSResult;
// function Rollback: TCQRSResult;
end;
TInfraRepoEntityFactory = class(TDDDRepositoryRestFactory)
public
constructor Create(aRest: TSQLRest; aOwner: TDDDRepositoryRestManager=nil); reintroduce;
class procedure RegressionTests(test: TSynTestCase);
end;
TTestRepoEntity = class(TSynTestCase)
published
procedure TestSelf;
end;
TTestSuit = class(TSynTests)
published
procedure TestAll;
end;
procedure RunTestProject;
implementation
procedure RunTestProject;
begin
with TTestSuit.Create() do
try
Run;
ReadLn;
finally
Free;
end;
end;
{ TInfraRepoEntity }
function TInfraRepoEntity.Add(const aAggregate: TSomeEntity): TCQRSResult;
begin
Result := ORMAdd(aAggregate);
end;
function TInfraRepoEntity.Get(out aAggregate: TSomeEntity): TCQRSResult;
begin
Result := ORMGetAggregate(aAggregate);
end;
function TInfraRepoEntity.GetAll(out aAggregates: TSomeEntityObjArray): TCQRSResult;
begin
Result := ORMGetAllAggregates(aAggregates);
end;
function TInfraRepoEntity.GetNext(out aAggregate: TSomeEntity): TCQRSResult;
begin
Result := ORMGetNextAggregate(aAggregate);
end;
function TInfraRepoEntity.SelectAll: TCQRSResult;
begin
Result := ORMSelectAll('', []);
end;
function TInfraRepoEntity.SelectAllByCaption(const aCaption: RawUTF8): TCQRSResult;
begin
Result := ORMSelectAll('Caption=?', [aCaption], (''=aCaption));
end;
function TInfraRepoEntity.SelectOneByCaption(
const aCaption: RawUTF8): TCQRSResult;
begin
Result := ORMSelectOne('Caption=?', [aCaption], (''=aCaption));
end;
function TInfraRepoEntity.Update(
const aUpdatedAggregate: TSomeEntity): TCQRSResult;
begin
Result := ORMUpdate(aUpdatedAggregate);
end;
{ TInfraRepoEntityFactory }
constructor TInfraRepoEntityFactory.Create(aRest: TSQLRest;
aOwner: TDDDRepositoryRestManager);
begin
inherited Create(IDomEntityCommand,TInfraRepoEntity,TSomeEntity,aRest,TSQLRecordSomeEntity,aOwner);
AddFilterOrValidate(['*'], TSynFilterTrim.Create);
AddFilterOrValidate(['Caption'],TSynValidateNonVoidText.Create);
end;
class procedure TInfraRepoEntityFactory.RegressionTests(test: TSynTestCase);
procedure TestOne(Rest: TSQLRest);
const
PreFix = 'Modified';
MAX = 1000;
var
cmd: IDomEntityCommand;
qry: IDomEntityQuery;
entity: TSomeEntity;
entitys: TSomeEntityObjArray;
i,entityCount: Integer;
iText: RawUTF8;
begin
with test do
begin
entity := TSomeEntity.Create;
Check(Rest.Services.Resolve(IDomEntityCommand, cmd));
try
// test Add
for i := 1 to MAX do
begin
UInt32ToUtf8(i,iText);
entity.Caption := ' ' + iText;
Check(cqrsSuccess = cmd.Add(entity));
end;
Check(cqrsSuccess = cmd.Commit);
// test select
for i := 1 to MAX do
begin
UInt32ToUtf8(i, iText);
// testing SelectAllByCaption
Check(cqrsSuccess = cmd.SelectAllByCaption(iText));
Check(1 = cmd.GetCount);
Check(cqrsSuccess = cmd.GetNext(entity));
Check(iText = entity.Caption);
// testing SelectOneByCaption
Check(cqrsSuccess = cmd.SelectOneByCaption(iText));
Check(1 = cmd.GetCount);
Check(cqrsSuccess = cmd.Get(entity));
Check(iText = entity.Caption);
end;
// Check(cqrsSuccess = cmd.SelectAllByCaption('1'));
// Check(1 = cmd.GetCount);
// Check(cqrsSuccess = cmd.GetNext(entity));
// entity.Caption := 'hello';
// Check(cqrsSuccess = cmd.Update(entity));
// Check(cqrsSuccess = cmd.Commit);
// test update
for i := 1 to MAX do
begin
UInt32ToUtf8(i, iText);
Check(cqrsSuccess = cmd.SelectOneByCaption(iText));
Check(1 = cmd.GetCount);
Check(cqrsSuccess = cmd.Get(entity));
Check(iText = entity.Caption);
iText := PreFix + iText;
entity.Caption := iText;
Check(cqrsSuccess = cmd.Update(entity));
end;
Check(cqrsSuccess = cmd.Commit);
// check effect of update
for i := 1 to MAX do
begin
UInt32ToUtf8(i, iText);
iText := PreFix + iText;
Check(cqrsSuccess = cmd.SelectOneByCaption(iText)); // error occurs here
Check(1 = cmd.GetCount);
Check(cqrsSuccess = cmd.Get(entity));
Check(iText = entity.Caption);
end;
// test delete
Check(cqrsSuccess = cmd.SelectAll);
Check(cqrsSuccess = cmd.DeleteAll);
Check(cqrsSuccess = cmd.Commit);
Check(cqrsSuccess = cmd.SelectAll);
Check(0 = cmd.GetCount);
finally
entity.Free;
end;
end;
end;
var
RestServer: TSQLRestServerFullMemory;
RestClient: TSQLRestClientURI;
begin
RestServer := TSQLRestServerFullMemory.CreateWithOwnModel([TSQLRecordSomeEntity]);
try // first try directly on server side
RestServer.ServiceContainer.InjectResolver([TInfraRepoEntityFactory.Create(RestServer)],true);
TestOne(RestServer); // sub function will ensure that all I*Command are released
finally
RestServer.Free;
end;
RestServer := TSQLRestServerFullMemory.CreateWithOwnModel([TSQLRecordSomeEntity]);
try // then try from a client-server process
RestServer.ServiceContainer.InjectResolver([TInfraRepoEntityFactory.Create(RestServer)],true);
RestServer.ServiceDefine(TInfraRepoEntity,[IDomEntityCommand,IDomEntityQuery],sicClientDriven);
test.Check(RestServer.ExportServer);
RestClient := TSQLRestClientURIDll.Create(TSQLModel.Create(RestServer.Model),@URIRequest);
try
RestClient.Model.Owner := RestClient;
RestClient.ServiceDefine([IDomEntityCommand],sicClientDriven);
TestOne(RestServer);
RestServer.DropDatabase;
USEFASTMM4ALLOC := true; // for slightly faster process
TestOne(RestClient);
finally
RestClient.Free;
end;
finally
RestServer.Free;
end;
end;
{ TTestRepoEntity }
procedure TTestRepoEntity.TestSelf;
begin
TInfraRepoEntityFactory.RegressionTests(Self);
end;
{ TTestSuit }
procedure TTestSuit.TestAll;
begin
AddCase([TTestRepoEntity]);
end;
initialization
TJSONSerializer.RegisterObjArrayForJSON([
TypeInfo(TSomeEntityObjArray), TSomeEntity]);
TInterfaceFactory.RegisterInterfaces([
TypeInfo(IDomEntityQuery), TypeInfo(IDomEntityCommand)]);
end.
Offline
@ab, would you please figure out what should done to avoid this error?
Offline
Pages: 1