Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 07:45:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

+ added more unit test for TMVCActiveRecord.Merge method

Browse Source
This commit is contained in:
Daniele Teti 2021-09-23 22:52:28 +02:00
parent 0927e3c449
commit e3eb26e04a
13 changed files with 646 additions and 1496 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -114,3 +114,4 @@ samples/data/activerecorddb.sql
samples/data/dump.sql
samples/activerecord_showcase/activerecord_showcase.delphilsp.json
unittests/general/TestServer/TestServer.delphilsp.json
samples/master_details/masterdetailssample.otares

40
samples/master_details/BusinessObjects.pas
View File

@ -29,6 +29,7 @@ interface
uses
MVCFramework.Serializer.Commons,
MVCFramework.ActiveRecord,
MVCFramework.Nullables,
System.Generics.Collections,
System.Classes;
@ -57,7 +58,7 @@ type
TOrderDetail = class(TMVCActiveRecord)
private
[MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
fID: Int64;
fID: NullableInt64;
[MVCTableField('id_order')]
fIDOrder: Int64;
[MVCTableField('id_article')]
@ -75,7 +76,7 @@ type
public
constructor Create; override;
destructor Destroy; override;
property ID: Int64 read fID write fID;
property ID: NullableInt64 read fID write fID;
property IDOrder: Int64 read fIDOrder write fIDOrder;
property IDArticle: Int64 read fIDArticle write fIDArticle;
property UnitPrice: Currency read fUnitPrice write fUnitPrice;
@ -97,9 +98,12 @@ type
fOrderDate: TDate;
[MVCTableField('total')]
fTotal: Currency;
[MVCOwned]
fDetails: TObjectList<TOrderDetail>;
protected
procedure OnAfterLoad; override;
procedure OnAfterUpdate; override;
procedure OnAfterInsert; override;
public
constructor Create; override;
destructor Destroy; override;
@ -147,12 +151,42 @@ begin
inherited;
end;
procedure TOrder.OnAfterInsert;
begin
inherited;
for var lOrderDetail in fDetails do
begin
lOrderDetail.IDOrder := ID;
lOrderDetail.Insert;
end;
end;
procedure TOrder.OnAfterUpdate;
begin
inherited;
var lOrderItems := TMVCActiveRecord.SelectRQL<TOrderDetail>(Format('eq(idorder,%d)', [ID]), 100);
try
TMVCActiveRecord.Merge<TOrderDetail>(lOrderItems, fDetails)
.Apply(
procedure (const Obj: TOrderDetail; const EntityAction: TMVCEntityAction;
var Handled: Boolean)
begin
if EntityAction in [eaCreate, eaUpdate] then
begin
Obj.IDOrder := ID;
end;
end);
finally
lOrderItems.Free;
end;
end;
procedure TOrder.OnAfterLoad;
var
lList: TObjectList<TOrderDetail>;
begin
inherited;
lList := TMVCActiveRecord.SelectRQL<TOrderDetail>(Format('eq(order_id,%d)',[ID]), 1000);
lList := TMVCActiveRecord.SelectRQL<TOrderDetail>(Format('eq(idOrder,%d)',[ID]), 1000);
try
fDetails.Clear;
fDetails.AddRange(lList);

31
samples/master_details/Controllers.Orders.pas
View File

@ -67,8 +67,8 @@ uses
procedure TOrdersController.CreateOrder(const [MVCFromBody] Order: TOrder);
begin
// GetOrdersService.Add(Order);
// Render201Created('/Orders/' + Order.id.ToString, 'Order Created');
Order.Insert;
Render201Created('/orders/' + Order.id.ToString, 'Order Created');
end;
procedure TOrdersController.CreateOrders(const OrderList: TObjectList<TOrder>);
@ -108,13 +108,26 @@ end;
procedure TOrdersController.GetOrders;
begin
// Render(ObjectDict().Add('data', GetOrdersService.GetAll));
try
Render(ObjectDict().Add('data', TMVCActiveRecord.All<TOrder>));
// Render(ObjectDict().Add('data', GetOrdersService.GetByID(id)));
except
on E: EServiceException do
begin
raise EMVCException.Create(E.Message, '', 0, 404);
end
end;
end;
procedure TOrdersController.GetOrdersByDescription(const Search: String);
var
lDict: IMVCObjectDictionary;
begin
// Render(
// ObjectDict()
// .Add('data', TMVCActiveRecord.SelectRQL<TOrder>(Format('contains(description,"%s")',[Search]),100))
// );
// try
// if Search = '' then
// begin
@ -137,14 +150,20 @@ end;
procedure TOrdersController.UpdateOrderByID(const Order: TOrder; const id: Integer);
begin
// Order.id := id;
// GetOrdersService.Update(Order);
// Render(200, 'Order Updated');
Order.id := id;
var lCurrentOrder := TMVCActiveRecord.GetByPK<TOrder>(id);
try
Order.Update();
finally
lCurrentOrder.Free;
end;
Render(200, 'Order Updated');
end;
procedure TOrdersController.GetOrderByID(id: Integer);
begin
try
Render(TMVCActiveRecord.GetByPK<TOrder>(id));
// Render(ObjectDict().Add('data', GetOrdersService.GetByID(id)));
except
on E: EServiceException do

4
samples/master_details/FDConnectionConfigU.pas
View File

@ -17,7 +17,9 @@ implementation
uses
System.Classes,
System.IOUtils,
FireDAC.Comp.Client;
FireDAC.Comp.Client,
FireDAC.Phys.PG,
MVCFramework.SQLGenerators.PostgreSQL;
procedure CreateMySQLPrivateConnDef(AIsPooled: boolean);
var

2
samples/master_details/WebModuleUnit1.dfm
View File

@ -1,5 +1,4 @@
object WebModule1: TWebModule1
OldCreateOrder = False
OnCreate = WebModuleCreate
Actions = <
item
@ -9,4 +8,5 @@ object WebModule1: TWebModule1
end>
Height = 230
Width = 415
PixelsPerInch = 96
end

4
samples/master_details/WebModuleUnit1.pas
View File

@ -21,7 +21,8 @@ implementation
{ %CLASSGROUP 'Vcl.Controls.TControl' }
uses Controllers.Orders, mvcframework.Middleware.CORS, mvcframework.Middleware.Compression,
Controllers.Base, MVCFramework.Commons;
Controllers.Base, MVCFramework.Commons, MVCFramework.Middleware.ActiveRecord,
FDConnectionConfigU;
{$R *.dfm}
@ -38,6 +39,7 @@ begin
{$IFDEF TESTINSTANCE}
FEngine.AddController(TPrivateController);
{$ENDIF}
FEngine.AddMiddleware(TMVCActiveRecordMiddleware.Create(CON_DEF_NAME, ''));
FEngine.AddMiddleware(TCORSMiddleware.Create);
FEngine.AddMiddleware(TMVCCompressionMiddleware.Create(256));

1
samples/master_details/masterdetailssample.dpr
View File

@ -40,6 +40,7 @@ end;
begin
ReportMemoryLeaksOnShutdown := True;
try
CreatePostgresqlPrivateConnDef(True);
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
RunServer(8080);

1540
samples/master_details/masterdetailssample.dproj
View File

File diff suppressed because it is too large Load Diff

69
sources/MVCFramework.ActiveRecord.pas
View File

@ -2748,39 +2748,42 @@ var
begin
lUnitOfWork := TMVCUnitOfWork<T>.Create;
lUnitOfWork.RegisterDelete(CurrentList);
lPKType := NewList[i].GetPrimaryKeyFieldType;
for i := 0 to NewList.Count - 1 do
if NewList.Count > 0 then
begin
if NewList[i].PKIsNull then
lPKType := NewList[0].GetPrimaryKeyFieldType;
for i := 0 to NewList.Count - 1 do
begin
lUnitOfWork.RegisterInsert(NewList[i]);
continue;
end;
if NewList[i].PKIsNull then
begin
lUnitOfWork.RegisterInsert(NewList[i]);
continue;
end;
case lPKType of
ftString:
begin
lNeedsToBeUpdated := TMVCUnitOfWork<T>.KeyExistsString(CurrentList,
NewList[i].GetPK.AsString, lFoundAtIndex);
end;
ftInteger:
begin
lNeedsToBeUpdated := TMVCUnitOfWork<T>.KeyExistsInt(CurrentList,
NewList[i].GetPK.AsInteger, lFoundAtIndex);
end;
ftLargeInt:
begin
lNeedsToBeUpdated := TMVCUnitOfWork<T>.KeyExistsInt64(CurrentList,
NewList[i].GetPK.AsInt64, lFoundAtIndex);
end;
else
raise EMVCActiveRecord.Create('Invalid primary key type');
end;
case lPKType of
ftString:
begin
lNeedsToBeUpdated := TMVCUnitOfWork<T>.KeyExistsString(CurrentList,
NewList[i].GetPK.AsString, lFoundAtIndex);
end;
ftInteger:
begin
lNeedsToBeUpdated := TMVCUnitOfWork<T>.KeyExistsInt(CurrentList,
NewList[i].GetPK.AsInteger, lFoundAtIndex);
end;
ftLargeInt:
begin
lNeedsToBeUpdated := TMVCUnitOfWork<T>.KeyExistsInt64(CurrentList,
NewList[i].GetPK.AsInt64, lFoundAtIndex);
end;
else
raise EMVCActiveRecord.Create('Invalid primary key type');
end;
if lNeedsToBeUpdated then
lUnitOfWork.RegisterUpdate(NewList[i])
else
lUnitOfWork.RegisterInsert(NewList[i]);
if lNeedsToBeUpdated then
lUnitOfWork.RegisterUpdate(NewList[i])
else
lUnitOfWork.RegisterInsert(NewList[i]);
end;
end;
Result := lUnitOfWork as IMVCMultiExecutor<T>;
end;
@ -3148,7 +3151,7 @@ end;
procedure TMVCUnitOfWork<T>.Apply(const ItemApplyAction: TMVCItemApplyAction<T>);
var
i: UInt32;
i: Integer;
lHandled: Boolean;
begin
for i := 0 to fListToInsert.Count - 1 do
@ -3166,7 +3169,7 @@ begin
DoItemApplyAction(fListToUpdate[i], eaUpdate, ItemApplyAction, lHandled);
if not lHandled then
begin
fListToUpdate[i].Update;
fListToUpdate[i].Update(True);
end;
end;
for i := 0 to fListToDelete.Count - 1 do
@ -3175,7 +3178,7 @@ begin
DoItemApplyAction(fListToDelete[i], eaDelete, ItemApplyAction, lHandled);
if not lHandled then
begin
fListToDelete[i].Delete;
fListToDelete[i].Delete(True);
end;
end;
end;
@ -3246,7 +3249,7 @@ begin
Result := false;
for i := 0 to NewList.Count - 1 do
begin
if NewList[i].GetPK.AsInt64 = KeyValue then
if (not NewList[i].PKIsNull) and (NewList[i].GetPK.AsInt64 = KeyValue) then
begin
Index := i;
Exit(True);

6
sources/MVCFramework.Middleware.ActiveRecord.pas
View File

@ -95,6 +95,12 @@ begin
Exit;
end;
if fConnectionDefFileName.IsEmpty then
begin
fConnectionLoaded := True;
Exit;
end;
// if not FDManager.ConnectionDefFileLoaded then
// begin
FDManager.ConnectionDefFileName := fConnectionDefFileName;

387
unittests/general/Several/ActiveRecordTestsU.pas
View File

@ -39,7 +39,7 @@ type
fConnection: TFDConnection;
fConDefName: string;
procedure CreatePrivateConnDef(AIsPooled: boolean); virtual; abstract;
procedure LoadData; virtual;
procedure LoadData(const JustAFew: Boolean = False); virtual;
procedure AfterDataLoad; virtual; abstract;
procedure InternalSetupFixture; virtual;
public
@ -79,6 +79,14 @@ type
procedure TestMultiThreading;
[Test]
procedure TestNullables;
[Test]
procedure TestMergeWhenNewRecords;
[Test]
procedure TestMergeWhenNewDeletedRecords;
[Test]
procedure TestMergeWhenChangedRecords;
[Test]
procedure TestMergeWhenMixedRecords;
end;
[TestFixture]
@ -123,7 +131,7 @@ implementation
uses
System.Classes, System.IOUtils, BOs, MVCFramework.ActiveRecord,
System.SysUtils, System.Threading, System.Generics.Collections, Data.DB,
FireDAC.Stan.Intf, ShellAPI, Winapi.Windows;
FireDAC.Stan.Intf, ShellAPI, Winapi.Windows, MVCFramework.Logger;
const
_CON_DEF_NAME_SQLITE = 'SQLITECONNECTION';
@ -215,7 +223,7 @@ begin
Assert.AreEqual('note1noteupdated', lCustomer.Note);
Assert.AreEqual('bit Time Professionals', lCustomer.CompanyName.Value);
Assert.AreEqual('Rome, IT', lCustomer.City);
Assert.AreEqual(1, lCustomer.ID);
Assert.AreEqual(1, lCustomer.ID.Value);
Assert.IsFalse(lCustomer.CreationTime.HasValue);
Assert.IsFalse(lCustomer.CreationDate.HasValue);
finally
@ -524,6 +532,346 @@ begin
end;
end;
procedure TTestActiveRecordBase.TestMergeWhenChangedRecords;
var
lCustomer: TCustomer;
lCustomers: TObjectList<TCustomer>;
lCustomersChanges: TObjectList<TCustomer>;
lInserted, lUpdated, lDeleted, lTotCustomers : Integer;
begin
TMVCActiveRecord.DeleteAll(TCustomer);
LoadData(true);
lCustomers := TMVCActiveRecord.SelectRQL<TCustomer>('eq(rating,1)', 1000);
try
lCustomersChanges := TObjectList<TCustomer>.Create(True);
try
for var lCust in lCustomers do
begin
lCustomer := lCust.Clone;
lCustomer.Rating := 10;
lCustomersChanges.Add(lCustomer);
end;
//calculate the unit-of-work to merge the lists
lInserted := 0;
lUpdated := 0;
lDeleted := 0;
TMVCActiveRecord.Merge<TCustomer>(lCustomers, lCustomersChanges).Apply(
procedure (const Customer: TCustomer; const EntityAction: TMVCEntityAction; var Handled: Boolean)
begin
Handled := False;
case EntityAction of
eaCreate: begin
LogI('Inserting Customer : ' + Customer.ToString);
Inc(lInserted);
end;
eaUpdate: begin
LogI('Updating Customer : ' + Customer.ToString);
Inc(lUpdated);
end;
eaDelete: begin
LogI('Deleting Customer : ' + Customer.ToString);
Inc(lDeleted);
end;
end;
end);
finally
lCustomersChanges.Free;
end;
finally
lCustomers.Free;
end;
Assert.AreEqual(0, lInserted);
Assert.AreEqual(30, lUpdated);
Assert.AreEqual(0, lDeleted);
lCustomers := TMVCActiveRecord.All<TCustomer>;
try
Assert.AreEqual(30, lCustomers.Count);
finally
lCustomers.Free;
end;
lCustomers := TMVCActiveRecord.SelectRQL<TCustomer>('eq(rating,10)', 1000);
try
Assert.AreEqual(30, lCustomers.Count);
finally
lCustomers.Free;
end;
end;
procedure TTestActiveRecordBase.TestMergeWhenMixedRecords;
var
lCustomer: TCustomer;
lCustomers: TObjectList<TCustomer>;
lCustomersChanges: TObjectList<TCustomer>;
lInserted, lUpdated, lDeleted, lTotCustomers : Integer;
begin
TMVCActiveRecord.DeleteAll(TCustomer);
LoadData(true);
lCustomers := TMVCActiveRecord.SelectRQL<TCustomer>('eq(rating,1)', 1000);
try
lCustomersChanges := TObjectList<TCustomer>.Create(True);
try
//these 2 customers will be updated
lCustomer := TCustomer.Create;
lCustomersChanges.Add(lCustomer);
lCustomer.ID := lCustomers[0].ID;
lCustomer.Code := 'C8765';
lCustomer.CompanyName := '(changed) Company1';
lCustomer.City := '(changed) City';
lCustomer.Rating := 2;
lCustomer := TCustomer.Create;
lCustomersChanges.Add(lCustomer);
lCustomer.ID := lCustomers[1].ID;
lCustomer.Code := lCustomers[1].Code;
lCustomer.CompanyName := '(changed) Company2';
lCustomer.City := '(changed) City';
lCustomer.Rating := 2;
//these 2 customer will be created
lCustomer := TCustomer.Create;
lCustomersChanges.Add(lCustomer);
lCustomer.Code := 'C9898';
lCustomer.CompanyName := '(new) Company3';
lCustomer.City := '(new) New City2';
lCustomer.Rating := 3;
lCustomer := TCustomer.Create;
lCustomersChanges.Add(lCustomer);
lCustomer.Code := 'C2343';
lCustomer.CompanyName := '(new) Company4';
lCustomer.City := '(new) New City2';
lCustomer.Rating := 3;
//these 2 customer will remain the same but will be updated
lCustomer := TCustomer.Create;
lCustomer.Assign(lCustomers[2]);
lCustomersChanges.Add(lCustomer);
lCustomer := TCustomer.Create;
lCustomer.Assign(lCustomers[3]);
lCustomersChanges.Add(lCustomer);
//all the other customers will be deleted
//calculate the unit-of-work to merge the lists
lInserted := 0;
lUpdated := 0;
lDeleted := 0;
TMVCActiveRecord.Merge<TCustomer>(lCustomers, lCustomersChanges).Apply(
procedure (const Customer: TCustomer; const EntityAction: TMVCEntityAction; var Handled: Boolean)
begin
Handled := False;
case EntityAction of
eaCreate: begin
LogI('Inserting Customer : ' + Customer.ToString);
Inc(lInserted);
end;
eaUpdate: begin
LogI('Updating Customer : ' + Customer.ToString);
Inc(lUpdated);
end;
eaDelete: begin
LogI('Deleting Customer : ' + Customer.ToString);
Inc(lDeleted);
end;
end;
end);
finally
lCustomersChanges.Free;
end;
finally
lCustomers.Free;
end;
Assert.AreEqual(2, lInserted);
Assert.AreEqual(4, lUpdated);
Assert.AreEqual(26, lDeleted);
lCustomers := TMVCActiveRecord.All<TCustomer>;
try
Assert.AreEqual(6, lCustomers.Count);
finally
lCustomers.Free;
end;
lCustomers := TMVCActiveRecord.SelectRQL<TCustomer>('eq(rating,3)', 1000);
try
Assert.AreEqual(2, lCustomers.Count);
finally
lCustomers.Free;
end;
lCustomers := TMVCActiveRecord.SelectRQL<TCustomer>('eq(rating,2)', 1000);
try
Assert.AreEqual(2, lCustomers.Count, 'Customers not updated correctly');
finally
lCustomers.Free;
end;
lCustomers := TMVCActiveRecord.SelectRQL<TCustomer>('eq(rating,1)', 1000);
try
Assert.AreEqual(2, lCustomers.Count);
finally
lCustomers.Free;
end;
end;
procedure TTestActiveRecordBase.TestMergeWhenNewDeletedRecords;
var
lCustomer: TCustomer;
lCustomers: TObjectList<TCustomer>;
lCustomersChanges: TObjectList<TCustomer>;
lInserted, lUpdated, lDeleted, lTotCustomers : Integer;
begin
TMVCActiveRecord.DeleteAll(TCustomer);
LoadData(true);
lCustomers := TMVCActiveRecord.SelectRQL<TCustomer>('eq(rating,1)', 1000);
try
lCustomersChanges := TObjectList<TCustomer>.Create(True);
try
lTotCustomers := lCustomersChanges.Count;
lInserted := 0;
lUpdated := 0;
lDeleted := 0;
//calculate the unit-of-work to merge the lists
TMVCActiveRecord.Merge<TCustomer>(lCustomers, lCustomersChanges).Apply(
procedure (const Customer: TCustomer; const EntityAction: TMVCEntityAction; var Handled: Boolean)
begin
Handled := False;
case EntityAction of
eaCreate: begin
LogI('Inserting Customer : ' + Customer.ToString);
Inc(lInserted);
end;
eaUpdate: begin
LogI('Updating Customer : ' + Customer.ToString);
Inc(lUpdated);
end;
eaDelete: begin
LogI('Deleting Customer : ' + Customer.ToString);
Inc(lDeleted);
end;
end;
end);
finally
lCustomersChanges.Free;
end;
finally
lCustomers.Free;
end;
Assert.AreEqual(0, lInserted);
Assert.AreEqual(0, lUpdated);
Assert.AreEqual(30, lDeleted);
lCustomers := TMVCActiveRecord.All<TCustomer>;
try
Assert.AreEqual(lTotCustomers, lCustomers.Count);
finally
lCustomers.Free;
end;
end;
procedure TTestActiveRecordBase.TestMergeWhenNewRecords;
var
lCustomer: TCustomer;
lCustomers: TObjectList<TCustomer>;
lCustomersChanges: TObjectList<TCustomer>;
lInserted, lUpdated, lDeleted, lTotCustomers : Integer;
begin
TMVCActiveRecord.DeleteAll(TCustomer);
LoadData(true);
lCustomers := TMVCActiveRecord.SelectRQL<TCustomer>('eq(rating,1)', 1000);
try
lCustomersChanges := TObjectList<TCustomer>.Create(True);
try
for var lCust in lCustomers do
begin
lCustomersChanges.Add(lCust.Clone);
end;
//these 2 customer will be created
lCustomer := TCustomer.Create;
lCustomersChanges.Add(lCustomer);
lCustomer.Code := 'C9898';
lCustomer.CompanyName := '(new) Company3';
lCustomer.City := '(new) New City2';
lCustomer.Rating := 3;
lCustomer := TCustomer.Create;
lCustomersChanges.Add(lCustomer);
lCustomer.Code := 'C2343';
lCustomer.CompanyName := '(new) Company4';
lCustomer.City := '(new) New City2';
lCustomer.Rating := 3;
lTotCustomers := lCustomersChanges.Count;
lInserted := 0;
lUpdated := 0;
lDeleted := 0;
//calculate the unit-of-work to merge the lists
TMVCActiveRecord.Merge<TCustomer>(lCustomers, lCustomersChanges).Apply(
procedure (const Customer: TCustomer; const EntityAction: TMVCEntityAction; var Handled: Boolean)
begin
Handled := False;
case EntityAction of
eaCreate: begin
LogI('Inserting Customer : ' + Customer.ToString);
Inc(lInserted);
end;
eaUpdate: begin
LogI('Updating Customer : ' + Customer.ToString);
Inc(lUpdated);
end;
eaDelete: begin
LogI('Deleting Customer : ' + Customer.ToString);
Inc(lDeleted);
end;
end;
end);
finally
lCustomersChanges.Free;
end;
finally
lCustomers.Free;
end;
Assert.AreEqual(2, lInserted);
Assert.AreEqual(30, lUpdated);
Assert.AreEqual(0, lDeleted);
lCustomers := TMVCActiveRecord.All<TCustomer>;
try
Assert.AreEqual(lTotCustomers, lCustomers.Count);
finally
lCustomers.Free;
end;
lCustomers := TMVCActiveRecord.SelectRQL<TCustomer>('eq(rating,1)', 1000);
try
Assert.AreEqual(lTotCustomers - 2, lCustomers.Count, 'Some customer changed when should not change');
finally
lCustomers.Free;
end;
lCustomers := TMVCActiveRecord.SelectRQL<TCustomer>('eq(rating,3)', 1000);
try
Assert.AreEqual(2, lCustomers.Count, 'Some customer changed when should not change');
finally
lCustomers.Free;
end;
end;
procedure TTestActiveRecordBase.TestMultiThreading;
begin
LoadData;
@ -870,7 +1218,7 @@ begin
// do nothing
end;
procedure TTestActiveRecordBase.LoadData;
procedure TTestActiveRecordBase.LoadData(const JustAFew: Boolean);
var
lTasks: TArray<ITask>;
lProc: TProc;
@ -886,8 +1234,10 @@ begin
lCustomer: TCustomer;
I: Integer;
begin
ActiveRecordConnectionsRegistry.AddDefaultConnection(TFDConnection.Create(nil), True);
//ActiveRecordConnectionsRegistry.AddDefaultConnection(TFDConnection.Create(nil), True);
ActiveRecordConnectionsRegistry.AddConnection('load', TFDConnection.Create(nil), True);
try
ActiveRecordConnectionsRegistry.SetCurrent('load');
ActiveRecordConnectionsRegistry.GetCurrent.ConnectionDefName := fConDefName;
for I := 1 to 30 do
begin
@ -899,6 +1249,7 @@ begin
Format('%s %s %s', [lCustomer.City, Stuff[Random(high(Stuff) + 1)],
CompanySuffix[Random(high(CompanySuffix) + 1)]]);
lCustomer.Note := Stuff[I mod Length(Stuff)];
lCustomer.Rating := 1;
lCustomer.CreationTime := EncodeTime(I mod 23, I, 60 - 1, 0);
lCustomer.CreationDate := EncodeDate(2020 - I, (I mod 12) + 1, (I mod 27) + 1);
lCustomer.Insert;
@ -907,26 +1258,36 @@ begin
end;
end;
finally
ActiveRecordConnectionsRegistry.RemoveDefaultConnection;
ActiveRecordConnectionsRegistry.RemoveConnection('load');
end;
end;
AfterDataLoad;
lTasks := [TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc),
TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc),
TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc),
TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc),
TTask.Run(lProc)];
TTask.WaitForAll(lTasks);
if JustAFew then
begin
lProc();
ActiveRecordConnectionsRegistry.SetCurrent('default');
end
else
begin
lTasks := [TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc),
TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc),
TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc),
TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc), TTask.Run(lProc),
TTask.Run(lProc)];
TTask.WaitForAll(lTasks);
end;
end;
procedure TTestActiveRecordBase.SetupFixturePG;
begin
LogI('** Setup Fixture: ' + ClassName);
InternalSetupFixture;
end;
procedure TTestActiveRecordSQLite.Setup;
begin
LogI('** Setup Test: ' + ClassName);
fConDefName := _CON_DEF_NAME_SQLITE;
fConnection := TFDConnection.Create(nil);
fConnection.ConnectionDefName := fConDefName;
@ -1009,6 +1370,7 @@ end;
procedure TTestActiveRecordFirebird.Setup;
begin
LogI('** Setup Test: ' + ClassName);
fConDefName := _CON_DEF_NAME_FIREBIRD;
fConnection := TFDConnection.Create(nil);
fConnection.ConnectionDefName := fConDefName;
@ -1116,6 +1478,7 @@ procedure TTestActiveRecordPostgreSQL.Setup;
var
lInitDBStructure: boolean;
begin
LogI('** Setup Test: ' + ClassName);
lInitDBStructure := false;
if not GPGIsInitialized then

