[Instantobjects-cvscommit] Source/Tests InstantMock.pas,NONE,1.1 Model.pas,NONE,1.1 TestIO.cfg,NONE,1.1 TestIO.dpr,NONE,1.1 TestIO.mdx,NONE,1.1 TestIO.res,NONE,1.1 TestMockBroker.pas,NONE,1.1 TestMockConnector.pas,NONE,1.1

[uberto b. <ub...@us...>]

Update of /cvsroot/instantobjects/Source/Tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9495

Added Files:
	InstantMock.pas Model.pas TestIO.cfg TestIO.dpr TestIO.mdx 
	TestIO.res TestMockBroker.pas TestMockConnector.pas 
Log Message:
Added Test

--- NEW FILE: TestMockBroker.pas ---
unit TestMockBroker;

interface

uses
  Classes, SysUtils,
  InstantPersistence,
  fpcunit,
  testregistry,
  InstantMock,
  UbMockObject,
  Model;

type

  TTestMockBroker = class(TTestCase)
  private
  protected
    FConn: TInstantMockConnector;
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestModelMdx;
    procedure TestGetBroker;
    procedure TestBuildDatabase;
    procedure TestStoreAndRetrieveAddress;
    procedure TestStoreAndRetrieveContact;
  end;


implementation


{ TTestMockBroker }

procedure TTestMockBroker.TestModelMdx;
begin
  InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx'));

  AssertNotNull(InstantModel.ClassMetadatas.Find('TContact'));
end;


procedure TTestMockBroker.TestGetBroker;
var
  brok: TInstantMockBroker;
begin
  brok := (Fconn.Broker as TInstantMockBroker);
  AssertNotNull(brok);
  AssertEquals(brok.ClassType, TInstantMockBroker);
  brok.MockManager.StartSetUp;
  brok.MockManager.EndSetUp;
  Fconn.BuildDatabase(InstantModel);
  brok.MockManager.Verify;
end;

procedure TTestMockBroker.TestBuildDatabase;
var
  brok: TInstantMockBroker;
begin
  InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx'));
  brok := Fconn.Broker as TInstantMockBroker;
  brok.MockManager.StartSetUp;
  brok.MockManager.EndSetUp;
  Fconn.BuildDatabase(InstantModel);
  brok.MockManager.Verify;
end;

procedure TTestMockBroker.TestStoreAndRetrieveAddress;
var
  a: TAddress;
  old_id: string;
  brok: TInstantMockBroker;
begin
  InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx'));
  Fconn.IsDefault := True;
  Fconn.StartTransaction;
  brok := Fconn.Broker as TInstantMockBroker;
  brok.MockManager.StartSetUp;
  a := TAddress.Create;
  try
    a.City := 'Milan';
    a.Store();
    old_id := a.id;
  finally
    a.Free;
  end;
  brok.MockManager.EndSetUp;
  brok.MockManager.AddExpectation('InternalStoreObject ' + old_id);
  brok.MockManager.Verify;
  Fconn.CommitTransaction;
  brok.MockManager.StartSetUp;
  a := TAddress.Create;
  try
    a.Retrieve(old_id);
  finally
    a.Free;
  end;
  brok.MockManager.EndSetUp;
  brok.MockManager.AddExpectation('InternalRetrieveObject ' + old_id);
  brok.MockManager.Verify;
end;

procedure TTestMockBroker.TestStoreAndRetrieveContact;
var
  c: TContact;
  old_id: string;
  brok: TInstantMockBroker;
begin
  InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx'));

  Fconn.IsDefault := True;
  brok := Fconn.Broker as TInstantMockBroker;
  brok.MockManager.StartSetUp;
  c := TContact.Create;
  try
    c.Name := 'Mike';
    c.Address.City := 'Milan';
    c.Store();
    old_id := c.id;
  finally
    c.Free;
  end;
  brok.MockManager.EndSetUp;
  brok.MockManager.AddExpectation('InternalStoreObject ' + old_id);
  brok.MockManager.Verify;
  brok.MockManager.StartSetUp;
  c := TContact.Create;
  try
    c.Retrieve(old_id);
  finally
    c.Free;
  end;
  brok.MockManager.EndSetUp;
  brok.MockManager.AddExpectation('InternalRetrieveObject ' + old_id);
  brok.MockManager.Verify;
end;


procedure TTestMockBroker.SetUp;
begin
  inherited;
  FConn := TInstantMockConnector.Create(nil);
end;

procedure TTestMockBroker.TearDown;
begin
  FConn.Free;
  inherited;
end;

initialization
  RegisterTests([TTestMockBroker]);

end.

--- NEW FILE: TestIO.cfg ---
-$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

--- NEW FILE: Model.pas ---
(*
 *   PrimerCross demo:
 *   Model.pas with "external storage" of Part and Parts
 *
 *)
unit Model;

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;
    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) externalstored 'Contact_Address';
    Category: Reference(TCategory);
    City: String(30) index;
    Name: String(50) index;
    Phones: Parts(TPhone) externalstored 'Contact_Phone'; }
    _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.

