// *************************************************************************** // // Delphi MVC Framework // // Copyright (c) 2010-2021 Daniele Teti and the DMVCFramework Team // // https://github.com/danieleteti/delphimvcframework // // *************************************************************************** // // Licensed under the Apache License, Version 2.0 (the "License"); // you may not use this file except in compliance with the License. // You may obtain a copy of the License at // // http://www.apache.org/licenses/LICENSE-2.0 // // Unless required by applicable law or agreed to in writing, software // distributed under the License is distributed on an "AS IS" BASIS, // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. // See the License for the specific language governing permissions and // limitations under the License. // // *************************************************************************** } unit ActiveRecordTestsU; interface uses DUnitX.TestFramework, FireDAC.Comp.Client, FireDAC.ConsoleUI.Wait, FireDAC.VCLUI.Wait, PGUtilsU; const PG_PORT = 5555; type TTestActiveRecordBase = class(TObject) protected fConnection: TFDConnection; fConDefName: string; procedure CreatePrivateConnDef(AIsPooled: boolean); virtual; abstract; procedure LoadData(const JustAFew: Boolean = False); virtual; procedure AfterDataLoad; virtual; abstract; procedure InternalSetupFixture; virtual; public [SetupFixture] procedure SetupFixturePG; [Teardown] procedure Teardown; [Test] procedure TestCRUD; [Test] procedure Test_ISSUE485; [Test] procedure TestDeleteIfNotFound; [Test] procedure TestUpdateIfNotFound; [Test] procedure TestCRUDWithSpaces; [Test] procedure TestCRUDWithTableChange; [Test] procedure TestCRUDStringPK; [Test] procedure TestSelectWithExceptions; [Test] procedure TestStore; [Test] procedure TestLifeCycle; [Test] procedure TestRQL; [Test] procedure TestRQLWithDateTime; [Test] procedure TestRQLLimit; [Test] procedure TestIssue424; [Test] procedure TestMultiThreading; [Test] procedure TestNullables; [Test] procedure TestMergeWhenNewRecords; [Test] procedure TestMergeWhenNewDeletedRecords; [Test] procedure TestMergeWhenChangedRecords; [Test] procedure TestMergeWhenMixedRecords; end; [TestFixture] TTestActiveRecordSQLite = class(TTestActiveRecordBase) protected procedure AfterDataLoad; override; procedure CreatePrivateConnDef(AIsPooled: boolean); override; public [Setup] procedure Setup; virtual; end; [TestFixture] TTestActiveRecordFirebird = class(TTestActiveRecordBase) protected procedure AfterDataLoad; override; procedure CreatePrivateConnDef(AIsPooled: boolean); override; public [Setup] procedure Setup; end; [TestFixture] TTestActiveRecordPostgreSQL = class(TTestActiveRecordBase) private fPGUtil: TPGUtil; protected procedure AfterDataLoad; override; procedure CreatePrivateConnDef(AIsPooled: boolean); override; procedure InternalSetupFixture; override; public [TearDownFixture] procedure TearDownFixture; [Setup] procedure Setup; constructor Create; destructor Destroy; override; end; implementation uses System.Classes, System.IOUtils, BOs, MVCFramework.ActiveRecord, System.SysUtils, System.Threading, System.Generics.Collections, Data.DB, FireDAC.Stan.Intf, ShellAPI, Winapi.Windows, MVCFramework.Logger; const _CON_DEF_NAME_SQLITE = 'SQLITECONNECTION'; _CON_DEF_NAME_FIREBIRD = 'FIREBIRDCONNECTION'; _CON_DEF_NAME_POSTGRESQL = 'POSTGRESQLCONNECTION'; var GDBFileName: string = ''; SQLiteFileName: string = 'sqlitetest.db'; GDBTemplateFileName: string = ''; GPGIsInitialized: boolean = false; procedure TTestActiveRecordSQLite.AfterDataLoad; begin { TODO -oDanieleT -cGeneral : Hot to reset a sqlite autoincrement field? } // https://sqlite.org/fileformat2.html#seqtab // https://stackoverflow.com/questions/5586269/how-can-i-reset-a-autoincrement-sequence-number-in-sqlite/14298431 TMVCActiveRecord.CurrentConnection.ExecSQL('delete from sqlite_sequence where name=''customers'''); TMVCActiveRecord.CurrentConnection.ExecSQL('delete from sqlite_sequence where name=''customers2'''); TMVCActiveRecord.CurrentConnection.ExecSQL('delete from sqlite_sequence where name=''customers with spaces'''); //TMVCActiveRecord.CurrentConnection.ExecSQL('drop table if exists sqlite_sequence'); end; procedure TTestActiveRecordSQLite.CreatePrivateConnDef(AIsPooled: boolean); var LParams: TStringList; begin LParams := TStringList.Create; try SQLiteFileName := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), SQLiteFileName); LParams.Add('Database=' + SQLiteFileName); LParams.Add('OpenMode=CreateUTF8'); if AIsPooled then begin LParams.Add('Pooled=True'); LParams.Add('POOL_MaximumItems=100'); end else begin LParams.Add('Pooled=False'); end; FDManager.AddConnectionDef(fConDefName, 'SQLite', LParams); finally LParams.Free; end; end; procedure TTestActiveRecordBase.TestCRUD; var lCustomer: TCustomer; lID: Integer; begin Assert.AreEqual(Int64(0), TMVCActiveRecord.Count()); lCustomer := TCustomer.Create; try lCustomer.CompanyName := 'bit Time Professionals'; lCustomer.City := 'Rome, IT'; lCustomer.Note := 'note1'; lCustomer.CreationTime := Time; lCustomer.CreationDate := Date; lCustomer.ID := -1; { don't be fooled by the default! } lCustomer.Insert; lID := lCustomer.ID; Assert.AreEqual(1, lID); finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID); try Assert.IsFalse(lCustomer.Code.HasValue); Assert.IsFalse(lCustomer.Rating.HasValue); Assert.IsTrue(lCustomer.CreationTime.HasValue); Assert.IsTrue(lCustomer.CreationDate.HasValue); lCustomer.Code := '1234'; lCustomer.Rating := 3; lCustomer.Note := lCustomer.Note + 'noteupdated'; lCustomer.CreationTime.Clear; lCustomer.CreationDate.Clear; lCustomer.Update; finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID); try Assert.AreEqual('1234', lCustomer.Code.Value); Assert.AreEqual(3, lCustomer.Rating.Value); Assert.AreEqual('note1noteupdated', lCustomer.Note); Assert.AreEqual('bit Time Professionals', lCustomer.CompanyName.Value); Assert.AreEqual('Rome, IT', lCustomer.City); Assert.AreEqual(1, lCustomer.ID.Value); Assert.IsFalse(lCustomer.CreationTime.HasValue); Assert.IsFalse(lCustomer.CreationDate.HasValue); finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID); try lCustomer.Delete; finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID, false); Assert.IsNull(lCustomer); lCustomer := TMVCActiveRecord.GetOneByWhere('id = ?', [lID], [ftInteger], false); Assert.IsNull(lCustomer); end; procedure TTestActiveRecordBase.TestCRUDStringPK; var lCustomer: TCustomerWithCode; begin Assert.AreEqual(Int64(0), TMVCActiveRecord.Count()); lCustomer := TCustomerWithCode.Create; try lCustomer.Code := '1000'; lCustomer.CompanyName := 'bit Time Professionals'; lCustomer.City := 'Rome, IT'; lCustomer.Note := 'note1'; lCustomer.Insert; finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK('1000'); try Assert.IsFalse(lCustomer.Rating.HasValue); lCustomer.Rating := 3; lCustomer.Note := lCustomer.Note + 'noteupdated'; lCustomer.Update; finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK('1000'); try Assert.AreEqual('1000', lCustomer.Code); Assert.AreEqual(3, lCustomer.Rating.Value); Assert.AreEqual('note1noteupdated', lCustomer.Note); Assert.AreEqual('bit Time Professionals', lCustomer.CompanyName.Value); Assert.AreEqual('Rome, IT', lCustomer.City); finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK('1000'); try lCustomer.Delete; finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK('1000', false); Assert.IsNull(lCustomer); lCustomer := TMVCActiveRecord.GetOneByWhere('code = ?', ['1000'], [ftString], false); Assert.IsNull(lCustomer); end; procedure TTestActiveRecordBase.TestCRUDWithSpaces; var lCustomer: TCustomerWithSpaces; lID: Integer; begin Assert.AreEqual(Int64(0), TMVCActiveRecord.Count()); lCustomer := TCustomerWithSpaces.Create; try lCustomer.CompanyName := 'bit Time Professionals'; lCustomer.City := 'Rome, IT'; lCustomer.Note := 'note1'; lCustomer.CreationTime := Time; lCustomer.CreationDate := Date; lCustomer.ID := -1; { don't be fooled by the default! } lCustomer.Insert; lID := lCustomer.ID; Assert.AreEqual(1, lID); finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID); try Assert.IsFalse(lCustomer.Code.HasValue); Assert.IsFalse(lCustomer.Rating.HasValue); Assert.IsTrue(lCustomer.CreationTime.HasValue); Assert.IsTrue(lCustomer.CreationDate.HasValue); lCustomer.Code := '1234'; lCustomer.Rating := 3; lCustomer.Note := lCustomer.Note + 'noteupdated'; lCustomer.CreationTime.Clear; lCustomer.CreationDate.Clear; lCustomer.Update; finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID); try Assert.AreEqual('1234', lCustomer.Code.Value); Assert.AreEqual(3, lCustomer.Rating.Value); 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.IsFalse(lCustomer.CreationTime.HasValue); Assert.IsFalse(lCustomer.CreationDate.HasValue); finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID); try lCustomer.Delete; finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID, false); Assert.IsNull(lCustomer); lCustomer := TMVCActiveRecord.GetOneByWhere('"id with spaces" = ?', [lID], [ftInteger], false); Assert.IsNull(lCustomer); end; procedure TTestActiveRecordBase.TestCRUDWithTableChange; var lCustomer: TCustomer; lID: Integer; begin Assert.AreEqual(Int64(0), TMVCActiveRecord.Count()); AfterDataLoad; lCustomer := TCustomer.Create; try lCustomer.CompanyName := 'bit Time Professionals'; lCustomer.City := 'Rome, IT'; lCustomer.Note := 'note1'; lCustomer.CreationTime := Time; lCustomer.CreationDate := Date; lCustomer.ID := -1; { don't be fooled by the default! } lCustomer.Insert; lID := lCustomer.ID; Assert.AreEqual(1, lID); finally lCustomer.Free; end; // the same changing tablename lCustomer := TCustomer.Create; try Assert.AreEqual('customers', lCustomer.TableName); lCustomer.TableName := 'customers2'; lCustomer.CompanyName := 'bit Time Professionals'; lCustomer.City := 'Rome, IT'; lCustomer.Note := 'note1'; lCustomer.CreationTime := Time; lCustomer.CreationDate := Date; lCustomer.ID := -1; { don't be fooled by the default! } lCustomer.Insert; lID := lCustomer.ID; Assert.AreEqual(1, lID); Assert.IsTrue(lCustomer.LoadByPK(lID)); finally lCustomer.Free; end; end; procedure TTestActiveRecordBase.TestDeleteIfNotFound; var lCustomer: TCustomer; lID: Integer; begin lCustomer := TCustomer.Create; try lCustomer.CompanyName := 'bit Time Professionals'; lCustomer.City := 'Rome, IT'; lCustomer.Note := 'note1'; lCustomer.CreationTime := Time; lCustomer.CreationDate := Date; lCustomer.ID := -1; { don't be fooled by the default! } lCustomer.Insert; lID := lCustomer.ID; finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID); try Assert.WillNotRaise( procedure begin lCustomer.Delete(True); end, EMVCActiveRecordNotFound); Assert.WillNotRaise( procedure begin lCustomer.Delete(False); end, EMVCActiveRecordNotFound); Assert.WillRaise( procedure begin lCustomer.Delete(True); end, EMVCActiveRecordNotFound); finally lCustomer.Free; end; end; { https://github.com/danieleteti/delphimvcframework/issues/424 } procedure TTestActiveRecordBase.TestIssue424; var lCustomers: TObjectList; const RQL1 = 'or(eq(City, "Rome"),eq(City, "London"))'; begin Assert.AreEqual(Int64(0), TMVCActiveRecord.Count(TCustomer)); LoadData; lCustomers := TMVCActiveRecord.SelectRQL(RQL1, MAXINT); try Assert.AreEqual(240, lCustomers.Count); finally lCustomers.Free; end; lCustomers := TMVCActiveRecord.SelectRQL(RQL1, 20); try Assert.AreEqual(20, lCustomers.Count); finally lCustomers.Free; end; lCustomers := TMVCActiveRecord.SelectRQL(RQL1, 1); try Assert.AreEqual(1, lCustomers.Count); finally lCustomers.Free; end; lCustomers := TMVCActiveRecord.SelectRQL(RQL1, -1); try Assert.AreEqual(240, lCustomers.Count); finally lCustomers.Free; end; end; procedure TTestActiveRecordBase.TestLifeCycle; var lCustomer: TCustomerWithLF; lID: Integer; begin lCustomer := TCustomerWithLF.Create; try lCustomer.CompanyName := 'bit Time Professionals'; lCustomer.City := 'Rome, IT'; lCustomer.Note := 'note1'; lCustomer.Insert; Assert.AreEqual ('OnValidation|OnBeforeInsert|OnBeforeInsertOrUpdate|OnBeforeExecuteSQL|MapObjectToParams|OnAfterInsert|OnAfterInsertOrUpdate', lCustomer.GetHistory); lID := lCustomer.ID; finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID); try Assert.AreEqual('OnBeforeLoad|MapDatasetToObject|OnAfterLoad', lCustomer.GetHistory); lCustomer.ClearHistory; lCustomer.City := 'XXX'; lCustomer.Update; Assert.AreEqual ('OnValidation|OnBeforeUpdate|OnBeforeInsertOrUpdate|OnBeforeExecuteSQL|MapObjectToParams|OnAfterUpdate|OnAfterInsertOrUpdate', lCustomer.GetHistory); finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetOneByWhere('id = ?', [lID]); try Assert.AreEqual('OnBeforeLoad|MapDatasetToObject|OnAfterLoad', lCustomer.GetHistory); lCustomer.ClearHistory; lCustomer.Delete; Assert.AreEqual ('OnValidation|OnBeforeDelete|OnBeforeExecuteSQL|MapObjectToParams|OnAfterDelete', lCustomer.GetHistory); finally lCustomer.Free; end; end; procedure TTestActiveRecordBase.TestMergeWhenChangedRecords; var lCustomer: TCustomer; lCustomers: TObjectList; lCustomersChanges: TObjectList; lInserted, lUpdated, lDeleted: Integer; begin TMVCActiveRecord.DeleteAll(TCustomer); LoadData(true); lCustomers := TMVCActiveRecord.SelectRQL('eq(rating,1)', 1000); try lCustomersChanges := TObjectList.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(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; try Assert.AreEqual(30, lCustomers.Count); finally lCustomers.Free; end; lCustomers := TMVCActiveRecord.SelectRQL('eq(rating,10)', 1000); try Assert.AreEqual(30, lCustomers.Count); finally lCustomers.Free; end; end; procedure TTestActiveRecordBase.TestMergeWhenMixedRecords; var lCustomer: TCustomer; lCustomers: TObjectList; lCustomersChanges: TObjectList; lInserted, lUpdated, lDeleted: Integer; begin TMVCActiveRecord.DeleteAll(TCustomer); LoadData(true); lCustomers := TMVCActiveRecord.SelectRQL('eq(rating,1)', 1000); try lCustomersChanges := TObjectList.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(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; try Assert.AreEqual(6, lCustomers.Count); finally lCustomers.Free; end; lCustomers := TMVCActiveRecord.SelectRQL('eq(rating,3)', 1000); try Assert.AreEqual(2, lCustomers.Count); finally lCustomers.Free; end; lCustomers := TMVCActiveRecord.SelectRQL('eq(rating,2)', 1000); try Assert.AreEqual(2, lCustomers.Count, 'Customers not updated correctly'); finally lCustomers.Free; end; lCustomers := TMVCActiveRecord.SelectRQL('eq(rating,1)', 1000); try Assert.AreEqual(2, lCustomers.Count); finally lCustomers.Free; end; end; procedure TTestActiveRecordBase.TestMergeWhenNewDeletedRecords; var lCustomers: TObjectList; lCustomersChanges: TObjectList; lInserted, lUpdated, lDeleted, lTotCustomers : Integer; begin TMVCActiveRecord.DeleteAll(TCustomer); LoadData(true); lCustomers := TMVCActiveRecord.SelectRQL('eq(rating,1)', 1000); try lCustomersChanges := TObjectList.Create(True); try lTotCustomers := lCustomersChanges.Count; lInserted := 0; lUpdated := 0; lDeleted := 0; //calculate the unit-of-work to merge the lists TMVCActiveRecord.Merge(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; try Assert.AreEqual(lTotCustomers, lCustomers.Count); finally lCustomers.Free; end; end; procedure TTestActiveRecordBase.TestMergeWhenNewRecords; var lCustomer: TCustomer; lCustomers: TObjectList; lCustomersChanges: TObjectList; lInserted, lUpdated, lDeleted, lTotCustomers : Integer; begin TMVCActiveRecord.DeleteAll(TCustomer); LoadData(true); lCustomers := TMVCActiveRecord.SelectRQL('eq(rating,1)', 1000); try lCustomersChanges := TObjectList.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(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; try Assert.AreEqual(lTotCustomers, lCustomers.Count); finally lCustomers.Free; end; lCustomers := TMVCActiveRecord.SelectRQL('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('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; Assert.AreEqual(Trunc(20 * 30), TMVCActiveRecord.Count(TCustomerWithLF)); end; procedure TTestActiveRecordBase.TestNullables; var lTest: TNullablesTest; begin TMVCActiveRecord.DeleteAll(TNullablesTest); lTest := TNullablesTest.Create(); try lTest.f_int2 := 2; lTest.f_int4 := 4; lTest.f_int8 := 8; lTest.f_blob := TStringStream.Create('Hello World'); lTest.Insert; finally lTest.Free; end; lTest := TMVCActiveRecord.GetFirstByWhere('f_int2 = ?', [2]); try Assert.IsTrue(lTest.f_int2.HasValue); Assert.IsTrue(lTest.f_int4.HasValue); Assert.IsTrue(lTest.f_int8.HasValue); Assert.IsFalse(lTest.f_string.HasValue); Assert.IsFalse(lTest.f_bool.HasValue); Assert.IsFalse(lTest.f_date.HasValue); Assert.IsFalse(lTest.f_time.HasValue); Assert.IsFalse(lTest.f_datetime.HasValue); Assert.IsFalse(lTest.f_float4.HasValue); Assert.IsFalse(lTest.f_float8.HasValue); Assert.IsFalse(lTest.f_bool.HasValue); Assert.IsNotNull(lTest); lTest.f_int2 := lTest.f_int2.Value + 2; lTest.f_int4 := lTest.f_int4.Value + 4; lTest.f_int8 := lTest.f_int8.Value + 8; lTest.f_blob.Free; lTest.f_blob := nil; lTest.Update; finally lTest.Free; end; lTest := TMVCActiveRecord.GetFirstByWhere('f_int2 = ?', [4]); try Assert.IsTrue(lTest.f_int2.ValueOrDefault = 4); Assert.IsTrue(lTest.f_int4.ValueOrDefault = 8); Assert.IsTrue(lTest.f_int8.ValueOrDefault = 16); Assert.IsFalse(lTest.f_string.HasValue); Assert.IsFalse(lTest.f_bool.HasValue); Assert.IsFalse(lTest.f_date.HasValue); Assert.IsFalse(lTest.f_time.HasValue); Assert.IsFalse(lTest.f_datetime.HasValue); Assert.IsFalse(lTest.f_float4.HasValue); Assert.IsFalse(lTest.f_float8.HasValue); Assert.IsFalse(lTest.f_bool.HasValue); Assert.IsFalse(Assigned(lTest.f_blob), 'Blob contains a value when should not'); TMVCActiveRecord.DeleteRQL(TNullablesTest, 'eq(f_int2,4)'); finally lTest.Free; end; Assert.IsNull(TMVCActiveRecord.GetFirstByWhere('f_int2 = 4', [], false)); lTest := TNullablesTest.Create; try lTest.f_int2 := 2; lTest.f_int4 := 4; lTest.f_int8 := 8; lTest.f_string := 'Hello World'; lTest.f_bool := True; lTest.f_date := EncodeDate(2020, 02, 01); lTest.f_time := EncodeTime(12, 24, 36, 0); lTest.f_datetime := Now; lTest.f_float4 := 1234.5678; lTest.f_float8 := 12345678901234567890.0123456789; // lTest.f_currency := 1234567890.1234; lTest.Insert; finally lTest.Free; end; end; procedure TTestActiveRecordBase.TestRQL; var lCustomers: TObjectList; const RQL1 = 'or(eq(City, "Rome"),eq(City, "London"))'; begin Assert.AreEqual(Int64(0), TMVCActiveRecord.Count(TCustomer)); LoadData; lCustomers := TMVCActiveRecord.SelectRQL(RQL1, MAXINT); try Assert.AreEqual(240, lCustomers.Count); for var lCustomer in lCustomers do begin Assert.IsMatch('^(Rome|London)$', lCustomer.City); end; finally lCustomers.Free; end; TMVCActiveRecord.DeleteRQL(TCustomer, RQL1); Assert.AreEqual(Int64(0), TMVCActiveRecord.Count(RQL1)); end; procedure TTestActiveRecordBase.TestRQLLimit; var lCustomers: TObjectList; const RQL1 = 'or(eq(City, "Rome"),eq(City, "London"))'; begin Assert.AreEqual(Int64(0), TMVCActiveRecord.Count(TCustomer)); LoadData; lCustomers := TMVCActiveRecord.SelectRQL(RQL1, MAXINT); try Assert.AreEqual(240, lCustomers.Count); for var lCustomer in lCustomers do begin Assert.IsMatch('^(Rome|London)$', lCustomer.City); end; finally lCustomers.Free; end; lCustomers := TMVCActiveRecord.SelectRQL(RQL1, 10); try Assert.AreEqual(10, lCustomers.Count); finally lCustomers.Free; end; lCustomers := TMVCActiveRecord.SelectRQL(RQL1, 0); try Assert.AreEqual(0, lCustomers.Count); finally lCustomers.Free; end; TMVCActiveRecord.DeleteRQL(TCustomer, RQL1); Assert.AreEqual(Int64(0), TMVCActiveRecord.Count(RQL1)); end; procedure TTestActiveRecordBase.TestRQLWithDateTime; var lCustomers: TObjectList; const RQL1 = 'and(and(gt(CreationDate, "2010-10-01"),le(CreationDate, "2022-12-31")),' + 'and(gt(CreationTime, "00:00:00"),le(CreationTime, "08:00:00")))'; begin TMVCActiveRecord.DeleteAll(TCustomer); Assert.AreEqual(Int64(0), TMVCActiveRecord.Count(TCustomer)); LoadData; lCustomers := TMVCActiveRecord.SelectRQL(RQL1, MAXINT); try Assert.AreEqual(140, lCustomers.Count); finally lCustomers.Free; end; TMVCActiveRecord.DeleteRQL(TCustomer, RQL1); Assert.AreEqual(Int64(0), TMVCActiveRecord.Count(RQL1)); end; procedure TTestActiveRecordBase.TestSelectWithExceptions; var lCustomer: TCustomer; lID: Integer; begin lID := 1000; lCustomer := TMVCActiveRecord.GetByPK(lID, false); try if Assigned(lCustomer) then begin lCustomer.Delete; end; finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID, false); Assert.IsNull(lCustomer); lCustomer := TMVCActiveRecord.GetOneByWhere('id = ?', [lID], [ftInteger], false); Assert.IsNull(lCustomer); Assert.WillRaise( procedure begin TMVCActiveRecord.GetByPK(lID, True); end, EMVCActiveRecordNotFound); Assert.WillRaise( procedure begin TMVCActiveRecord.GetOneByWhere('id = ?', [lID], [ftInteger], True); end, EMVCActiveRecordNotFound); Assert.WillRaise( procedure begin TMVCActiveRecord.GetOneByWhere('id = ?', [lID], True); end, EMVCActiveRecordNotFound); Assert.WillRaise( procedure begin TMVCActiveRecord.GetFirstByWhere('id = ?', [lID], [ftInteger], True); end, EMVCActiveRecordNotFound); Assert.WillRaise( procedure begin TMVCActiveRecord.GetFirstByWhere('id = ?', [lID], True); end, EMVCActiveRecordNotFound); end; procedure TTestActiveRecordBase.TestStore; var lCustomer: TCustomerWithNullablePK; lID: Integer; begin Assert.AreEqual(Int64(0), TMVCActiveRecord.Count()); lCustomer := TCustomerWithNullablePK.Create; try lCustomer.CompanyName := 'bit Time Professionals'; lCustomer.City := 'Rome, IT'; lCustomer.Note := 'note1'; lCustomer.Store; { pk is not set, so it should do an insert } lID := lCustomer.ID; Assert.AreEqual(1, lID, 'ID should be 1 but it is ' + lID.ToString); finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID); try Assert.IsFalse(lCustomer.Code.HasValue); Assert.IsFalse(lCustomer.Rating.HasValue); lCustomer.Code := '1234'; lCustomer.Rating := 3; lCustomer.Note := lCustomer.Note + 'noteupdated'; lCustomer.Store; { pk is set, so it should do an update } Assert.AreEqual(1, lCustomer.ID.Value); finally lCustomer.Free; end; end; procedure TTestActiveRecordBase.TestUpdateIfNotFound; var lCustomer: TCustomer; lID: Integer; begin lCustomer := TCustomer.Create; try lCustomer.CompanyName := 'bit Time Professionals'; lCustomer.City := 'Rome, IT'; lCustomer.Note := 'note1'; lCustomer.CreationTime := Time; lCustomer.CreationDate := Date; lCustomer.ID := -1; { don't be fooled by the default! } lCustomer.Insert; lID := lCustomer.ID; finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID); try lCustomer.Update; lCustomer.Delete; Assert.WillNotRaise( procedure begin lCustomer.Update(False); end, EMVCActiveRecordNotFound); Assert.WillRaise( procedure begin lCustomer.Update(True); end, EMVCActiveRecordNotFound); finally lCustomer.Free; end; end; procedure TTestActiveRecordBase.Test_ISSUE485; var lCustomer: TCustomer; lID: Integer; begin Assert.AreEqual(Int64(0), TMVCActiveRecord.Count()); lCustomer := TCustomer.Create; try lCustomer.CompanyName := 'bit Time Professionals'; lCustomer.City := 'Rome, IT'; lCustomer.Note := 'note1'; lCustomer.CreationTime := Time; lCustomer.CreationDate := Date; lCustomer.ID := -1; { don't be fooled by the default! } lCustomer.Insert; lID := lCustomer.ID; Assert.AreEqual(1, lID); finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID); try Assert.IsTrue(lCustomer.CompanyName.HasValue); lCustomer.CompanyName.Clear; lCustomer.Update; finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID); try Assert.IsFalse(lCustomer.CompanyName.HasValue); lCustomer.CompanyName := 'bit Time Professionals'; lCustomer.Update; finally lCustomer.Free; end; lCustomer := TMVCActiveRecord.GetByPK(lID); try Assert.IsTrue(lCustomer.CompanyName.HasValue); finally lCustomer.Free; end; end; procedure TTestActiveRecordBase.InternalSetupFixture; begin // do nothing end; procedure TTestActiveRecordBase.LoadData(const JustAFew: Boolean); var lTasks: TArray; lProc: TProc; const Cities: array [0 .. 4] of string = ('Rome', 'New York', 'London', 'Melbourne', 'Berlin'); CompanySuffix: array [0 .. 5] of string = ('Corp.', 'Inc.', 'Ltd.', 'Srl', 'SPA', 'doo'); Stuff: array [0 .. 4] of string = ('Burger', 'GAS', 'Motors', 'House', 'Boats'); begin TMVCActiveRecord.DeleteRQL(TCustomer, 'in(City,["Rome","New York","London","Melbourne","Berlin"])'); lProc := procedure var lCustomer: TCustomer; I: Integer; begin //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 lCustomer := TCustomer.Create; try lCustomer.Code := Format('%5.5d', [TThread.CurrentThread.ThreadID, I]); lCustomer.City := Cities[I mod Length(Cities)]; lCustomer.CompanyName := 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; finally lCustomer.Free; end; end; finally ActiveRecordConnectionsRegistry.RemoveConnection('load'); end; end; AfterDataLoad; 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; if FDManager.ConnectionDefs.FindConnectionDef(fConDefName) = nil then begin CreatePrivateConnDef(True); if TFile.Exists(SQLiteFileName) then begin TFile.Delete(SQLiteFileName); end; fConnection.Open; for var lSQL in SQLs_SQLITE do begin fConnection.ExecSQL(lSQL); end; end else begin fConnection.Open; end; ActiveRecordConnectionsRegistry.AddDefaultConnection(fConnection); TMVCActiveRecord.DeleteAll(TCustomer); ActiveRecordConnectionsRegistry.GetCurrent.ExecSQL('delete from customers2'); AfterDataLoad; end; procedure TTestActiveRecordBase.Teardown; begin ActiveRecordConnectionsRegistry.RemoveDefaultConnection(); fConnection.Close; FreeAndNil(fConnection); end; { TTestActiveRecordFirebird } procedure TTestActiveRecordFirebird.AfterDataLoad; begin TMVCActiveRecord.CurrentConnection.ExecSQL('alter table customers alter column id restart'); TMVCActiveRecord.CurrentConnection.ExecSQL('alter table customers2 alter column id restart'); end; procedure TTestActiveRecordFirebird.CreatePrivateConnDef(AIsPooled: boolean); var LParams: TStringList; lDriver: IFDStanDefinition; begin lDriver := FDManager.DriverDefs.Add; lDriver.Name := 'FBEMBEDDED'; lDriver.AsString['BaseDriverID'] := 'FB'; lDriver.AsString['DriverID'] := 'FBEMBEDDED'; lDriver.AsString['VendorLib'] := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), 'firebird\fbclient.dll'); lDriver.Apply; LParams := TStringList.Create; try GDBFileName := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), 'firebirdtest.fdb'); GDBTemplateFileName := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), 'firebirdtest_template.fdb'); LParams.Add('Database=' + GDBFileName); LParams.Add('user_name=sysdba'); LParams.Add('password=masterkey'); if AIsPooled then begin LParams.Add('Pooled=True'); LParams.Add('POOL_MaximumItems=100'); end else begin LParams.Add('Pooled=False'); end; FDManager.AddConnectionDef(fConDefName, 'FBEMBEDDED', LParams); finally LParams.Free; end; end; procedure TTestActiveRecordFirebird.Setup; begin LogI('** Setup Test: ' + ClassName); fConDefName := _CON_DEF_NAME_FIREBIRD; fConnection := TFDConnection.Create(nil); fConnection.ConnectionDefName := fConDefName; if FDManager.ConnectionDefs.FindConnectionDef(fConDefName) = nil then begin CreatePrivateConnDef(True); if TFile.Exists(GDBFileName) then begin TFile.Delete(GDBFileName); end; TFile.Copy(GDBTemplateFileName, GDBFileName); fConnection.Open; for var lSQL in SQLs_FIREBIRD do begin fConnection.ExecSQL(lSQL); end; end else begin fConnection.Open; end; fConnection.Close; fConnection.Open; ActiveRecordConnectionsRegistry.AddDefaultConnection(fConnection); TMVCActiveRecord.DeleteAll(TCustomer); TMVCActiveRecord.CurrentConnection.ExecSQL('delete from customers2'); AfterDataLoad; end; { TTestActiveRecordPostgreSQL } procedure TTestActiveRecordPostgreSQL.AfterDataLoad; begin TMVCActiveRecord.CurrentConnection.ExecSQL('alter table customers alter column id restart'); TMVCActiveRecord.CurrentConnection.ExecSQL('alter table customers2 alter column id restart'); end; constructor TTestActiveRecordPostgreSQL.Create; var lPGHome, lDataDir: String; begin inherited; lPGHome := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), 'pgsql'); lDataDir := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), 'pgsql\testdatadir'); fPGUtil := TPGUtil.Create(lPGHome, lDataDir, PG_PORT); end; procedure TTestActiveRecordPostgreSQL.CreatePrivateConnDef(AIsPooled: boolean); var LParams: TStringList; lDriver: IFDStanDefinition; begin lDriver := FDManager.DriverDefs.Add; lDriver.Name := 'PG'; // lDriver.AsString['BaseDriverID'] := 'PG'; lDriver.AsString['DriverID'] := 'PG'; lDriver.AsString['VendorLib'] := TPath.Combine(fPGUtil.PGHome, 'libpq.dll'); lDriver.Apply; LParams := TStringList.Create; try LParams.Add('Database=activerecordtest'); LParams.Add('Port=' + PG_PORT.ToString); // LParams.Add('user_name=sysdba'); // LParams.Add('password=masterkey'); if AIsPooled then begin LParams.Add('Pooled=True'); LParams.Add('POOL_MaximumItems=100'); end else begin LParams.Add('Pooled=False'); end; FDManager.AddConnectionDef(fConDefName, 'PG', LParams); finally LParams.Free; end; end; destructor TTestActiveRecordPostgreSQL.Destroy; begin try fPGUtil.StopPG; except // do nothing end; fPGUtil.Free; inherited; end; procedure TTestActiveRecordPostgreSQL.InternalSetupFixture; begin fPGUtil.RemoveDataDir; fPGUtil.InitDB; fPGUtil.StartPG; fPGUtil.CreateDatabase('activerecordtest'); end; procedure TTestActiveRecordPostgreSQL.Setup; var lInitDBStructure: boolean; begin LogI('** Setup Test: ' + ClassName); lInitDBStructure := false; if not GPGIsInitialized then begin FDManager.CloseConnectionDef(_CON_DEF_NAME_POSTGRESQL); fPGUtil.StopPG; fPGUtil.RemoveDataDir; lInitDBStructure := True; InternalSetupFixture; GPGIsInitialized := True; end; fConDefName := _CON_DEF_NAME_POSTGRESQL; if FDManager.ConnectionDefs.FindConnectionDef(fConDefName) = nil then begin CreatePrivateConnDef(True); end; fConnection := TFDConnection.Create(nil); fConnection.ConnectionDefName := fConDefName; fConnection.Open; if lInitDBStructure then begin for var lSQL in SQLs_POSTGRESQL do begin fConnection.ExecSQL(lSQL); end; end; fConnection.Close; fConnection.Open; ActiveRecordConnectionsRegistry.AddDefaultConnection(fConnection); TMVCActiveRecord.DeleteAll(TCustomer); TMVCActiveRecord.CurrentConnection.ExecSQL('delete from customers2'); AfterDataLoad; end; procedure TTestActiveRecordPostgreSQL.TearDownFixture; begin FDManager.CloseConnectionDef(_CON_DEF_NAME_POSTGRESQL); fPGUtil.StopPG; GPGIsInitialized := false; end; initialization TDUnitX.RegisterTestFixture(TTestActiveRecordSQLite); TDUnitX.RegisterTestFixture(TTestActiveRecordFirebird); TDUnitX.RegisterTestFixture(TTestActiveRecordPostgreSQL); finalization end.