36
unittests/general/Several/BOs.pas
View File

@ -27,12 +27,12 @@ unit BOs;
interface
uses
system.TimeSpan, system.SysUtils, generics.collections, system.Classes,
system.TimeSpan, generics.collections, system.Classes,
system.Rtti, MVCFramework.Serializer.Commons, JsonDataObjects,
MVCFramework.ActiveRecord, MVCFramework.Nullables,
MVCFramework.SQLGenerators.SQLite, MVCFramework.SQLGenerators.Firebird,
MVCFramework.SQLGenerators.PostgreSQL,
FireDAC.Stan.Param, Data.DB;
FireDAC.Stan.Param, Data.DB, System.SysUtils;
const
SQLs_SQLITE: array [0 .. 4] of string =
@ -98,7 +98,7 @@ type
TCustomer = class(TMVCActiveRecord)
private
[MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
fID: Integer;
fID: NullableInt32;
[MVCTableField('code')]
fCode: NullableString;
[MVCTableField('description')]
@ -114,7 +114,10 @@ type
[MVCTableField('creation_date')]
fCreationDate: NullableTDate;
public
property ID: Integer read fID write fID;
procedure Assign(Customer: TCustomer); overload;
function Clone: TCustomer;
function ToString: String; override;
property ID: NullableInt32 read fID write fID;
property Code: NullableString read fCode write fCode;
property CompanyName: NullableString read fCompanyName write fCompanyName;
property City: string read fCity write fCity;
@ -1281,4 +1284,29 @@ begin
FMyDateTime := Value;
end;
{ TCustomer }
procedure TCustomer.Assign(Customer: TCustomer);
begin
Self.fID := Customer.fID;
Self.fCode := Customer.fCode;
Self.fCompanyName := Customer.fCompanyName;
Self.fCity := Customer.fCity;
Self.fRating := Customer.fRating;
Self.fNote := Customer.fNote;
Self.fCreationTime := Customer.fCreationTime;
Self.fCreationDate := Customer.fCreationDate;
end;
function TCustomer.Clone: TCustomer;
begin
Result := TCustomer.Create;
Result.Assign(Self);
end;
function TCustomer.ToString: String;
begin
Result := inherited + Format(' [ID:%5d][Company: %s]', [ID.ValueOrDefault, CompanyName.ValueOrDefault]);
end;
end.

21
unittests/general/Several/DMVCFrameworkTests.dproj
View File

@ -4,7 +4,7 @@
<ProjectVersion>19.3</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">CONSOLE</Config>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Console</AppType>
@ -107,6 +107,7 @@
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<DCC_Define>TESTINSIGHT;DEBUG;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_ShowGeneralMessages>true</DCC_ShowGeneralMessages>
@ -303,12 +304,14 @@
<Source Name="MainSource">DMVCFrameworkTests.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k270.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp270.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k280.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp280.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k280.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp280.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="Win32\Debug\DMVCFrameworkTests.exe" Configuration="Debug" Class="ProjectOutput">
<DeployFile LocalName="bin\DMVCFrameworkTests.exe" Configuration="TESTINSIGHT" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>DMVCFrameworkTests.exe</RemoteName>
<Overwrite>true</Overwrite>
@ -332,13 +335,13 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\osx32\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="OSX32">
<DeployFile LocalName="$(BDS)\Redist\iossim32\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="iOSSimulator">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\iossim32\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="iOSSimulator">
<DeployFile LocalName="$(BDS)\Redist\osx32\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="OSX32">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
@ -360,7 +363,7 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="bin\DMVCFrameworkTests.exe" Configuration="TESTINSIGHT" Class="ProjectOutput">
<DeployFile LocalName="Win32\Debug\DMVCFrameworkTests.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>DMVCFrameworkTests.exe</RemoteName>
<Overwrite>true</Overwrite>