--- NEW FILE: TestIO.res ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: TestMockConnector.pas ---
unit TestMockConnector;

interface

uses
  Classes, SysUtils,
  InstantPersistence,
  fpcunit,
  testregistry,
  InstantMock,
  UbMockObject;

type

  TTestMockConnector = class(TTestCase)
  published
    procedure TestBuildDatabase;
    procedure TestConnectDisconnect;
    procedure TestTransaction;
    procedure TestDefault;
  end;

implementation

{ TTestMockConnector }

procedure TTestMockConnector.TestBuildDatabase;
var
  conn: TInstantMockConnector;
begin
  InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx'));
  conn := TInstantMockConnector.Create(nil);
  try
    AssertNotNull(conn);
    conn.MockManager.AddExpectation('InternalConnect');
    conn.MockManager.AddExpectation('InternalCreateScheme');
    conn.MockManager.AddExpectation('CreateBroker');
    conn.MockManager.AddExpectation('InternalDisconnect');
    conn.MockManager.EndSetUp;
    AssertEquals(4, conn.MockManager.UncoveredExpectations);
    conn.BuildDatabase(InstantModel);
    conn.MockManager.Verify;
  finally
    conn.Free;
  end;

end;

procedure TTestMockConnector.TestConnectDisconnect;
var
  conn: TInstantMockConnector;
begin
  conn := TInstantMockConnector.Create(nil);
  try
    conn.BuildDatabase(InstantModel);
    conn.MockManager.StartSetUp;
    conn.MockManager.AddExpectation('InternalConnect');
    conn.MockManager.AddExpectation('InternalDisconnect');
    conn.MockManager.EndSetUp;
    conn.Connect;
    conn.Disconnect;
    conn.MockManager.Verify;
  finally
    conn.Free;
  end;
end;


procedure TTestMockConnector.TestTransaction;
var
  conn: TInstantMockConnector;
begin
  InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx'));
  conn := TInstantMockConnector.Create(nil);
  try
    conn.BuildDatabase(InstantModel);
    conn.Connect;
    conn.MockManager.StartSetUp; //reset expectations
    conn.MockManager.AddExpectation('InternalStartTransaction');
    conn.MockManager.AddExpectation('InternalCommitTransaction');
    conn.MockManager.EndSetUp;
    conn.StartTransaction;
    AssertTrue(conn.InTransaction);
    conn.CommitTransaction;
    AssertFalse(conn.InTransaction);
    conn.MockManager.Verify;
    conn.Disconnect;
  finally
    conn.Free;
  end;
end;

procedure TTestMockConnector.TestDefault;
var
  conn: TInstantMockConnector;
begin
  conn := TInstantMockConnector.Create(nil);
  try
    conn.IsDefault := True;
    AssertSame(InstantDefaultConnector, conn);
  finally
    conn.Free;
  end;
end;



initialization
  RegisterTests([TTestMockConnector]);

end.

--- NEW FILE: TestIO.mdx ---
<TInstantClassMetadatas><TInstantClassMetadata><Name>TAddress</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>State</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>4</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Street</Name><AttributeType>atMemo</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Zip</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>10</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCountry</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPhone</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TEmail</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>100</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCategory</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContact</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atPart</AttributeType><ExternalStoredName>Contact_Address</ExternalStoredName><IsExternal>ceStored</IsExternal><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Phones</Name><AttributeType>atParts</AttributeType><ExternalStoredName>Contact_Phone</ExternalStoredName><IsExternal>ceStored</IsExternal><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPhone</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContactFilter</Name><ParentName>TContact</ParentName><Persistence>peEmbedded</Persistence><AttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPerson</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>BirthDate</Name><AttributeType>atDateTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Emails</Name><AttributeType>atParts</AttributeType><ExternalStoredName>Person_Email</ExternalStoredName><IsExternal>ceStored</IsExternal><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TEmail</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employer</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Picture</Name><AttributeType>atBlob</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Salary</Name><AttributeType>atCurrency</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCompany</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Employees</Name><AttributeType>atReferences</AttributeType><ExternalStoredName>Company_Employee</ExternalStoredName><IsExternal>ceStored</IsExternal><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata></TInstantClassMetadatas>
--- NEW FILE: InstantMock.pas ---
unit InstantMock;

interface

uses
  InstantPersistence, Classes, UbMockObject;

