Created
May 28, 2023 06:45
-
-
Save martin-doyle/6cb7726b3926e986df3cfea26990e46e to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
program CollectionTest; | |
{$APPTYPE CONSOLE} | |
{$I mormot.defines.inc} | |
uses | |
mormot.core.log, | |
mormot.db.raw.sqlite3, | |
mormot.db.raw.sqlite3.static, | |
data in 'data.pas', | |
CollectionTests in 'CollectionTests.pas'; | |
var | |
TestSuite: TTestSuite; | |
LogFamily: TSynLogFamily; | |
begin | |
LogFamily := SQLite3Log.Family; | |
LogFamily.Level := LOG_VERBOSE; | |
LogFamily.PerThreadLog := ptIdentifiedInOneFile; | |
TestSuite := TTestSuite.Create; | |
try | |
TestSuite.Run; | |
readln; | |
finally | |
TestSuite.Free; | |
end; | |
end. |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
unit CollectionTests; | |
interface | |
uses | |
SysUtils, | |
mormot.core.base, | |
mormot.core.test, | |
mormot.orm.core, | |
mormot.rest.sqlite3, | |
data; | |
type | |
{ TTestData } | |
TTestData = class(TSynTestCase) | |
private | |
FModel: TOrmModel; | |
protected | |
procedure Setup; override; | |
procedure CleanUp; override; | |
published | |
procedure TestCreateDatabase; | |
procedure TestCreateOrmWithCollection; | |
procedure TestCreateAndFillPrepare; | |
procedure TestFillPrepare; | |
procedure TestCreate; | |
procedure TestRetreive; | |
end; | |
TTestSuite = class(TSynTestsLogged) | |
published | |
procedure TestSuite; | |
end; | |
implementation | |
{ | |
********************************** TTestData *********************************** | |
} | |
procedure TTestData.Setup; | |
begin | |
FModel := CreateModel; | |
end; | |
procedure TTestData.CleanUp; | |
begin | |
if (FModel <> nil) then | |
FreeAndNil(FModel); | |
end; | |
procedure TTestData.TestCreateDatabase; | |
var | |
TestClient: TRestClientDB; | |
begin | |
if FileExists(DataFile) then | |
Check(DeleteFile(DataFile)); | |
TestClient := TRestClientDB.Create(FModel, nil, DataFile, TRestServerDB, false, ''); | |
try | |
TestClient.Server.Server.CreateMissingTables(); | |
finally | |
TestClient.Free; | |
end; | |
end; | |
procedure TTestData.TestCreateOrmWithCollection; | |
var | |
Order: TOrmOrderBook; | |
Item: TItem; | |
TestClient: TRestClientDB; | |
TestInteger: Integer; | |
begin | |
TestClient := TRestClientDB.Create(FModel, nil, DataFile, TRestServerDB, false, ''); | |
try | |
Order := TOrmOrderBook.Create; | |
try | |
Order.OrderNo := 'Order1'; | |
Item := TItem.Create(Order.Items); | |
Item.PartNo := 'Item 1'; | |
Item.Description := 'Item 1 Description'; | |
Item := TItem.Create(Order.Items); | |
Item.PartNo := 'Item 2'; | |
Item.Description := 'Item 2 Description'; | |
TestInteger := TestClient.Client.Add(Order, True); | |
Check(TestInteger = 1, 'Order Add'); | |
finally | |
Order.Free; | |
end; | |
finally | |
TestClient.Free; | |
end; | |
end; | |
procedure TTestData.TestCreateAndFillPrepare; | |
var | |
Order: TOrmOrderBook; | |
TestClient: TRestClientDB; | |
TestInteger: Integer; | |
TestBoolean: Boolean; | |
begin | |
TestClient := TRestClientDB.Create(FModel, nil, DataFile, TRestServerDB, false, ''); | |
try | |
Order := TOrmOrderBook.CreateAndFillPrepare(TestClient.Orm, '', []); | |
try | |
TestInteger := Order.FillTable.RowCount; | |
Check(TestInteger = 1, 'Row Count'); | |
Order.FillOne(); | |
Check(Order.Items <> nil, 'Items <> nil'); | |
if (Order.Items <> nil) then | |
begin | |
TestInteger := Order.Items.Count; | |
Check(TestInteger = 2, 'Items Count'); | |
end; | |
finally | |
Order.Free; | |
end; | |
finally | |
TestClient.Free; | |
end; | |
end; | |
procedure TTestData.TestFillPrepare; | |
var | |
Order: TOrmOrderBook; | |
TestClient: TRestClientDB; | |
TestInteger: Integer; | |
TestBoolean: Boolean; | |
begin | |
TestClient := TRestClientDB.Create(FModel, nil, DataFile, TRestServerDB, false, ''); | |
try | |
Order := TOrmOrderBook.Create; | |
try | |
TestBoolean := Order.FillPrepare(TestClient.Orm, '', []); | |
Check(TestBoolean); | |
TestInteger := Order.FillTable.RowCount; | |
Check(TestInteger = 1, 'Row Count'); | |
Order.FillOne(); | |
Check(Order.Items <> nil, 'Items <> nil'); | |
if (Order.Items <> nil) then | |
begin | |
TestInteger := Order.Items.Count; | |
Check(TestInteger = 2, 'Items Count'); | |
end; | |
finally | |
Order.Free; | |
end; | |
finally | |
TestClient.Free; | |
end; | |
end; | |
procedure TTestData.TestCreate; | |
var | |
Order: TOrmOrderBook; | |
TestClient: TRestClientDB; | |
TestInteger: Integer; | |
TestBoolean: Boolean; | |
begin | |
TestClient := TRestClientDB.Create(FModel, nil, DataFile, TRestServerDB, false, ''); | |
try | |
Order := TOrmOrderBook.Create(TestClient.Orm, 'OrderNo = ?', ['Order1']); | |
try | |
Check(Order.Items <> nil, 'Items <> nil'); | |
if (Order.Items <> nil) then | |
begin | |
TestInteger := Order.Items.Count; | |
Check(TestInteger = 2, 'Items Count'); | |
end; | |
finally | |
Order.Free; | |
end; | |
finally | |
TestClient.Free; | |
end; | |
end; | |
procedure TTestData.TestRetreive; | |
var | |
Order: TOrmOrderBook; | |
TestClient: TRestClientDB; | |
TestInteger: Integer; | |
TestBoolean: Boolean; | |
begin | |
TestClient := TRestClientDB.Create(FModel, nil, DataFile, TRestServerDB, false, ''); | |
try | |
Order := TOrmOrderBook.Create; | |
try | |
TestClient.Orm.Retrieve('OrderNo = ?', [], ['Order1'], Order); | |
Check(Order.Items <> nil, 'Items <> nil'); | |
if (Order.Items <> nil) then | |
begin | |
TestInteger := Order.Items.Count; | |
Check(TestInteger = 2, 'Items Count'); | |
end; | |
finally | |
Order.Free; | |
end; | |
finally | |
TestClient.Free; | |
end; | |
end; | |
{ | |
********************************** TTestSuite ********************************** | |
} | |
procedure TTestSuite.TestSuite; | |
begin | |
AddCase([TTestData]); | |
end; | |
end. |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
unit Data; | |
interface | |
{$I mormot.defines.inc} | |
uses | |
SysUtils, Classes, | |
mormot.core.base, mormot.core.data, mormot.core.json, mormot.core.os, mormot.core.rtti, | |
mormot.db.core, | |
mormot.orm.base, | |
mormot.orm.core; | |
const | |
DataFile = '..\data\data.db3'; | |
type | |
TItem = class(TCollectionItem) | |
private | |
FPartNo: RawUTF8; | |
FDescription: RawUTF8; | |
published | |
property PartNo: RawUTF8 read FPartNo write FPartNo; | |
property Description: RawUTF8 read FDescription write FDescription; | |
end; | |
TItemCollection = class(TCollection) | |
protected | |
function GetItem(Index: Integer): TItem; | |
procedure SetItem(Index: Integer; Value: TItem); | |
public | |
property Items[Index: Integer]: TItem read GetItem write SetItem; default; | |
end; | |
TOrmOrderBook = class(TOrm) | |
private | |
FOrderNo: RawUTF8; | |
FItems: TItemCollection; | |
public | |
constructor Create; overload; override; | |
destructor Destroy; override; | |
published | |
property OrderNo: RawUTF8 read FOrderNo write FOrderNo stored AS_UNIQUE; | |
property Items: TItemCollection read FItems write FItems; | |
end; | |
function CreateModel: TOrmModel; | |
implementation | |
function CreateModel: TOrmModel; | |
begin | |
Result := TOrmModel.Create([TOrmOrderBook]); | |
end; | |
{ | |
******************************* TItemCollection ******************************** | |
} | |
function TItemCollection.GetItem(Index: Integer): TItem; | |
begin | |
Result := TItem(inherited GetItem(Index)); | |
end; | |
procedure TItemCollection.SetItem(Index: Integer; Value: TItem); | |
begin | |
inherited SetItem(Index, Value); | |
end; | |
{ | |
******************************** TOrmOrderBook ********************************* | |
} | |
constructor TOrmOrderBook.Create; | |
begin | |
inherited Create; | |
FItems := TItemCollection.Create(TItem); | |
end; | |
destructor TOrmOrderBook.Destroy; | |
begin | |
if (FItems <> nil) then | |
FreeAndNil(FItems); | |
inherited Destroy; | |
end; | |
initialization | |
Rtti.RegisterCollection(TItemCollection, TItem); | |
end. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment