Menu
▾
▴
[Instantobjects-cvscommit] Source/Tests TestIO.mdr,NONE,1.1 TestInstantAttributeMetadata.pas,NONE,1.1 TestInstantClassMetadata.pas,NONE,1.1 TestInstantFieldMetadata.pas,NONE,1.1 TestInstantIndexMetadata.pas,NONE,1.1 TestInstantMetadata.pas,NONE,1.1 TestInstantScheme.pas,NONE,1.1 TestInstantTableMetadata.pas,NONE,1.1 TestModel.pas,NONE,1.1 TestIO.cfg,1.1,1.2 TestIO.dof,1.1,1.2 TestIO.dpr,1.3,1.4 TestIO.res,1.1,1.2 TestInstantClasses.pas,1.1,1.2 TestInstantRtti.pas,1.1,1.2 TestMinimalModel.pas,1.1,1.2 TestMockBroker.pas,1.6,1.7 TestMockConnector.pas,1.4,1.5 Model.pas,1.2,NONE
Update of /cvsroot/instantobjects/Source/Tests In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15430/Source/Tests Modified Files: TestIO.cfg TestIO.dof TestIO.dpr TestIO.res TestInstantClasses.pas TestInstantRtti.pas TestMinimalModel.pas TestMockBroker.pas TestMockConnector.pas Added Files: TestIO.mdr TestInstantAttributeMetadata.pas TestInstantClassMetadata.pas TestInstantFieldMetadata.pas TestInstantIndexMetadata.pas TestInstantMetadata.pas TestInstantScheme.pas TestInstantTableMetadata.pas TestModel.pas Removed Files: Model.pas Log Message: Addition/revision of Tests Index: TestMockBroker.pas =================================================================== RCS file: /cvsroot/instantobjects/Source/Tests/TestMockBroker.pas,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** TestMockBroker.pas 2 May 2005 23:26:33 -0000 1.6 --- TestMockBroker.pas 3 May 2005 04:52:37 -0000 1.7 *************** *** 5,21 **** uses Classes, SysUtils, InstantPersistence, fpcunit, testregistry, InstantMock, ! Model; type TTestMockBroker = class(TTestCase) private protected FConn: TInstantMockConnector; procedure SetUp; override; procedure TearDown; override; published ! procedure TestModelMdx; procedure TestGetBroker; procedure TestBuildDatabase; procedure TestStoreAndRetrieveAddress; end; --- 5,24 ---- uses Classes, SysUtils, InstantPersistence, fpcunit, testregistry, InstantMock, ! TestModel; type TTestMockBroker = class(TTestCase) private + FClassCount: Integer; protected FConn: TInstantMockConnector; procedure SetUp; override; procedure TearDown; override; + public published ! procedure TestModelFromToFile; procedure TestGetBroker; procedure TestBuildDatabase; + procedure TestModelFromToResFile; procedure TestStoreAndRetrieveAddress; end; *************** *** 23,26 **** --- 26,30 ---- TTestMockRelationalBroker = class(TTestCase) private + FClassCount: Integer; protected FConn: TInstantMockConnector; *************** *** 35,44 **** implementation ! { TTestMockBroker } ! procedure TTestMockBroker.TestModelMdx; begin ! InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx')); AssertNotNull(InstantModel.ClassMetadatas.Find('TContact')); end; --- 39,91 ---- implementation ! procedure TTestMockBroker.TestModelFromToFile; ! var ! vReturnValue: TInstantClassMetadata; ! begin ! if FClassCount > 0 then ! begin ! // This ensures that the exported file is synchronised ! // with the current model resource file. ! InstantModel.SaveToFile(ChangeFileExt(ParamStr(0), '.mdx')); ! InstantModel.ClassMetadatas.Clear; ! end; ! InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0), '.mdx')); ! vReturnValue := InstantModel.ClassMetadatas.Find('TCategory'); ! AssertNotNull(vReturnValue); ! if FClassCount = 0 then ! FClassCount := InstantModel.ClassMetadatas.Count; ! ! InstantModel.ClassMetadatas.Remove(vReturnValue); ! AssertNull('TCategory was found!', ! InstantModel.ClassMetadatas.Find('TCategory')); ! InstantModel.SaveToFile(ChangeFileExt(ParamStr(0), '.mdxt')); ! ! InstantModel.ClassMetadatas.Clear; ! InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0), '.mdxt')); ! AssertNotNull(InstantModel.ClassMetadatas.Find('TContact')); ! AssertNull(InstantModel.ClassMetadatas.Find('TCategory')); ! end; ! ! procedure TTestMockBroker.TestModelFromToResFile; ! var ! vReturnValue: TInstantClassMetadata; begin ! if FClassCount > 0 then ! InstantModel.ClassMetadatas.Clear; ! ! InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr')); ! vReturnValue := InstantModel.ClassMetadatas.Find('TCategory'); ! AssertNotNull(vReturnValue); ! ! InstantModel.ClassMetadatas.Remove(vReturnValue); ! AssertNull(InstantModel.ClassMetadatas.Find('TCategory')); ! ! InstantModel.SaveToResFile(ChangeFileExt(ParamStr(0), '.mdrt')); ! InstantModel.ClassMetadatas.Clear; ! ! InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdrt')); AssertNotNull(InstantModel.ClassMetadatas.Find('TContact')); + AssertNull(InstantModel.ClassMetadatas.Find('TCategory')); end; *************** *** 60,65 **** brok: TInstantMockBroker; begin - InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx')); - brok := Fconn.Broker as TInstantMockBroker; brok.MockManager.StartSetUp; --- 107,110 ---- *************** *** 75,79 **** brok: TInstantMockBroker; begin ! InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx')); Fconn.IsDefault := True; --- 120,124 ---- brok: TInstantMockBroker; begin ! AssertTrue(FClassCount > 0); Fconn.IsDefault := True; *************** *** 111,114 **** --- 156,164 ---- FConn := TInstantMockConnector.Create(nil); FConn.BrokerClass := TInstantMockBroker; + + if FClassCount > 0 then + InstantModel.ClassMetadatas.Clear; + InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr')); + FClassCount := InstantModel.ClassMetadatas.Count; end; *************** *** 126,129 **** --- 176,184 ---- FConn := TInstantMockConnector.Create(nil); FConn.BrokerClass := TInstantMockCRBroker; + + if FClassCount > 0 then + InstantModel.ClassMetadatas.Clear; + InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr')); + FClassCount := InstantModel.ClassMetadatas.Count; end; *************** *** 152,156 **** t: TPhone; begin ! InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx')); Fconn.IsDefault := True; c := TContact.Create; --- 207,212 ---- t: TPhone; begin ! AssertTrue(FClassCount > 0); ! Fconn.IsDefault := True; c := TContact.Create; *************** *** 175,184 **** t: TPhone; begin ! InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx')); Fconn.IsDefault := True; brok := Fconn.Broker as TInstantMockCRBroker; brok.MockManager.StartSetUp; - c := TContact.Create; try --- 231,239 ---- t: TPhone; begin ! AssertTrue(FClassCount > 0); Fconn.IsDefault := True; brok := Fconn.Broker as TInstantMockCRBroker; brok.MockManager.StartSetUp; c := TContact.Create; try *************** *** 190,194 **** c.AddPhone(t); AssertEquals(1, c.PhoneCount); - t := TPhone.Create; t.Name := 'Office'; --- 245,248 ---- *************** *** 220,224 **** initialization RegisterTests([TTestMockBroker, TTestMockRelationalBroker]); ! ! end. --- 274,279 ---- initialization + {$IFNDEF CURR_TESTS} RegisterTests([TTestMockBroker, TTestMockRelationalBroker]); ! {$ENDIF} ! end. \ No newline at end of file Index: TestIO.res =================================================================== RCS file: /cvsroot/instantobjects/Source/Tests/TestIO.res,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvs0AJSMF and /tmp/cvsbmi4wp differ --- NEW FILE: TestInstantIndexMetadata.pas --- unit TestInstantIndexMetadata; interface uses fpcunit, InstantPersistence; type // Test methods for class TInstantIndexMetadata TestTInstantIndexMetadata = class(TTestCase) private FCollection: TInstantIndexMetadatas; FInstantIndexMetadata: TInstantIndexMetadata; FOwner: TInstantTableMetadata; public procedure SetUp; override; procedure TearDown; override; published procedure TestCollection; procedure TestFields; procedure TestOptions; procedure TestTableMetadata; end; // Test methods for class TInstantIndexMetadatas TestTInstantIndexMetadatas = class(TTestCase) private FInstantIndexMetadatas: TInstantIndexMetadatas; FOwner: TInstantTableMetadata; public procedure SetUp; override; procedure TearDown; override; published procedure TestAddIndexMetadata; procedure TestAdd; procedure TestOwner; end; implementation uses SysUtils, Db, testregistry; procedure TestTInstantIndexMetadata.SetUp; begin FOwner := TInstantTableMetadata.Create(nil); FCollection := TInstantIndexMetadatas.Create(FOwner); FInstantIndexMetadata := TInstantIndexMetadata.Create(FCollection); FInstantIndexMetadata.Fields := 'IndexFields'; FInstantIndexMetadata.Options := [ixPrimary, ixUnique]; end; procedure TestTInstantIndexMetadata.TearDown; begin FInstantIndexMetadata.Free; FInstantIndexMetadata := nil; FreeAndNil(FCollection); FreeAndNil(FOwner); end; procedure TestTInstantIndexMetadata.TestCollection; begin AssertNotNull('Collection is nil!', FInstantIndexMetadata.Collection); AssertSame('Collection is incorrect!', FCollection, FInstantIndexMetadata.Collection); end; procedure TestTInstantIndexMetadata.TestFields; begin AssertEquals('Fields value is incorrect!', 'IndexFields', FInstantIndexMetadata.Fields); end; procedure TestTInstantIndexMetadata.TestOptions; begin AssertTrue('Options value is incorrect!', [ixPrimary, ixUnique] = FInstantIndexMetadata.Options); end; procedure TestTInstantIndexMetadata.TestTableMetadata; begin AssertNotNull('TableMetadata is nil!', FInstantIndexMetadata.TableMetadata); AssertSame('TableMetadata is incorrect!', FOwner, FInstantIndexMetadata.TableMetadata); end; procedure TestTInstantIndexMetadatas.SetUp; begin FOwner := TInstantTableMetadata.Create(nil); FInstantIndexMetadatas := TInstantIndexMetadatas.Create(FOwner); end; procedure TestTInstantIndexMetadatas.TearDown; begin FInstantIndexMetadatas.Free; FInstantIndexMetadatas := nil; FreeAndNil(FOwner); end; procedure TestTInstantIndexMetadatas.TestAdd; var vReturnValue: TInstantIndexMetadata; begin vReturnValue := FInstantIndexMetadatas.Add; AssertNotNull('vReturnValue is nil!', vReturnValue); AssertEquals('Count is incorrect!', 1, FInstantIndexMetadatas.Count); AssertNotNull('Items[0] is nil!', FInstantIndexMetadatas.Items[0]); FInstantIndexMetadatas.Remove(vReturnValue); AssertEquals('Count is incorrect!', 0, FInstantIndexMetadatas.Count); end; procedure TestTInstantIndexMetadatas.TestAddIndexMetadata; var vOptions: TIndexOptions; vFields: string; vName: string; vReturnValue: TInstantIndexMetadata; begin vName := 'PrimaryID'; vFields := 'IndexFields'; vOptions := [ixPrimary, ixUnique]; FInstantIndexMetadatas.AddIndexMetadata(vName, vFields, vOptions); vReturnValue := TInstantIndexMetadata(FInstantIndexMetadatas.Find(vName)); AssertNotNull('IndexMetadata not found!', vReturnValue); AssertEquals('Fields value is incorrect!', vFields, vReturnValue.Fields); AssertTrue('Options value is incorrect!', vOptions = vReturnValue.Options); end; procedure TestTInstantIndexMetadatas.TestOwner; var vReturnValue: TInstantTableMetadata; begin vReturnValue := FInstantIndexMetadatas.Owner; AssertNotNull('Owner is nil!', vReturnValue); AssertSame('Owner value is incorrect!', FOwner, vReturnValue); end; initialization // Register any test cases with the test runner {$IFNDEF CURR_TESTS} RegisterTests([TestTInstantIndexMetadata, TestTInstantIndexMetadatas]); {$ENDIF} end. Index: TestInstantClasses.pas =================================================================== RCS file: /cvsroot/instantobjects/Source/Tests/TestInstantClasses.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** TestInstantClasses.pas 2 May 2005 23:26:34 -0000 1.1 --- TestInstantClasses.pas 3 May 2005 04:52:37 -0000 1.2 *************** *** 317,321 **** c.ConvertToText(ic); ic.Producer.eof; //to flush the buffer ! AssertEquals('ConvertToText', '<Age>2</Age><Weight>1,123</Weight><PigName>Miss piggy</PigName>', outs.DataString); //butta via l'output e riprova col sistema completo --- 317,322 ---- c.ConvertToText(ic); ic.Producer.eof; //to flush the buffer ! AssertEquals('ConvertToText', '<Age>2</Age><Weight>1' + DecimalSeparator + ! '123</Weight><PigName>Miss piggy</PigName>', outs.DataString); //butta via l'output e riprova col sistema completo *************** *** 324,328 **** s2 := ''; InstantObjectBinaryToText(ins, outs); ! AssertEquals('InstantObjectBinaryToText', '<TInstantGuineaPig><Age>2</Age><Weight>1,123</Weight><PigName>Miss piggy</PigName></TInstantGuineaPig>', outs.DataString); finally ic.Free; --- 325,332 ---- s2 := ''; InstantObjectBinaryToText(ins, outs); ! AssertEquals('InstantObjectBinaryToText', ! '<TInstantGuineaPig><Age>2</Age><Weight>1' + DecimalSeparator + ! '123</Weight><PigName>Miss piggy</PigName></TInstantGuineaPig>', ! outs.DataString); finally ic.Free; *************** *** 346,350 **** InstantWriteObject(ms, sfXML, c); AssertEquals(102, ms.Position); ! AssertEquals('<TInstantGuineaPig><Age>2</Age><Weight>1,123</Weight><PigName>Miss piggy</PigName></TInstantGuineaPig>', ms.DataString); finally c.Free; --- 350,356 ---- InstantWriteObject(ms, sfXML, c); AssertEquals(102, ms.Position); ! AssertEquals('<TInstantGuineaPig><Age>2</Age><Weight>1' + DecimalSeparator + ! '123</Weight><PigName>Miss piggy</PigName></TInstantGuineaPig>', ! ms.DataString); finally c.Free; *************** *** 380,385 **** initialization RegisterTests([TTestInstantClasses]); RegisterClass(TInstantGuineaPig); ! end. --- 386,393 ---- initialization + // Register any test cases with the test runner + {$IFNDEF CURR_TESTS} RegisterTests([TTestInstantClasses]); RegisterClass(TInstantGuineaPig); ! {$ENDIF} end. Index: TestInstantRtti.pas =================================================================== RCS file: /cvsroot/instantobjects/Source/Tests/TestInstantRtti.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** TestInstantRtti.pas 2 May 2005 23:26:34 -0000 1.1 --- TestInstantRtti.pas 3 May 2005 04:52:37 -0000 1.2 *************** *** 203,207 **** --- 203,210 ---- initialization + // Register any test cases with the test runner + {$IFNDEF CURR_TESTS} RegisterTests([TTestInstantRtti]); + {$ENDIF} end. --- NEW FILE: TestInstantTableMetadata.pas --- unit TestInstantTableMetadata; interface uses fpcunit, InstantPersistence; type // Test methods for class TInstantTableMetadata TestTInstantTableMetadata = class(TTestCase) private FCollection: TInstantTableMetadatas; FInstantTableMetadata: TInstantTableMetadata; FOwner: TInstantScheme; public procedure SetUp; override; procedure TearDown; override; published procedure TestFieldMetadatas; procedure TestIndexMetadatas; procedure TestScheme; end; // Test methods for class TInstantTableMetadatas TestTInstantTableMetadatas = class(TTestCase) private FInstantTableMetadatas: TInstantTableMetadatas; public procedure SetUp; override; procedure TearDown; override; published procedure TestAdd_ReadItems; end; implementation uses SysUtils, testregistry; procedure TestTInstantTableMetadata.SetUp; begin FOwner := TInstantScheme.Create(nil); FCollection := TInstantTableMetadatas.Create(FOwner); FInstantTableMetadata := TInstantTableMetadata.Create(FCollection); end; procedure TestTInstantTableMetadata.TearDown; begin FInstantTableMetadata.Free; FInstantTableMetadata := nil; FreeAndNil(FCollection); FreeAndNil(FOwner); end; procedure TestTInstantTableMetadata.TestFieldMetadatas; begin AssertNotNull('FieldMetadatas is nil!', FInstantTableMetadata.FieldMetadatas); end; procedure TestTInstantTableMetadata.TestIndexMetadatas; begin AssertNotNull('IndexMetadatas is nil!', FInstantTableMetadata.IndexMetadatas); end; procedure TestTInstantTableMetadata.TestScheme; begin AssertNotNull('Scheme is nil!', FInstantTableMetadata.Scheme); AssertSame('Scheme value is incorrect!', FOwner, FInstantTableMetadata.Scheme); end; procedure TestTInstantTableMetadatas.SetUp; begin FInstantTableMetadatas := TInstantTableMetadatas.Create(nil); end; procedure TestTInstantTableMetadatas.TearDown; begin FInstantTableMetadatas.Free; FInstantTableMetadatas := nil; end; procedure TestTInstantTableMetadatas.TestAdd_ReadItems; var vReturnValue: TInstantTableMetadata; begin vReturnValue := FInstantTableMetadatas.Add; AssertNotNull('vReturnValue is nil!', vReturnValue); AssertEquals('Count is incorrect!', 1, FInstantTableMetadatas.Count); AssertNotNull('Items[0] is nil!', FInstantTableMetadatas.Items[0]); FInstantTableMetadatas.Remove(vReturnValue); AssertEquals('Count is incorrect!', 0, FInstantTableMetadatas.Count); end; initialization // Register any test cases with the test runner {$IFNDEF CURR_TESTS} RegisterTests([TestTInstantTableMetadata, TestTInstantTableMetadatas]); {$ENDIF} end. Index: TestIO.dof =================================================================== RCS file: /cvsroot/instantobjects/Source/Tests/TestIO.dof,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** TestIO.dof 2 May 2005 23:26:34 -0000 1.1 --- TestIO.dof 3 May 2005 04:52:37 -0000 1.2 *************** *** 21,25 **** R=0 S=0 ! T=0 U=0 V=1 --- 21,25 ---- R=0 S=0 ! T=1 U=0 V=1 *************** *** 77,83 **** SuspiciousTypecast=1 PrivatePropAccessor=1 ! UnsafeType=1 ! UnsafeCode=1 ! UnsafeCast=1 [Linker] MapFile=0 --- 77,83 ---- SuspiciousTypecast=1 PrivatePropAccessor=1 ! UnsafeType=0 ! UnsafeCode=0 ! UnsafeCast=0 [Linker] MapFile=0 *************** *** 92,101 **** [Directories] OutputDir= ! UnitOutputDir= PackageDLLOutputDir= PackageDCPOutputDir= ! SearchPath=D:\lazarus\components\fpcunit\ubmock\src ! Packages= ! Conditionals= DebugSourceDirs= UsePackages=0 --- 92,101 ---- [Directories] OutputDir= ! UnitOutputDir=D:\D\DCU\D7\Tmp PackageDLLOutputDir= PackageDCPOutputDir= ! SearchPath=D:\L\ubmock\src ! Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;adortl;vclactnband;vclshlctrls;CS30Logging70;Rz30Ctls70;Rz30DBCtls70;ip4000v7;Rave60VCL;Rave60CLX;madBasic_;madDisAsm_;CLXIB;ibxpress;VCLIB;IOCore;IOIBX ! Conditionals=CURR_TESTS DebugSourceDirs= UsePackages=0 *************** *** 109,113 **** ActiveLang= ProjectLang= ! RootDir= [Version Info] IncludeVerInfo=0 --- 109,113 ---- ActiveLang= ProjectLang= ! RootDir=C:\Program Files\Borland\Delphi7\Bin\ [Version Info] IncludeVerInfo=0 *************** *** 122,125 **** Private=0 DLL=0 ! Locale=1040 CodePage=1252 --- 122,142 ---- Private=0 DLL=0 ! Locale=3081 CodePage=1252 + [Version Info Keys] + CompanyName= + FileDescription= + FileVersion=1.0.0.0 + InternalName= + LegalCopyright= + LegalTrademarks= + OriginalFilename= + ProductName= + ProductVersion=1.0.0.0 + Comments= + [HistoryLists\hlConditionals] + Count=1 + Item0=CURR_TESTS + [HistoryLists\hlUnitAliases] + Count=1 + Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; --- NEW FILE: TestModel.pas --- (* * TestIO Model: * TestModel.pas with "external storage" of Part and Parts * *) unit TestModel; interface uses InstantPersistence; type TAddress = class; TCategory = class; TCompany = class; TContact = class; TContactFilter = class; TCountry = class; TEmail = class; TPerson = class; TPhone = class; TAddress = class(TInstantObject) {IOMETADATA stored; City: String(30) index; Country: Reference(TCountry); State: String(4); Street: Memo; Zip: String(10); } _City: TInstantString; _Country: TInstantReference; _State: TInstantString; _Street: TInstantMemo; _Zip: TInstantString; private function GetCity: string; function GetCountry: TCountry; function GetState: string; function GetStreet: string; function GetZip: string; procedure SetCity(const Value: string); procedure SetCountry(Value: TCountry); procedure SetState(const Value: string); procedure SetStreet(const Value: string); procedure SetZip(const Value: string); published property City: string read GetCity write SetCity; property Country: TCountry read GetCountry write SetCountry; property State: string read GetState write SetState; property Street: string read GetStreet write SetStreet; property Zip: string read GetZip write SetZip; end; TCountry = class(TInstantObject) {IOMETADATA stored; Name: String(30); } _Name: TInstantString; private function GetName: string; procedure SetName(const Value: string); protected procedure BeforeStore; override; function GetCaption: string; override; published property Id; property Name: string read GetName write SetName; end; TPhone = class(TInstantObject) {IOMETADATA stored; Name: String(20); Number: String(20) mask '(000) 000-0000;0;_'; } _Name: TInstantString; _Number: TInstantString; private function GetName: string; function GetNumber: string; procedure SetName(const Value: string); procedure SetNumber(const Value: string); published property Name: string read GetName write SetName; property Number: string read GetNumber write SetNumber; end; TEmail = class(TInstantObject) {IOMETADATA stored; Address: String(100); } _Address: TInstantString; private function GetAddress: string; procedure SetAddress(const Value: string); published property Address: string read GetAddress write SetAddress; end; TCategory = class(TInstantObject) {IOMETADATA stored 'Categories'; Name: String(30); } _Name: TInstantString; private function GetName: string; procedure SetName(const Value: string); protected function GetCaption: string; override; published property Name: string read GetName write SetName; end; TContact = class(TInstantObject) {IOMETADATA stored; Address: Part(TAddress); Category: Reference(TCategory); City: String(30) index; Name: String(50) index; Phones: Parts(TPhone); } _Address: TInstantPart; _Category: TInstantReference; _City: TInstantString; _Name: TInstantString; _Phones: TInstantParts; private function GetAddress: TAddress; function GetCategory: TCategory; function GetCity: string; function GetMainPhoneNumber: string; function GetName: string; function GetPhoneCount: Integer; function GetPhones(Index: Integer): TPhone; procedure SetAddress(Value: TAddress); procedure SetCategory(Value: TCategory); procedure SetCity(const Value: string); procedure SetMainPhoneNumber(const Value: string); procedure SetName(const Value: string); procedure SetPhones(Index: Integer; Value: TPhone); protected procedure AfterCreate; override; procedure BeforeStore; override; function GetCaption: string; override; public function AddPhone(Phone: TPhone): Integer; procedure ClearPhones; procedure DeletePhone(Index: Integer); function IndexOfPhone(Phone: TPhone): Integer; procedure InsertPhone(Index: Integer; Phone: TPhone); function RemovePhone(Phone: TPhone): Integer; property PhoneCount: Integer read GetPhoneCount; property Phones[Index: Integer]: TPhone read GetPhones write SetPhones; published property Address: TAddress read GetAddress write SetAddress; property Category: TCategory read GetCategory write SetCategory; property City: string read GetCity write SetCity; property MainPhoneNumber: string read GetMainPhoneNumber write SetMainPhoneNumber; property Name: string read GetName write SetName; end; TContactFilter = class(TContact) private FIsDynamic: Boolean; function GetIsEmpty: Boolean; public function Matches(Contact: TContact): Boolean; published property IsDynamic: Boolean read FIsDynamic write FIsDynamic; property IsEmpty: Boolean read GetIsEmpty; end; TPerson = class(TContact) {IOMETADATA stored; BirthDate: DateTime; Emails: Parts(TEmail) externalstored 'Person_Email'; Employer: Reference(TCompany); Picture: Blob; Salary: Currency; } _BirthDate: TInstantDateTime; _Emails: TInstantParts; _Employer: TInstantReference; _Picture: TInstantGraphic; _Salary: TInstantCurrency; private function GetBirthDate: TDateTime; function GetEmailCount: Integer; function GetEmails(Index: Integer): TEmail; function GetEmployer: TCompany; function GetMainEmailAddress: string; function GetPicture: string; function GetSalary: Currency; procedure SetBirthDate(Value: TDateTime); procedure SetEmails(Index: Integer; Value: TEmail); procedure SetMainEmailAddress(const Value: string); procedure SetPicture(const Value: string); procedure SetSalary(Value: Currency); protected procedure BeforeDispose; override; public function AddEmail(Email: TEmail): Integer; procedure ClearEmails; procedure DeleteEmail(Index: Integer); procedure EmployBy(NewEmployer: TCompany); function IndexOfEmail(Email: TEmail): Integer; procedure InsertEmail(Index: Integer; Email: TEmail); function RemoveEmail(Email: TEmail): Integer; property EmailCount: Integer read GetEmailCount; property Emails[Index: Integer]: TEmail read GetEmails write SetEmails; published property BirthDate: TDateTime read GetBirthDate write SetBirthDate; property Employer: TCompany read GetEmployer; property MainEmailAddress: string read GetMainEmailAddress write SetMainEmailAddress; property Picture: string read GetPicture write SetPicture; property Salary: Currency read GetSalary write SetSalary; end; TCompany = class(TContact) {IOMETADATA stored; Employees: References(TPerson) externalstored 'Company_Employee'; } _Employees: TInstantReferences; private function GetEmployeeCount: Integer; function GetEmployees(Index: Integer): TPerson; public function AddEmployee(Employee: TPerson): Integer; procedure ClearEmployees; procedure DeleteEmployee(Index: Integer); function IndexOfEmployee(Employee: TPerson): Integer; procedure InsertEmployee(Index: Integer; Employee: TPerson); function RemoveEmployee(Employee: TPerson): Integer; property EmployeeCount: Integer read GetEmployeeCount; property Employees[Index: Integer]: TPerson read GetEmployees; end; implementation uses SysUtils, InstantUtils; { TAddress } function TAddress.GetCity: string; begin Result := _City.Value; end; function TAddress.GetCountry: TCountry; begin Result := _Country.Value as TCountry; end; function TAddress.GetState: string; begin Result := _State.Value; end; function TAddress.GetStreet: string; begin Result := _Street.Value; end; function TAddress.GetZip: string; begin Result := _Zip.Value; end; procedure TAddress.SetCity(const Value: string); begin _City.Value := Value; end; procedure TAddress.SetCountry(Value: TCountry); begin _Country.Value := Value; end; procedure TAddress.SetState(const Value: string); begin _State.Value := Value; end; procedure TAddress.SetStreet(const Value: string); begin _Street.Value := Value; end; procedure TAddress.SetZip(const Value: string); begin _Zip.Value := Value; end; { TCountry } procedure TCountry.BeforeStore; begin if Id = '' then raise Exception.Create('Country ID missing'); inherited; end; function TCountry.GetCaption: string; begin Result := Name; end; function TCountry.GetName: string; begin Result := _Name.Value; end; procedure TCountry.SetName(const Value: string); begin _Name.Value := Value; end; { TPerson } function TPerson.AddEmail(Email: TEmail): Integer; begin Result := _Emails.Add(Email); end; procedure TPerson.BeforeDispose; begin inherited; EmployBy(nil); end; procedure TPerson.ClearEmails; begin _Emails.Clear; end; procedure TPerson.DeleteEmail(Index: Integer); begin _Emails.Delete(Index); end; procedure TPerson.EmployBy(NewEmployer: TCompany); procedure AddToEmployer(AEmployer: TCompany); begin if Assigned(AEmployer) then AEmployer.AddEmployee(Self); end; procedure RemoveFromEmployer(AEmployer: TCompany); begin if Assigned(AEmployer) then AEmployer.RemoveEmployee(Self); end; procedure StoreEmployer(AEmployer: TCompany); begin if Assigned(AEmployer) then AEmployer.Store; end; var OldEmployer: TCompany; begin OldEmployer := Employer; AddRef; try Connector.StartTransaction; try AddToEmployer(NewEmployer); try StoreEmployer(NewEmployer); RemoveFromEmployer(OldEmployer); try StoreEmployer(OldEmployer); _Employer.Value := NewEmployer; try Store; Connector.CommitTransaction; except _Employer.Value := OldEmployer; raise; end; except AddToEmployer(OldEmployer); raise; end; except RemoveFromEmployer(NewEmployer); raise; end; except Connector.RollbackTransaction; raise; end; finally Free; end; end; function TPerson.GetBirthDate: TDateTime; begin Result := _BirthDate.Value; end; function TPerson.GetEmailCount: Integer; begin Result := _Emails.Count end; function TPerson.GetEmails(Index: Integer): TEmail; begin Result := _Emails[Index] as TEmail; end; function TPerson.GetEmployer: TCompany; begin Result := _Employer.Value as TCompany; end; function TPerson.GetMainEmailAddress: string; begin if EmailCount > 0 then Result := Emails[0].Address else Result := ''; end; function TPerson.GetPicture: string; begin Result := _Picture.Value; end; function TPerson.GetSalary: Currency; begin Result := _Salary.Value; end; function TPerson.IndexOfEmail(Email: TEmail): Integer; begin Result := _Emails.IndexOf(Email); end; procedure TPerson.InsertEmail(Index: Integer; Email: TEmail); begin _Emails.Insert(Index, Email); end; function TPerson.RemoveEmail(Email: TEmail): Integer; begin Result := _Emails.Remove(Email); end; procedure TPerson.SetBirthDate(Value: TDateTime); begin _BirthDate.Value := Value; end; procedure TPerson.SetEmails(Index: Integer; Value: TEmail); begin _Emails[Index] := Value; end; procedure TPerson.SetMainEmailAddress(const Value: string); var Email: TEmail; begin if Value <> MainEmailAddress then begin if EmailCount = 0 then begin Email := TEmail.Create; AddEmail(Email); end else Email := Emails[0]; Email.Address := Value; end; end; procedure TPerson.SetPicture(const Value: string); begin _Picture.Value := Value; end; { TPhone } procedure TPerson.SetSalary(Value: Currency); begin _Salary.Value := Value; end; function TPhone.GetName: string; begin Result := _Name.Value; end; function TPhone.GetNumber: string; begin Result := _Number.Value; end; procedure TPhone.SetName(const Value: string); begin _Name.Value := Value; end; procedure TPhone.SetNumber(const Value: string); begin _Number.Value := Value; end; { TEmail } function TEmail.GetAddress: string; begin Result := _Address.Value; end; procedure TEmail.SetAddress(const Value: string); begin _Address.Value := Value; end; { TCategory } function TCategory.GetCaption: string; begin Result := Name; end; function TCategory.GetName: string; begin Result := _Name.Value; end; procedure TCategory.SetName(const Value: string); begin _Name.Value := Value; end; { TContact } function TContact.AddPhone(Phone: TPhone): Integer; begin Result := _Phones.Add(Phone); end; procedure TContact.AfterCreate; begin inherited; Id := InstantGenerateId; _Category.ReferenceObject(TCategory, 'CAT000'); end; procedure TContact.BeforeStore; begin if Name = '' then raise Exception.Create('Contact name required'); inherited; City := Address.City; end; procedure TContact.ClearPhones; begin _Phones.Clear; end; procedure TContact.DeletePhone(Index: Integer); begin _Phones.Delete(Index); end; function TContact.GetAddress: TAddress; begin Result := _Address.Value as TAddress; end; function TContact.GetCaption: string; begin Result := Name; end; function TContact.GetCategory: TCategory; begin Result := _Category.Value as TCategory; end; function TContact.GetCity: string; begin Result := _City.Value; end; function TContact.GetMainPhoneNumber: string; begin if PhoneCount > 0 then Result := Phones[0].Number else Result := ''; end; function TContact.GetName: string; begin Result := _Name.Value; end; function TContact.GetPhoneCount: Integer; begin Result := _Phones.Count end; function TContact.GetPhones(Index: Integer): TPhone; begin Result := _Phones[Index] as TPhone; end; function TContact.IndexOfPhone(Phone: TPhone): Integer; begin Result := _Phones.IndexOf(Phone); end; procedure TContact.InsertPhone(Index: Integer; Phone: TPhone); begin _Phones.Insert(Index, Phone); end; function TContact.RemovePhone(Phone: TPhone): Integer; begin Result := _Phones.Remove(Phone); end; procedure TContact.SetAddress(Value: TAddress); begin _Address.Value := Value; end; procedure TContact.SetCategory(Value: TCategory); begin _Category.Value := Value; end; procedure TContact.SetCity(const Value: string); begin _City.Value := Value; end; procedure TContact.SetMainPhoneNumber(const Value: string); var Phone: TPhone; begin if Value <> MainPhoneNumber then begin if PhoneCount = 0 then begin Phone := TPhone.Create; AddPhone(Phone); Phone.Name := 'Main'; end else Phone := Phones[0]; Phone.Number := Value; end; end; procedure TContact.SetName(const Value: string); begin _Name.Value := Value; end; procedure TContact.SetPhones(Index: Integer; Value: TPhone); begin _Phones[Index] := Value; end; { TContactFilter } function TContactFilter.GetIsEmpty: Boolean; begin Result := (Name = '') and (Address.Street = '') and (Address.City = '') and (Address.Zip = '') and (Address.State = '') and (Address.Country = nil) and (Category = nil); end; function TContactFilter.Matches(Contact: TContact): Boolean; function MatchStr(const Str1, Str2: string): Boolean; begin Result := (Str1 = '') or (Pos(UpperCase(Str1), UpperCase(Str2)) > 0); end; function MatchObj(Obj1, Obj2: TObject): Boolean; begin Result := not Assigned(Obj1) or (Obj1 = Obj2); end; begin Result := Assigned(Contact) and MatchStr(Name, Contact.Name) and MatchStr(Address.Street, Contact.Address.Street) and MatchStr(Address.City, Contact.Address.City) and MatchStr(Address.Zip, Contact.Address.Zip) and MatchStr(Address.State, Contact.Address.State) and MatchObj(Address.Country, Contact.Address.Country) and MatchObj(Category, Contact.Category); end; { TCompany } function TCompany.AddEmployee(Employee: TPerson): Integer; begin Result := _Employees.Add(Employee) end; procedure TCompany.ClearEmployees; begin _Employees.Clear; end; procedure TCompany.DeleteEmployee(Index: Integer); begin _Employees.Delete(Index); end; function TCompany.GetEmployeeCount: Integer; begin Result := _Employees.Count end; function TCompany.GetEmployees(Index: Integer): TPerson; begin Result := _Employees[Index] as TPerson; end; function TCompany.IndexOfEmployee(Employee: TPerson): Integer; begin Result := _Employees.IndexOf(Employee); end; procedure TCompany.InsertEmployee(Index: Integer; Employee: TPerson); begin _Employees.Insert(Index, Employee); end; function TCompany.RemoveEmployee(Employee: TPerson): Integer; begin Result := _Employees.Remove(Employee); end; initialization InstantRegisterClasses([ TAddress, TCategory, TCompany, TContact, TContactFilter, TCountry, TEmail, TPerson, TPhone ]); end. Index: TestIO.dpr =================================================================== RCS file: /cvsroot/instantobjects/Source/Tests/TestIO.dpr,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** TestIO.dpr 2 May 2005 23:26:33 -0000 1.3 --- TestIO.dpr 3 May 2005 04:52:37 -0000 1.4 *************** *** 6,12 **** uses ! {$IFDEF FPC} Interfaces, {$ENDIF} ! Forms, GuiTestRunner, fpcunit, testregistry, --- 6,14 ---- uses ! {$IFDEF FPC} ! Interfaces, {$ENDIF} ! Forms, ! GuiTestRunner, fpcunit, testregistry, *************** *** 16,31 **** TestMockConnector in 'TestMockConnector.pas', TestMockBroker in 'TestMockBroker.pas', ! TestInstantPersistence in 'TestInstantPersistence.pas', TestInstantClasses in 'TestInstantClasses.pas', TestInstantRtti in 'TestInstantRtti.pas', ! TestMinimalModel in 'TestMinimalModel.pas', ! TestMinimalModelDb in 'TestMinimalModelDb.pas', ! TestModelDb in 'TestModelDb.pas'; {$R *.res} begin Application.Initialize; ! Application.CreateForm(TGUITestRunner, TestRunner); Application.Run; end. --- 18,39 ---- TestMockConnector in 'TestMockConnector.pas', TestMockBroker in 'TestMockBroker.pas', ! TestInstantMetadata in 'TestInstantMetadata.pas', ! TestModel in 'TestModel.pas', ! TestInstantFieldMetadata in 'TestInstantFieldMetadata.pas', ! TestInstantClassMetadata in 'TestInstantClassMetadata.pas', ! TestInstantAttributeMetadata in 'TestInstantAttributeMetadata.pas', ! TestInstantIndexMetadata in 'TestInstantIndexMetadata.pas', ! TestInstantTableMetadata in 'TestInstantTableMetadata.pas', ! TestInstantScheme in 'TestInstantScheme.pas', TestInstantClasses in 'TestInstantClasses.pas', TestInstantRtti in 'TestInstantRtti.pas', ! TestMinimalModel in 'TestMinimalModel.pas'; {$R *.res} + {$R *.mdr} {TestModel} begin Application.Initialize; ! Application.CreateForm(TTestRunner, TestRunner); Application.Run; end. --- NEW FILE: TestInstantClassMetadata.pas --- unit TestInstantClassMetadata; interface uses fpcunit, InstantMock, InstantPersistence; type // Test methods for class TInstantClassMetadata TestTInstantClassMetadata = class(TTestCase) private FClassCount: Integer; FConn: TInstantMockConnector; FInstantClassMetadata: TInstantClassMetadata; public procedure SetUp; override; procedure TearDown; override; published procedure TestAssign; procedure TestAttributeMetadatas; procedure TestCollection; procedure TestFindInstantAttributeMetadata; procedure TestIsEmpty; procedure TestIsStored; procedure TestMemberMap; procedure TestParentName; procedure TestPersistence; procedure TestStorageMaps; procedure TestStorageName; procedure TestTableName; end; // Test methods for class TInstantClassMetadatas TestTInstantClassMetadatas = class(TTestCase) private FInstantClassMetadatas: TInstantClassMetadatas; public procedure SetUp; override; procedure TearDown; override; published procedure TestAdd; procedure TestFind; procedure TestItems; end; implementation uses SysUtils, TypInfo, testregistry; procedure TestTInstantClassMetadata.SetUp; begin FConn := TInstantMockConnector.Create(nil); FConn.BrokerClass := TInstantMockBroker; if FClassCount > 0 then InstantModel.ClassMetadatas.Clear; InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr')); // Load a default ClassMetadata FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TContact'); end; procedure TestTInstantClassMetadata.TearDown; begin FInstantClassMetadata := nil; FConn.Free; end; procedure TestTInstantClassMetadata.TestAssign; var vDest, vSource: TInstantClassMetadata; vStr: string; begin vSource := TInstantClassMetadata.Create(nil); vDest := TInstantClassMetadata.Create(nil); try vSource.DefaultContainerName := 'DefaultContainerName'; vSource.StorageName := 'StorageName'; vSource.Persistence := peStored; vDest.Assign(vSource); AssertEquals('DefaultContainerName is incorrect!', 'DefaultContainerName', vDest.DefaultContainerName); AssertEquals('StorageName is incorrect!', 'StorageName', vDest.StorageName); vStr := GetEnumName(TypeInfo(TInstantPersistence), Ord(vDest.Persistence)); AssertEquals('PersistenceType incorrect', 'peStored', vStr); finally vSource.Free; vDest.Free; end; end; procedure TestTInstantClassMetadata.TestAttributeMetadatas; begin AssertNotNull('AttributeMetadatas is nil!', FInstantClassMetadata.AttributeMetadatas); end; procedure TestTInstantClassMetadata.TestCollection; begin // Collection property contains all of the class metadatas in the model AssertNotNull('Collection is nil!', FInstantClassMetadata.Collection); AssertEquals('The number of model classes is incorrect!', 9, FInstantClassMetadata.Collection.Count); FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TPhone'); AssertEquals('The number of model classes is incorrect!', 9, FInstantClassMetadata.Collection.Count); end; procedure TestTInstantClassMetadata.TestFindInstantAttributeMetadata; begin AssertNotNull(FInstantClassMetadata); end; procedure TestTInstantClassMetadata.TestIsEmpty; begin AssertFalse('FInstantClassMetadata is empty!', FInstantClassMetadata.IsEmpty); end; procedure TestTInstantClassMetadata.TestIsStored; begin AssertTrue('Incorrect storage flag!', FInstantClassMetadata.IsStored); FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TContactFilter'); AssertFalse('Incorrect storage flag!', FInstantClassMetadata.IsStored); end; procedure TestTInstantClassMetadata.TestMemberMap; begin AssertNotNull('MemberMap is nil!', FInstantClassMetadata.MemberMap); end; procedure TestTInstantClassMetadata.TestParentName; begin AssertEquals('ParentName incorrect!', '', FInstantClassMetadata.ParentName); FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TPerson'); AssertEquals('ParentName incorrect!', 'TContact', FInstantClassMetadata.ParentName); end; procedure TestTInstantClassMetadata.TestPersistence; var vStr: string; begin vStr := GetEnumName(TypeInfo(TInstantPersistence), Ord(FInstantClassMetadata.Persistence)); AssertEquals('PersistenceType incorrect', 'peStored', vStr); FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TContactFilter'); vStr := GetEnumName(TypeInfo(TInstantPersistence), Ord(FInstantClassMetadata.Persistence)); AssertEquals('PersistenceType incorrect', 'peEmbedded', vStr); end; procedure TestTInstantClassMetadata.TestStorageMaps; begin AssertNotNull('StorageMaps is nil!', FInstantClassMetadata.StorageMaps); FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TContactFilter'); AssertNull('StorageMaps should be nil!', FInstantClassMetadata.StorageMaps); end; procedure TestTInstantClassMetadata.TestStorageName; begin // Test with default class StorageName returns ''. AssertEquals('StorageName incorrect!', '', FInstantClassMetadata.StorageName); // Test for User entered non-default class StorageName. FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TCategory'); AssertEquals('StorageName incorrect!', 'Categories', FInstantClassMetadata.StorageName); end; procedure TestTInstantClassMetadata.TestTableName; begin // Test with default class StorageName (TableName). AssertEquals('TableName incorrect!', 'Contact', FInstantClassMetadata.TableName); // Test for User entered non-default class StorageName (TableName). FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TCategory'); AssertEquals('TableName incorrect!', 'Categories', FInstantClassMetadata.TableName); end; procedure TestTInstantClassMetadatas.SetUp; var TestItem: TInstantClassMetadata; begin FInstantClassMetadatas := TInstantClassMetadatas.Create(nil); TestItem := TInstantClassMetadata(FInstantClassMetadatas.Add); TestItem.Name := 'TPerson'; TestItem := TInstantClassMetadata(FInstantClassMetadatas.Add); TestItem.Name := 'TAddress'; TestItem := TInstantClassMetadata(FInstantClassMetadatas.Add); TestItem.Name := 'TCountry'; end; procedure TestTInstantClassMetadatas.TearDown; begin FInstantClassMetadatas.Free; FInstantClassMetadatas := nil; end; procedure TestTInstantClassMetadatas.TestAdd; var vReturnValue: TInstantClassMetadata; begin vReturnValue := FInstantClassMetadatas.Add; AssertNotNull('vReturnValue is nil!', vReturnValue); AssertEquals('Count is incorrect!', 4, FInstantClassMetadatas.Count); FInstantClassMetadatas.Remove(vReturnValue); AssertEquals('Count is incorrect!', 3, FInstantClassMetadatas.Count); end; procedure TestTInstantClassMetadatas.TestFind; var vReturnValue: TInstantClassMetadata; vName: string; begin vName := 'TAddress'; vReturnValue := FInstantClassMetadatas.Find(vName); AssertEquals('TestFind failed!', vName, vReturnValue.Name); end; procedure TestTInstantClassMetadatas.TestItems; begin AssertEquals('The second item''s name is incorrect!', 'TAddress', FInstantClassMetadatas.Items[1].Name); end; initialization // Register any test cases with the test runner {$IFNDEF CURR_TESTS} RegisterTests([TestTInstantClassMetadata, TestTInstantClassMetadatas]); {$ENDIF} end. --- NEW FILE: TestInstantFieldMetadata.pas --- unit TestInstantFieldMetadata; interface uses fpcunit, InstantPersistence; type // Test methods for class TInstantFieldMetadata TestTInstantFieldMetadata = class(TTestCase) private FOwner: TInstantTableMetadata; FCollection: TInstantFieldMetadatas; FInstantFieldMetadata: TInstantFieldMetadata; public procedure SetUp; override; procedure TearDown; override; published procedure TestCollection; procedure TestDataType; procedure TestExternalTableName; procedure TestOptions; procedure TestOriginalAttributeType; procedure TestSize; end; // Test methods for class TInstantFieldMetadatas TestTInstantFieldMetadatas = class(TTestCase) private FOwner: TInstantTableMetadata; FInstantFieldMetadatas: TInstantFieldMetadatas; public procedure SetUp; override; procedure TearDown; override; published procedure TestAddFieldMetadata; procedure TestAddRemoveItems; procedure TestOwner; end; implementation uses SysUtils, TypInfo, testregistry; procedure TestTInstantFieldMetadata.SetUp; begin FOwner := TInstantTableMetadata.Create(nil); FCollection := TInstantFieldMetadatas.Create(FOwner); FInstantFieldMetadata := TInstantFieldMetadata.Create(FCollection); FInstantFieldMetadata.DataType := dtInteger; FInstantFieldMetadata.ExternalTableName := 'ExternalTableName'; FInstantFieldMetadata.Size := 10; FInstantFieldMetadata.Options := [foRequired]; FInstantFieldMetadata.OriginalAttributeType := atInteger; end; procedure TestTInstantFieldMetadata.TearDown; begin FInstantFieldMetadata.Free; FInstantFieldMetadata := nil; FreeAndNil(FCollection); FreeAndNil(FOwner); end; procedure TestTInstantFieldMetadata.TestCollection; begin AssertNotNull('Collection is nil!', FInstantFieldMetadata.Collection); AssertSame('Collection is incorrect!', FCollection, FInstantFieldMetadata.Collection); end; procedure TestTInstantFieldMetadata.TestDataType; var vStr: string; begin vStr := GetEnumName(TypeInfo(TInstantDataType), Ord(FInstantFieldMetadata.DataType)); AssertEquals('DataType incorrect!', 'dtInteger', vStr); end; procedure TestTInstantFieldMetadata.TestExternalTableName; begin AssertEquals('ExternalTableName incorrect!', 'ExternalTableName', FInstantFieldMetadata.ExternalTableName); end; procedure TestTInstantFieldMetadata.TestOptions; begin AssertTrue('Options incorrect!', foRequired in FInstantFieldMetadata.Options); end; procedure TestTInstantFieldMetadata.TestOriginalAttributeType; var vStr: string; begin vStr := GetEnumName(TypeInfo(TInstantAttributeType), Ord(FInstantFieldMetadata.OriginalAttributeType)); AssertEquals('OriginalAttributeType incorrect!', 'atInteger', vStr); end; procedure TestTInstantFieldMetadata.TestSize; begin AssertEquals('Size incorrect!', 10, FInstantFieldMetadata.Size); end; procedure TestTInstantFieldMetadatas.SetUp; begin FOwner := TInstantTableMetadata.Create(nil); FInstantFieldMetadatas := TInstantFieldMetadatas.Create(FOwner); end; procedure TestTInstantFieldMetadatas.TearDown; begin FInstantFieldMetadatas.Free; FInstantFieldMetadatas := nil; FreeAndNil(FOwner); end; procedure TestTInstantFieldMetadatas.TestAddRemoveItems; var vReturnValue: TInstantFieldMetadata; begin vReturnValue := FInstantFieldMetadatas.Add; AssertNotNull('vReturnValue is nil!', vReturnValue); AssertEquals('Count is incorrect!', 1, FInstantFieldMetadatas.Count); AssertNotNull('Items[0] is nil!', FInstantFieldMetadatas.Items[0]); FInstantFieldMetadatas.Remove(vReturnValue); AssertEquals('Count is incorrect!', 0, FInstantFieldMetadatas.Count); end; procedure TestTInstantFieldMetadatas.TestAddFieldMetadata; var vExternalTableName: string; vOptions: TInstantFieldOptions; vOriginalAttributeType: TInstantAttributeType; vSize: Integer; vDataType: TInstantDataType; vName: string; vInstantFieldMetadata: TInstantFieldMetadata; vStr: string; begin vName := 'Code'; vDataType := dtInteger; vSize := 10; vOriginalAttributeType := atInteger; vOptions := [foRequired]; vExternalTableName := 'ExternalTableName'; FInstantFieldMetadatas.AddFieldMetadata(vName, vDataType, vSize, vOriginalAttributeType, vOptions, vExternalTableName); AssertEquals('Count is incorrect!', 1, FInstantFieldMetadatas.Count); vInstantFieldMetadata := FInstantFieldMetadatas.Items[0]; AssertNotNull(vInstantFieldMetadata); AssertEquals('Name is incorrect!', vName, vInstantFieldMetadata.Name); AssertEquals('Size is incorrect!', 10, vInstantFieldMetadata.Size); vStr := GetEnumName(TypeInfo(TInstantAttributeType), Ord(vInstantFieldMetadata.OriginalAttributeType)); AssertEquals('OriginalAttributeType incorrect!', 'atInteger', vStr); AssertTrue('Count is incorrect!', foRequired in vInstantFieldMetadata.Options); vStr := GetEnumName(TypeInfo(TInstantDataType), Ord(vInstantFieldMetadata.DataType)); AssertEquals('DataType incorrect!', 'dtInteger', vStr); AssertEquals('ExternalTableName is incorrect!', 'ExternalTableName', vInstantFieldMetadata.ExternalTableName); end; procedure TestTInstantFieldMetadatas.TestOwner; begin AssertNotNull('Owner is nil!', FInstantFieldMetadatas.Owner); AssertSame('Owner value is incorrect!', FOwner, FInstantFieldMetadatas.Owner); end; initialization // Register any test cases with the test runner {$IFNDEF CURR_TESTS} RegisterTests([TestTInstantFieldMetadata, TestTInstantFieldMetadatas]); {$ENDIF} end. --- NEW FILE: TestInstantScheme.pas --- unit TestInstantScheme; interface uses fpcunit, InstantPersistence; type // Test methods for class TInstantRelationalScheme TestTInstantRelationalScheme = class(TTestCase) private FInstantRelationalScheme: TInstantRelationalScheme; public procedure SetUp; override; procedure TearDown; override; published procedure TestBlobStreamFormat; procedure TestFindTableMetadata; procedure TestIdDataType; procedure TestIdSize; procedure TestTableMetadataCount; procedure TestTableMetadatas; end; implementation uses SysUtils, testregistry, InstantClasses, InstantConsts; procedure TestTInstantRelationalScheme.SetUp; begin if InstantModel.ClassMetadatas.Count > 0 then InstantModel.ClassMetadatas.Clear; InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr')); FInstantRelationalScheme := TInstantRelationalScheme.Create(InstantModel); end; procedure TestTInstantRelationalScheme.TearDown; begin FInstantRelationalScheme.Free; FInstantRelationalScheme := nil; end; procedure TestTInstantRelationalScheme.TestBlobStreamFormat; begin AssertTrue('Incorrect BlobStreamFormat!', sfBinary = FInstantRelationalScheme.BlobStreamFormat); FInstantRelationalScheme.BlobStreamFormat := sfXML; AssertTrue('Incorrect BlobStreamFormat!', sfXML = FInstantRelationalScheme.BlobStreamFormat); end; procedure TestTInstantRelationalScheme.TestFindTableMetadata; var vReturnValue: TInstantTableMetadata; vName: string; begin vName := 'Contact'; vReturnValue := FInstantRelationalScheme.FindTableMetadata(vName); AssertNotNull('Could not find TableMetadata!', vReturnValue); AssertEquals('', vName, vReturnValue.Name); end; procedure TestTInstantRelationalScheme.TestIdDataType; begin AssertTrue('Incorrect IdDataType!', dtString = FInstantRelationalScheme.IdDataType); FInstantRelationalScheme.IdDataType := dtInteger; AssertTrue('Incorrect IdDataType!', dtInteger = FInstantRelationalScheme.IdDataType); end; procedure TestTInstantRelationalScheme.TestIdSize; begin AssertEquals('Incorrect IDSize!', InstantDefaultFieldSize, FInstantRelationalScheme.IdSize); FInstantRelationalScheme.IdSize := 10; AssertEquals('Incorrect IDSize!', 10, FInstantRelationalScheme.IdSize); end; procedure TestTInstantRelationalScheme.TestTableMetadataCount; begin AssertEquals('Incorrect TableMetadataCount!', 8, FInstantRelationalScheme.TableMetadataCount); end; procedure TestTInstantRelationalScheme.TestTableMetadatas; var vReturnValue: TInstantTableMetadata; begin vReturnValue := FInstantRelationalScheme.TableMetadatas[0]; AssertNotNull('TableMetadata is nil!', vReturnValue); AssertEquals('', 'Address', vReturnValue.Name); end; initialization // Register any test cases with the test runner {$IFNDEF CURR_TESTS} RegisterTests([TestTInstantRelationalScheme]); {$ENDIF} end. Index: TestIO.cfg =================================================================== RCS file: /cvsroot/instantobjects/Source/Tests/TestIO.cfg,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** TestIO.cfg 20 Feb 2005 19:26:42 -0000 1.1 --- TestIO.cfg 3 May 2005 04:52:37 -0000 1.2 *************** *** 1,38 **** ! -$A8 ! -$B- ! -$C+ ! -$D+ ! -$E- ! -$F- ! -$G+ ! -$H+ ! -$I+ ! -$J- ! -$K- ! -$L+ ! -$M- ! -$N+ ! -$O+ ! -$P+ ! -$Q- ! -$R- ! -$S- ! -$T- ! -$U- ! -$V+ ! -$W- ! -$X+ ! -$YD ! -$Z1 ! -cg ! -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; ! -H+ ! -W+ ! -M ! -$M16384,1048576 ! -K$00400000 ! -LE"c:\programmi\borland\delphi7\Projects\Bpl" ! -LN"c:\programmi\borland\delphi7\Projects\Bpl" ! -w-UNSAFE_TYPE ! -w-UNSAFE_CODE ! -w-UNSAFE_CAST --- 1,44 ---- ! -$A8 ! -$B- ! -$C+ ! -$D+ ! -$E- ! -$F- ! -$G+ ! -$H+ ! -$I+ ! -$J- ! -$K- ! -$L+ ! -$M- ! -$N+ ! -$O+ ! -$P+ ! -$Q- ! -$R- ! -$S- ! -$T+ ! -$U- ! -$V+ ! -$W- ! -$X+ ! -$YD ! -$Z1 ! -cg ! -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; ! -H+ ! -W+ ! -M ! -$M16384,1048576 ! -K$00400000 ! -N"D:\D\DCU\D7\Tmp" ! -LE"c:\program files\borland\delphi7\Projects\Bpl" ! -LN"c:\program files\borland\delphi7\Projects\Bpl" ! -U"D:\L\ubmock\src" ! -O"D:\L\ubmock\src" ! -I"D:\L\ubmock\src" ! -R"D:\L\ubmock\src" ! -DCURR_TESTS ! -w-UNSAFE_TYPE ! -w-UNSAFE_CODE ! -w-UNSAFE_CAST --- NEW FILE: TestIO.mdr --- (This appears to be a binary file; contents omitted.) --- NEW FILE: TestInstantAttributeMetadata.pas --- unit TestInstantAttributeMetadata; interface uses SysUtils, fpcunit, InstantMock, InstantPersistence; type TRunMethodCategory = procedure(Category: TInstantAttributeCategory) of object; TRunMethodIAClass = procedure(AClass: TInstantAttributeClass) of object; // Extended test methods for class TTestCase TTestCaseEx = class(TTestCase) public class procedure AssertException(const AMessage: string; AExceptionClass: ExceptClass; ACategory: TInstantAttributeCategory; AMethod: TRunMethodCategory); overload; class procedure AssertException(AExceptionClass: ExceptClass; ACategory: TInstantAttributeCategory; AMethod: TRunMethodCategory); overload; class procedure AssertException(const AMessage: string; AExceptionClass: ExceptClass; AClass: TInstantAttributeClass; AMethod: TRunMethodIAClass); overload; class procedure AssertException(AExceptionClass: ExceptClass; AClass: TInstantAttributeClass; AMethod: TRunMethodIAClass); overload; class procedure AssertNoException(const AMessage: string; AExceptionClass: ExceptClass; ACategory: TInstantAttributeCategory; AMethod: TRunMethodCategory); overload; class procedure AssertNoException(AExceptionClass: ExceptClass; ACategory: TInstantAttributeCategory; AMethod: TRunMethodCategory); overload; class procedure AssertNoException(const AMessage: string; AExceptionClass: ExceptClass; AClass: TInstantAttributeClass; AMethod: TRunMethodIAClass); overload; class procedure AssertNoException(AExceptionClass: ExceptClass; AClass: TInstantAttributeClass; AMethod: TRunMethodIAClass); overload; end; // Test methods for class TInstantAttributeMetadata TestTInstantAttributeMetadata = class(TTestCaseEx) private FConn: TInstantMockConnector; FInstantAttributeMetadata: TInstantAttributeMetadata; public procedure SetUp; override; procedure TearDown; override; published procedure TestCreateAttribute; procedure TestAssign; procedure TestCheckAttributeClass; procedure TestCheckCategory; procedure TestCheckIsIndexed; procedure TestIsAttributeClass; end; // Test methods for class TInstantAttributeMetadatas TestTInstantAttributeMetadatas = class(TTestCase) private FOwner: TInstantClassMetadata; FInstantAttributeMetadatas: TInstantAttributeMetadatas; public procedure SetUp; override; procedure TearDown; override; published procedure TestAddRemove; procedure TestClear; procedure TestFind; procedure TestOwner; end; implementation uses Classes, TypInfo, testregistry, InstantClasses; class procedure TTestCaseEx.AssertException(const AMessage: string; AExceptionClass: ExceptClass; ACategory: TInstantAttributeCategory; AMethod: TRunMethodCategory); var Passed : Boolean; ExceptionName: string; begin Passed := False; try AMethod(ACategory); except on E: Exception do begin ExceptionName := E.ClassName; if E.ClassType.InheritsFrom(AExceptionClass) then begin Passed := AExceptionClass.ClassName = E.ClassName; end; end; end; AssertTrue(Format(SExceptionCompare, [AExceptionClass.ClassName, ExceptionName])+ ': ' + AMessage, Passed); end; class procedure TTestCaseEx.AssertException(const AMessage: string; AExceptionClass: ExceptClass; AClass: TInstantAttributeClass; AMethod: TRunMethodIAClass); var Passed : Boolean; ExceptionName: string; begin Passed := False; try AMethod(AClass); except on E: Exception do begin ExceptionName := E.ClassName; if E.ClassType.InheritsFrom(AExceptionClass) then begin Passed := AExceptionClass.ClassName = E.ClassName; end; end; end; AssertTrue(Format(SExceptionCompare, [AExceptionClass.ClassName, ExceptionName])+ ': ' + AMessage, Passed); end; class procedure TTestCaseEx.AssertException(AExceptionClass: ExceptClass; ACategory: TInstantAttributeCategory; AMethod: TRunMethodCategory); begin AssertException('', AExceptionClass, ACategory, AMethod); end; class procedure TTestCaseEx.AssertException(AExceptionClass: ExceptCl... [truncated message content] |