type

  TInstantMockConnector = class(TInstantConnector, IUbMockObject)
  private
    FMock: TUbMockObject;
  protected
    procedure SetMock(const Value: TUbMockObject);
    function CreateBroker: TInstantBroker; override;
    procedure InternalConnect; override;
    function InternalCreateScheme(Model: TInstantModel): TInstantScheme; override;
    procedure InternalDisconnect; override;
    procedure InternalStartTransaction; override;
    procedure InternalCommitTransaction; override;
    procedure InternalRollbackTransaction; override;
  public
    property MockManager: TUbMockObject read FMock write SetMock implements IUbMockObject;
    class function ConnectionDefClass: TInstantConnectionDefClass; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TInstantMockConnectionDef = class(TInstantConnectionDef)
    class function ConnectionTypeName: String; override;
    class function ConnectorClass: TInstantConnectorClass; override;
    function Edit: Boolean; override;
  end;

  TInstantMockBroker = class(TInstantBroker, IUbMockObject)
  private
    FMock: TUbMockObject;
    procedure SetMock(const Value: TUbMockObject);
  protected
    function InternalDisposeObject(AObject: TInstantObject;
      ConflictAction: TInstantConflictAction): Boolean; override;
    function InternalRetrieveObject(AObject: TInstantObject;
      const AObjectId: String;
      ConflictAction: TInstantConflictAction): Boolean;  override;
    function InternalStoreObject(AObject: TInstantObject;
      ConflictAction: TInstantConflictAction): Boolean;  override;
  public
    property MockManager: TUbMockObject read FMock write SetMock implements IUbMockObject;
    constructor Create(AConnector: TInstantConnector); override;
    destructor Destroy; override;
  end;

implementation

{ TMockIConnector }

class function TInstantMockConnector.ConnectionDefClass: TInstantConnectionDefClass;
begin
  result := TInstantMockConnectionDef;
end;

constructor TInstantMockConnector.Create(AOwner: TComponent);
begin
  inherited;
  FMock := TUbMockObject.Create;
end;

function TInstantMockConnector.CreateBroker: TInstantBroker;
begin
  FMock.AddExpectation('CreateBroker');
  Result := TInstantMockBroker.Create(Self);
end;


{ TInstantMockConnectionDef }

class function TInstantMockConnectionDef.ConnectionTypeName: String;
begin
  result := 'Mock';
end;

class function TInstantMockConnectionDef.ConnectorClass: TInstantConnectorClass;
begin
  result := TInstantMockConnector;
end;

function TInstantMockConnectionDef.Edit: Boolean;
begin
  result := True; //boh??
end;


{ TInstantMockBroker }

destructor TInstantMockConnector.Destroy;
begin
  FMock.Free;
  inherited;
end;

procedure TInstantMockConnector.InternalCommitTransaction;
begin
  inherited;
  FMock.AddExpectation('InternalCommitTransaction');
end;

procedure TInstantMockConnector.InternalConnect;
begin
  FMock.AddExpectation('InternalConnect');
end;

function TInstantMockConnector.InternalCreateScheme(
  Model: TInstantModel): TInstantScheme;
begin
  FMock.AddExpectation('InternalCreateScheme');
  result := TInstantScheme.Create(Model);
end;

procedure TInstantMockConnector.InternalDisconnect;
begin
  FMock.AddExpectation('InternalDisconnect');
end;

procedure TInstantMockBroker.SetMock(const Value: TUbMockObject);

begin
  FMock := Value;
end;

constructor TInstantMockBroker.Create(AConnector: TInstantConnector);

begin
  inherited;
  FMock := TUbMockObject.Create;
end;

destructor TInstantMockBroker.Destroy;

begin
  FMock.Free;
  inherited;
end;

{ TInstantMockBroker }

function TInstantMockBroker.InternalDisposeObject(AObject: TInstantObject;
  ConflictAction: TInstantConflictAction): Boolean;
begin
  Result := True;
  FMock.AddExpectation('InternalDisposeObject ' + AObject.Id);
end;

function TInstantMockBroker.InternalRetrieveObject(AObject: TInstantObject;
  const AObjectId: String;
  ConflictAction: TInstantConflictAction): Boolean;
begin
  Result := True;
  FMock.AddExpectation('InternalRetrieveObject ' + AObjectId);
end;

function TInstantMockBroker.InternalStoreObject(AObject: TInstantObject;
  ConflictAction: TInstantConflictAction): Boolean;
begin
  Result := True;
  FMock.AddExpectation('InternalStoreObject ' + AObject.Id);
end;

procedure TInstantMockConnector.InternalRollbackTransaction;
begin
  inherited;
  FMock.AddExpectation('InternalRollbackTransaction');
end;

procedure TInstantMockConnector.InternalStartTransaction;
begin
  inherited;
  FMock.AddExpectation('InternalStartTransaction');
end;

procedure TInstantMockConnector.SetMock(const Value: TUbMockObject);
begin
  FMock := Value;
end;

initialization
  RegisterClass(TInstantMockConnectionDef);
  TInstantMockConnector.RegisterClass;

finalization
  TInstantMockConnector.UnregisterClass;

end.

--- NEW FILE: TestIO.dpr ---
program TestIO;

uses
  Forms,
  TestMockConnector in 'TestMockConnector.pas',
  guitestrunner {TestRunner},
  fpcunit,
  testregistry,
  testutils,
  testreport,
  InstantMock in 'InstantMock.pas',
  TestMockBroker in 'TestMockBroker.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TTestRunner, TestRunner);
  Application.Run;
end.