[Instantobjects-cvscommit] Source/Tests MinimalModel.pas,NONE,1.1 TTestInstantClasses.pas,NONE,1.1 TestIO.dof,NONE,1.1 TestInstantClasses.pas,NONE,1.1 TestInstantPersistence.pas,NONE,1.1 TestInstantRtti.pas,NONE,1.1 TestMinimalModel.pas,NONE,1.1 TestMinimalModelDb.pas,NONE,1.1 TestModelDb.pas,NONE,1.1 TestSimpleModel.pas,NONE,1.1 testcontactdb.pas,NONE,1.1 ttestminimalmodel.pas,NONE,1.1 InstantMock.pas,1.3,1.4 TestIO.dpr,1.2,1.3 TestMockBroker.pas,1.5,1.6 TestMockConnector.pas,1.3,1.4

[Carlo B. <car...@us...>]

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

Modified Files:
	InstantMock.pas TestIO.dpr TestMockBroker.pas 
	TestMockConnector.pas 
Added Files:
	MinimalModel.pas TTestInstantClasses.pas TestIO.dof 
	TestInstantClasses.pas TestInstantPersistence.pas 
	TestInstantRtti.pas TestMinimalModel.pas 
	TestMinimalModelDb.pas TestModelDb.pas TestSimpleModel.pas 
	testcontactdb.pas ttestminimalmodel.pas 
Log Message:
Chanfes for porting to FPC-Lazarus project. Some other little changes to remove uses to forms for non-visual level of IO.

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

interface

implementation

end.

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

interface

uses
  Classes, SysUtils,
  InstantRtti,
  fpcunit,
  MaskUtils,
  testregistry;

type

  { TTestInstantRtti }

  TTestInstantRtti = class(TTestCase)
  published
    procedure TestHexToBin;
    procedure TestInheritsFrom;
    procedure TestMaskUtils;
    procedure TestInstantProperties;
    procedure TestInstantSetProperty;
  end;

  { TGuineaPig }

  TGuineaPig = class;
  TGuineaPigClass = class of TGuineaPig;
  
  TGuineaPig = class(TPersistent)
  private
    FAge: integer;
    FIsMale: Boolean;
    FName: string;
    FWeight: double;
    procedure SetAge(const Value: integer);
    procedure SetIsMale(const AValue: Boolean);
    procedure SetName(const Value: string);
    procedure SetWeight(const Value: double);
  public
    constructor Create;
  published
    property Age: integer read FAge write SetAge;
    property Weight: double read FWeight write SetWeight;
    property PigName: string read FName write SetName;
    property IsMale: Boolean read FIsMale write SetIsMale;
  end;

implementation

uses
  Variants;

{ TTestInstantRtti }

procedure TTestInstantRtti.TestHexToBin;
var
  s, hs: array [0..4] of char;
begin
  s := '  ';
  hs := '    ';
  BinToHex(PChar(@s), PChar(@hs), 2);
  AssertEquals('2020', hs);
  s := '2020';
  hs := 'aa';
  HexToBin(PChar(@s), PChar(@hs), 2);
  AssertEquals('  ', hs);
end;

procedure TTestInstantRtti.TestInheritsFrom;
var
  c: TGuineaPig;
  cc: TGuineaPigClass;
  
  procedure CheckClass(AClass: TGuineaPigClass);
  begin
    AssertTrue(AClass.InheritsFrom(TGuineaPig));
  end;
  
begin
  AssertTrue(TGuineaPig.InheritsFrom(TPersistent));
  AssertFalse(TGuineaPig.InheritsFrom(TTestInstantRtti));
  AssertTrue(TGuineaPig.InheritsFrom(TGuineaPig));
  c := TGuineaPig.Create;
  try
    AssertTrue(c.InheritsFrom(TPersistent));
    AssertFalse(c.InheritsFrom(TTestInstantRtti));
    AssertTrue(c.InheritsFrom(TGuineaPig));
    
    cc := TGuineaPig;
    AssertTrue(cc.InheritsFrom(TPersistent));
    AssertFalse(cc.InheritsFrom(TTestInstantRtti));
    AssertTrue(cc.InheritsFrom(TGuineaPig));

    AssertTrue(c.InheritsFrom(cc));
    AssertTrue(c.ClassType.InheritsFrom(cc));
    AssertTrue(cc.InheritsFrom(cc));

    CheckClass(TGuineaPigClass(c.ClassType));
  finally
    c.Free;
  end;
end;

procedure TTestInstantRtti.TestInstantProperties;
var
  p: TInstantProperties;
  c: TGuineaPig;
  i, t: integer;
begin
  c := TGuineaPig.Create;
  p := TInstantProperties.Create(c);
  try
    AssertEquals(4, p.Count);
    t := -1;
    for i := 0 to p.Count - 1 do
      if p.Names[i] = 'PigName' then
        t := i;
    AssertTrue('t >= 0', t >= 0);
    AssertEquals(c.PigName, VarToStr(p.Values[t]));
  finally
    c.Free;
    p.Free;
  end;
end;

procedure TTestInstantRtti.TestInstantSetProperty;
var
  c: TGuineaPig;
begin
  c := TGuineaPig.Create;
  try
    InstantSetProperty(c, 'PigName', 'croton');
    AssertEquals('croton', c.PigName);
    InstantSetProperty(c, 'IsMale', True);
    AssertEquals(True, c.IsMale);
    InstantSetProperty(c, 'Age', 15);
    AssertEquals(15, c.Age);
    InstantSetProperty(c, 'Weight', 15.758);
    AssertEquals(15.758, c.Weight);
  finally
    c.Free;
  end;
end;

procedure TTestInstantRtti.TestMaskUtils;
var
  ds, ts : string;
begin
  ds := DateSeparator;
  ts := TimeSeparator;

  AssertEquals('123', FormatMaskText('###','1234'));
  AssertEquals('(123)_   -    ', FormatMaskText('(000)_000-0000;0;*','123'));
  AssertEquals('(123)_456-    ', FormatMaskText('(000)_000-0000;0;*','123456'));
  AssertEquals('(123)_456-789 ', FormatMaskText('(000)_000-0000;0;*','123456789'));
  AssertEquals('(123)_456-7890', FormatMaskText('(000)_000-0000;0;*','1234567890'));
  AssertEquals('t_   ', FormatMaskText('t_###','ab'));
  AssertEquals('t_   ', FormatMaskText('t_###','abcd'));
  AssertEquals('t_abc', FormatMaskText('t_LLL;0;*','abc'));

  AssertEquals('(012)345-6789',FormatMaskText('!\(999\)000-0000;0;','0123456789'));
  AssertEquals('(02  ) 1234 5678.1234',FormatMaskText('!\(9999\) 0000 0000\.9999;0;','02  123456781234'));
  AssertEquals('TRM.DNC.55P27.B242.Z',FormatMaskText('>LLL\.LLL\.00L00\.L000\.L;0;','TRMDNC55P27B242Z'));
  AssertEquals('00100',FormatMaskText('00000;0;','00100'));
  AssertEquals('13'+ds+'02'+ds+'95',FormatMaskText('!99/99/00;0;','130295'));
  AssertEquals('13'+ds+'02'+ds+'1995',FormatMaskText('!99/99/\1\900;0;','130295'));
  AssertEquals('13 Gen 1995',FormatMaskText('!99 >L<LL \1\900;0;','13Gen95'));
  AssertEquals('21'+ts+'05'+TimeSeparator+'15',FormatMaskText('!90:00:00;0;','210515'));
  AssertEquals('13'+ts+'45',FormatMaskText('!90:00;0;','1345'));
end;

{ TGuineaPig }

constructor TGuineaPig.Create;
begin
  Age := 2;
  Weight := 1.75;
  PigName := 'miss piggy';
  IsMale := False;
end;

procedure TGuineaPig.SetAge(const Value: integer);
begin
  FAge := Value;
end;

procedure TGuineaPig.SetIsMale(const AValue: Boolean);
begin
  if FIsMale=AValue then exit;
  FIsMale:=AValue;
end;

procedure TGuineaPig.SetName(const Value: string);
begin
  FName := Value;
end;

procedure TGuineaPig.SetWeight(const Value: double);
begin
  FWeight := Value;
end;

initialization
  RegisterTests([TTestInstantRtti]);

end.

--- NEW FILE: ttestminimalmodel.pas ---
unit TTestMinimalModel;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fpcunit, InstantMock;

type

  { TTestSimpleModel }

  TTestMinimalModel = class(TTestCase)
  protected
    FConn: TInstantMockConnector;
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCreateModelMdx;
    procedure TestStoreSimpleClass;
    procedure TestRetrieveSimpleClass;
  end;

implementation

uses
  InstantPersistence, testregistry, MinimalModel;

{ TTestMinimalModel }

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

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

procedure TTestMinimalModel.TestCreateModelMdx;
var
  InstantClassMetadata : TInstantClassMetadata;
  InstantAttributeMetadata : TInstantAttributeMetadata;
begin
//codice da  CreateMinimalModel;
  InstantModel.ClassMetadatas.Create(InstantModel);
  AssertNotNull('!',InstantModel);
  InstantClassMetadata := InstantModel.ClassMetadatas.Add;
  AssertNotNull('!!',InstantClassMetadata);
  InstantClassMetadata.Name := 'TSimpleClass';
  InstantClassMetadata.Persistence := peStored;
  InstantClassMetadata.StorageName := 'SIMPLE';
  InstantAttributeMetadata := InstantClassMetadata.AttributeMetadatas.Add;
  AssertNotNull('!!!',InstantAttributeMetadata);
  InstantAttributeMetadata.Name := 'StringProperty';
  InstantAttributeMetadata.AttributeType := atString;
  InstantAttributeMetadata.IsIndexed := FALSE;
  InstantAttributeMetadata.IsRequired := FALSE;
  InstantAttributeMetadata.Size := 10;
  InstantAttributeMetadata.StorageName := 'STRING';


  AssertNotNull('1',InstantModel);
  AssertNotNull('11',InstantModel.ClassMetadatas);
  AssertNotNull('111',InstantModel.ClassMetadatas.Find('TSimpleClass'));
end;

procedure TTestMinimalModel.TestStoreSimpleClass;
var
  conn: TInstantMockConnector;
  i: integer;
  SimpleClass : TSimpleClass;
begin
  CreateMinimalModel;
  conn := TInstantMockConnector.Create(nil);
  conn.IsDefault := True;
  conn.BrokerClass := TInstantMockBroker;
  conn.Connect;
  for i := 0 to 100 do
  begin
    SimpleClass := TSimpleClass.Create;
    try
      SimpleClass.StringProperty := IntToStr(Random(MaxInt));
      SimpleClass.Store;
      AssertTrue('Id ' + SimpleClass.Id, SimpleClass.Id <> '');
    finally
      SimpleClass.Free;
    end;
  end;
end;

procedure TTestMinimalModel.TestRetrieveSimpleClass;
var
  conn: TInstantMockConnector;
  i: integer;
  SimpleClass : TSimpleClass;
  Id : string;
begin
  CreateMinimalModel;
  conn := TInstantMockConnector.Create(nil);
  conn.IsDefault := True;
  conn.BrokerClass := TInstantMockBroker;
  conn.Connect;
  Id := '';
  for i := 0 to 100 do
  begin
    SimpleClass := TSimpleClass.Create;
    try
      SimpleClass.StringProperty := IntToStr(Random(MaxInt));
      SimpleClass.Store;
      Id := SimpleClass.Id;
    finally
      SimpleClass.Free;
    end;

    SimpleClass := TSimpleClass.Create;
    try
      SimpleClass.StringProperty := IntToStr(Random(MaxInt));
      SimpleClass.Retrieve(Id);
      AssertEquals(Id, SimpleClass.Id);
    finally
      SimpleClass.Free;
    end;
  end;
end;

(*
program IOMinimal;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Model in 'Model.pas',
  InstantPersistence;
  //,InstantUIBConnection, InstantUIB;

//{$R *.mdr} {Model}

var
  ApplicationPath : string;
  Connection : TInstantUIBConnection;
  Connector : TInstantUIBConnector;
  SimpleClass : TSimpleClass;
  Id : string;
  i : integer;
begin
  ApplicationPath := ExtractFilePath(ParamStr(0));
  Try
//    InstantModel.LoadFromFile(ApplicationPath+'MinimalModel.xml');
    CreateInstantModel;

    //Connect to database
    Connection := nil;
    Connector := nil;
    Try
      Connection := TInstantUIBConnection.Create(nil);
      Connection.Database.DatabaseName := ApplicationPath+'MINIMAL.FDB';
      Connection.Database.UserName := 'SYSDBA';
      Connection.Database.Password := 'a';
      Connector := TInstantUIBConnector.Create(nil);
      Connector.Connection := Connection;
      Connector.LoginPrompt := False;
      Connector.IsDefault := True;
      WriteLn('Connecting to Database.');
      Connector.Connect;

      for i := 0 to 100 do
      begin
        WriteLn('Storing Object.');
        SimpleClass := TSimpleClass.Create;
        Try
          SimpleClass.StringProperty := IntToStr(Random(MaxInt));
          SimpleClass.Store;
          Id := SimpleClass.Id;
        Finally
          SimpleClass.Free;
        End;

        WriteLn('Retrieving and changing Object.');
        SimpleClass := TSimpleClass.Retrieve(Id);
        Try
          SimpleClass.StringProperty := IntToStr(Random(MaxInt));
          SimpleClass.Store;
        Finally
          SimpleClass.Free;
        End;

        WriteLn('Retrieving and deleting Object.');
        SimpleClass := TSimpleClass.Retrieve(Id);
        Try
          SimpleClass.Dispose;
        Finally
          SimpleClass.Free;
        End;
      end;

      WriteLn('Disconnecting from Database.');
      Connector.Disconnect;
    Finally
      Connector.Free;
      Connection.Free;
    End;
    WriteLn('Done!');
  Except
    on E: Exception do WriteLn(E.Message);
  End;
end.

*)


initialization
  RegisterTests([TTestMinimalModel]);

end.



Index: InstantMock.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/InstantMock.pas,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** InstantMock.pas	26 Feb 2005 16:43:04 -0000	1.3
--- InstantMock.pas	2 May 2005 23:26:33 -0000	1.4
***************
*** 4,8 ****
  
  uses
!   InstantPersistence, Classes, UbMockObject;
  
  type
--- 4,8 ----
  
  uses
!   SysUtils, InstantPersistence, Classes, UbMockObject;
  
  type
***************
*** 101,104 ****
--- 101,106 ----
  function TInstantMockConnector.CreateBroker: TInstantBroker;
  begin
+   if not Assigned(FBrokerClass) then
+      raise  Exception.Create('Undefined BrokerClass');
    FMock.AddExpectation('CreateBroker ' + FBrokerClass.ClassName);
    Result := FBrokerClass.Create(Self);
***************
*** 235,238 ****
--- 237,241 ----
  begin
    MockManager.AddExpectation('EnsureResolver');
+   Result := nil;
  end;
  

--- NEW FILE: testcontactdb.pas ---
unit TestContactDb;

{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}

interface

uses
  Classes, SysUtils, fpcunit, testregistry,
  InstantUIBConnection, InstantUIB;

type

  { TestMinimalModelUIB }

  TTestContactModelUIB=class(TTestCase)
  private
    _ApplicationPath : string;
    _Connection: TInstantUIBConnection;
    _Connector: TInstantUIBConnector;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAll;
    procedure TestConnected;
    procedure TestStoring;
  end; 

implementation

uses
  Model;

procedure TTestContactModelUIB.SetUp;
begin
  InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx'));
  //Connect to database
  _Connection := nil;
  _Connector := nil;
  _Connection := TInstantUIBConnection.Create(nil);
  _Connection.Database.DatabaseName :=  ChangeFileExt(ParamStr(0),'.FDB');
  _Connection.Database.UserName := 'SYSDBA';
  _Connection.Database.Password := 'a';
  _Connector := TInstantUIBConnector.Create(nil);
  _Connector.Connection := _Connection;
  _Connector.LoginPrompt := False;
  _Connector.IsDefault := True;
  _Connector.Connect;
end;

procedure TTestContactModelUIB.TearDown;
begin
  if assigned(_Connector) and _Connector.Connected then
    _Connector.Disconnect;
  FreeAndNil(_Connector); //libera anche il connector
//  FreeAndNil(_Connection); //libera anche il connector
end;

procedure TTestContactModelUIB.TestAll;
var
  c: TContact;
  t: TPhone;
  SimpleClass : TSimpleClass;
  Id : string;
  i : integer;
  s: string;
begin
  for i := 0 to 10 do
  begin
    c := TContact.Create;
    try
      c.Name := 'Mike';
      c.Address.City := 'Milan';
      t := TPhone.Create;
      t.Name := 'Home';
      t.Number := '012 12345678';
      c.AddPhone(t);
      AssertEquals(1, c.PhoneCount);

      t := TPhone.Create;
      t.Name := 'Office';
      t.Number := '012 23456781';
      c.AddPhone(t);
      AssertEquals(2, c.PhoneCount);
      c.Store();
      old_id := c.id;
    finally
      FreeAndNil(c);
    end;
    AssertNull(c);

    c := TContact.Retrieve(old_id);
    try
      AssertEquals(old_id, c.Id);
      AssertNotNull(c.Address);
      AssertEquals(2, c.PhoneCount);
    finally
      FreeAndNil(c);
    end;

  
// Storing Object.
    SimpleClass := TSimpleClass.Create;
    Try
      AssertEquals('', SimpleClass.Id);
      SimpleClass.StringProperty := IntToStr(Random(MaxInt));
      s := SimpleClass.StringProperty;
      SimpleClass.Store;
      Id := SimpleClass.Id;
    Finally
      SimpleClass.Free;
    End;

// Retrieving and changing Object.
    SimpleClass := TSimpleClass.Retrieve(Id);
    Try
      AssertEquals(s, SimpleClass.StringProperty);
      SimpleClass.StringProperty := IntToStr(Random(MaxInt));
      s := SimpleClass.StringProperty;
      SimpleClass.Store;
    Finally
      SimpleClass.Free;
    End;

// Retrieving and deleting Object.
    SimpleClass := TSimpleClass.Retrieve(Id);
    Try
      AssertEquals(s, SimpleClass.StringProperty);
      SimpleClass.Dispose;
    Finally
      SimpleClass.Free;
    End;


// Trying to retrive deleted object
    SimpleClass := nil; 
    SimpleClass := TSimpleClass.Retrieve(Id);
    AssertNull(SimpleClass);

  end;
end;

procedure TTestContactModelUIB.TestConnected;
begin
  AssertTrue(_Connector.Connected);
  _Connector.Disconnect;
  AssertFalse(_Connector.Connected);
end;

procedure TTestContactModelUIB.TestStoring;
var
  Id: string;
  i: integer;
  SimpleClass: TSimpleClass;
begin
  Id := '';
  for i := 0 to 10 do
  begin
    SimpleClass := TSimpleClass.Create;
    try
      SimpleClass.StringProperty := IntToStr(Random(MaxInt));
      SimpleClass.Store;
      AssertFalse(Id = SimpleClass.Id); //different from previous one
      Id := SimpleClass.Id;
    finally
      SimpleClass.Free;
    end;
  end;
end;

initialization

  RegisterTest(TTestContactModelUIB);
end.


Index: TestMockBroker.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestMockBroker.pas,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** TestMockBroker.pas	26 Feb 2005 16:43:04 -0000	1.5
--- TestMockBroker.pas	2 May 2005 23:26:33 -0000	1.6
***************
*** 5,9 ****
  uses
    Classes, SysUtils, InstantPersistence, fpcunit, testregistry, InstantMock,
!   UbMockObject, Model;
  
  type
--- 5,9 ----
  uses
    Classes, SysUtils, InstantPersistence, fpcunit, testregistry, InstantMock,
!   Model;
  
  type
***************
*** 30,33 ****
--- 30,34 ----
      procedure TestGetBroker;
      procedure TestStoreAndRetrieveContact;
+     procedure TestParts;
    end;
  
***************
*** 98,102 ****
      AssertEquals(old_id, a.Id);
    finally
!     a.Free;
    end;
    brok.MockManager.EndSetUp;
--- 99,103 ----
      AssertEquals(old_id, a.Id);
    finally
!     FreeAndNil(a);
    end;
    brok.MockManager.EndSetUp;
***************
*** 146,149 ****
--- 147,171 ----
  end;
  
+ procedure TTestMockRelationalBroker.TestParts;
+ var
+   c: TContact;
+   t: TPhone;
+ begin
+   InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx'));
+   Fconn.IsDefault := True;
+   c := TContact.Create;
+   try
+     AssertNotNull(c._Phones);
+     AssertEquals(0, c.PhoneCount);
+     t := TPhone.Create;
+     t.Name := 'Home';
+     t.Number := '012 12345678';
+     c.AddPhone(t);
+     AssertEquals(1, c.PhoneCount);
+   finally
+     c.Free;
+   end;
+ end;
+ 
  procedure TTestMockRelationalBroker.TestStoreAndRetrieveContact;
  var
***************
*** 154,160 ****
--- 176,184 ----
  begin
    InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx'));
+ 
    Fconn.IsDefault := True;
    brok := Fconn.Broker as TInstantMockCRBroker;
    brok.MockManager.StartSetUp;
+ 
    c := TContact.Create;
    try
***************
*** 165,168 ****
--- 189,194 ----
      t.Number := '012 12345678';
      c.AddPhone(t);
+     AssertEquals(1, c.PhoneCount);
+ 
      t := TPhone.Create;
      t.Name := 'Office';
***************
*** 188,192 ****
      AssertEquals(0, c.PhoneCount); //mock brocker cannot collect part and parts
    finally
!     c.Free;
    end;
    brok.MockManager.Verify;
--- 214,218 ----
      AssertEquals(0, c.PhoneCount); //mock brocker cannot collect part and parts
    finally
!     FreeAndNil(c);
    end;
    brok.MockManager.Verify;
***************
*** 196,198 ****
    RegisterTests([TTestMockBroker, TTestMockRelationalBroker]);
  
! end.
\ No newline at end of file
--- 222,224 ----
    RegisterTests([TTestMockBroker, TTestMockRelationalBroker]);
  
! end.

--- NEW FILE: TestIO.dof ---
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=1
UnsafeCode=1
UnsafeCast=1
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=D:\lazarus\components\fpcunit\ubmock\src
Packages=
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1040
CodePage=1252

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

{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}

interface

uses
  Classes, SysUtils, fpcunit, testregistry,
  InstantPersistence, Model,
  InstantUIBConnection, InstantUIB, InstantXML;

type

  { TTestModel }
  TTestModel=class(TTestCase)
  private
    _Connector : TInstantConnector;
    function GetApplicationPath: string;
    function CreateContact : TContact;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
    function CreateConnector : TInstantConnector; virtual; abstract;
  public
    property ApplicationPath : string read GetApplicationPath;
  published
    procedure TestAll;
    procedure TestConnected;
    procedure TestStoring;
    procedure TestselectAll;
  end;

  { TTestModelUIB }
  TTestModelUIB=class(TTestModel)
  private
    _Connection: TInstantUIBConnection;
  protected
    function CreateConnector : TInstantConnector; override;
  end;

  { TTestModelXML }
  TTestModelXML=class(TTestModel)
  private
    _Connection: TXMLFilesAccessor;
  protected
    function CreateConnector : TInstantConnector; override;
  end;

implementation

uses
  InstantClasses;

function TTestModel.CreateContact: TContact;
var
  t: TPhone;
begin
  Result := TContact.Create;
  try
//      AssertEquals('', Result.Id); why Id is yet defined?
    Result.Name := 'Mike';
    Result.Address.City := 'Milan';
    t := TPhone.Create;
    t.Name := 'Home';
    t.Number := '012 12345678';
    Result.AddPhone(t);
    AssertEquals(1, Result.PhoneCount);

    t := TPhone.Create;
    t.Name := 'Office';
    t.Number := '012 23456781';
    Result.AddPhone(t);
    AssertEquals(2, Result.PhoneCount);
  except
    FreeAndNil(Result);
  end;
end;

function TTestModel.GetApplicationPath: string;
begin
  Result := ExtractFilePath(ParamStr(0));
end;

procedure TTestModel.SetUp;
begin
  InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx'));
  //Connect to database
  _Connector := CreateConnector;
  _Connector.BlobStreamFormat := sfXml;
  _Connector.IsDefault := True;
//  _Connector.BuildDatabase(InstantModel);
  _Connector.Connect;
end;

procedure TTestModel.TearDown;
begin
  if assigned(_Connector) and _Connector.Connected then
    _Connector.Disconnect;
  FreeAndNil(_Connector);  //free the connection too
end;

procedure TTestModel.TestAll;
var
  c: TContact;
  id, old_id: string;
  i : integer;
  s: string;
  t : TPhone;
begin
  old_id := '';
  for i := 0 to 10 do
  begin
    c := CreateContact;
    try
      c.Store;
      id := c.id;
      AssertFalse(old_id = id);
      old_id := id; //different from previous one
    finally
      FreeAndNil(c);
    end;
    AssertNull(c);

    c := TContact.Retrieve(id);
    try
      AssertEquals(id, c.Id);
      AssertNotNull(c.Address);
      AssertEquals('Milan', c.Address.City);
      AssertEquals(2, c.PhoneCount);
      AssertEquals('012 12345678', c.MainPhoneNumber);
      c.Phones[0].Number := '012 12345679';
      c.Address.City := 'Rome';
      t := TPhone.Create;
      t.Name := 'Mobile';
      t.Number := '333-445556666';
      c.AddPhone(t);
      AssertEquals(3, c.PhoneCount);
      c.Store();
    finally
      FreeAndNil(c);
    end;
    AssertNull(c);

// Retrieving and deleting Object.
    c := TContact.Retrieve(id);
    try
      AssertEquals('Rome', c.Address.City);
      AssertEquals(3, c.PhoneCount);
      c.Dispose;
    finally
      FreeAndNil(c);
    end;
    AssertNull(c);

// Trying to retrieve deleted object
    c := TContact.Retrieve(id);
    AssertNull(c);
  end;
end;

procedure TTestModel.TestConnected;
begin
  AssertTrue(_Connector.Connected);
  _Connector.Disconnect;
  AssertFalse(_Connector.Connected);
end;

function TTestModelUIB.CreateConnector : TInstantConnector;
var
  Connector : TInstantUIBConnector;
begin
  //Connect to database
  _Connection := TInstantUIBConnection.Create(nil);
  _Connection.Database.DatabaseName :=  ChangeFileExt(ParamStr(0),'.FDB');
  _Connection.Database.UserName := 'SYSDBA';
  _Connection.Database.Password := 'a';
  Connector := TInstantUIBConnector.Create(nil);
  Connector.Connection := _Connection;
  Connector.LoginPrompt := False;
  Result := Connector;
end;

{ TTestModelXML }

function TTestModelXML.CreateConnector: TInstantConnector;
var
  Connector : TInstantXMLConnector;
begin
  _Connection :=  TXMLFilesAccessor.Create(nil);
  _Connection.RootFolder :=  ApplicationPath + 'XMLModel'+PathDelim;
//  _Connection.XMLFileFormat := xffIso;
  Connector := TInstantXMLConnector.Create(nil);
  Connector.Connection := _Connection;
  Connector.BuildDatabase;
  Result := Connector;
end;

procedure TTestModel.TestselectAll;
var
  InstantQuery : TInstantQuery;
  IO, IO2 : TInstantObject;
  Id : string;
  I : integer;
begin
  InstantQuery := _Connector.CreateQuery;
  Try
    InstantQuery.Command := 'SELECT * FROM ANY TContact';
    InstantQuery.Open;
    Try
      for i := 0 to InstantQuery.ObjectCount-1 do
      begin
        IO := InstantQuery.Objects[i] as TInstantObject;
        AssertEquals(IO.RefCount,1);
        IO2 := TContact.Retrieve(IO.Id);
        Try
          AssertEquals(IO.RefCount,2);
        Finally
          IO2.Free;
        End;
        AssertEquals(IO.RefCount,1);
      end;
    Finally
      Instantquery.Close;
    End;
  Finally
    InstantQuery.Free;
  End;
end;

procedure TTestModel.TestStoring;
var
  i : integer;
  c : TContact;
  old_id, id : string;
begin
  old_id := '';
  for i := 0 to 10 do
  begin
    c := CreateContact;
    try
      c.Store;
      id := c.id;
      AssertFalse(old_id = id);
      old_id := id; //different from previous one
    finally
      FreeAndNil(c);
    end;
    AssertNull(c);
  end;
end;

initialization

  RegisterTest(TTestModelUIB);
  RegisterTest(TTestModelXML);
end.


Index: TestIO.dpr
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestIO.dpr,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** TestIO.dpr	22 Feb 2005 11:43:43 -0000	1.2
--- TestIO.dpr	2 May 2005 23:26:33 -0000	1.3
***************
*** 1,8 ****
  program TestIO;
  
  uses
!   Forms,
!   TestMockConnector in 'TestMockConnector.pas',
!   guitestrunner {TestRunner},
    fpcunit,
    testregistry,
--- 1,12 ----
  program TestIO;
  
+ {$IFDEF FPC}
+ {$mode objfpc}{$H+}
+ {$ENDIF}
+ 
  uses
! {$IFDEF FPC}  Interfaces,
! {$ENDIF}
!   Forms, GuiTestRunner,
    fpcunit,
    testregistry,
***************
*** 10,14 ****
    testreport,
    InstantMock in 'InstantMock.pas',
!   TestMockBroker in 'TestMockBroker.pas';
  
  {$R *.res}
--- 14,25 ----
    testreport,
    InstantMock in 'InstantMock.pas',
!   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}
***************
*** 16,20 ****
  begin
    Application.Initialize;
!   Application.CreateForm(TTestRunner, TestRunner);
    Application.Run;
  end.
--- 27,31 ----
  begin
    Application.Initialize;
!   Application.CreateForm(TGUITestRunner, TestRunner);
    Application.Run;
  end.

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

interface

uses
  Classes, SysUtils,
  InstantPersistence,
  fpcunit,
  testregistry;

type

  { TTestInstantPersistence }

  TTestInstantPersistence = class(TTestCase)
  published
    procedure TestMetadatas;
    procedure TestInstantAttributeMetadatas;
    procedure TestInstantFieldMetadatas;
    procedure TestInstantString;
  end;

implementation


{ TTestInstantPersistence }

procedure TTestInstantPersistence.TestMetadatas;
var
  i: TInstantMetadata;
  c: TInstantMetadatas;
begin
  c := TInstantMetadatas.Create(nil, TInstantMetadata);
  AssertNotNull(c);
  AssertEquals(0, c.Count);
  i := c.add as TInstantMetadata;
  AssertEquals(1, c.Count);
  i.Name := 'pippo';
  AssertTrue(i = c.Find('pippo'));
  AssertTrue(i.Collection = c);
end;

procedure TTestInstantPersistence.TestInstantAttributeMetadatas;
var
  i: TInstantAttributeMetadata;
  c: TInstantAttributeMetadatas;
begin
  c := TInstantAttributeMetadatas.Create(nil);
  AssertNotNull(c);
  AssertEquals(0, c.Count);
  i := c.add;
  AssertEquals(1, c.Count);
  i.Name := 'pippo';
  i.DefaultValue := '1';
  AssertTrue(i = c.Find('pippo'));
  AssertTrue(i.Collection = c);
  AssertEquals('1', i.DefaultValue);
end;

procedure TTestInstantPersistence.TestInstantFieldMetadatas;
var
  i: TInstantFieldMetadata;
  c: TInstantFieldMetadatas;
begin
  c := TInstantFieldMetadatas.Create(nil);
  AssertNotNull(c);
  AssertEquals(0, c.Count);
  i := c.add;
  AssertEquals(1, c.Count);
  i.Name := 'pippo';
  AssertTrue(i = c.Find('pippo'));
  AssertTrue(i.Collection = c);
end;

procedure TTestInstantPersistence.TestInstantString;
var
  c: TInstantString;
begin
  c := TInstantString.Create();
  try
    AssertFalse(c.IsChanged);
    c.AsString := 'goofy';
    AssertTrue(c.IsChanged);
  finally
    c.Free;
  end;
end;


initialization
  RegisterTests([TTestInstantPersistence]);

end.

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

{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}

interface

uses
  Classes, SysUtils, fpcunit, InstantMock;

type


  { TTestSimpleModel }

  TTestMinimalModel = class(TTestCase)
  protected
    FConn: TInstantMockConnector;
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCreateModelMdx;
    procedure TestSaveModelMdx;
    procedure TestRestoreModelMdx;
    procedure TestStoreSimpleClass;
    procedure TestRetrieveSimpleClass;
  end;

implementation

uses
  InstantPersistence, testregistry, MinimalModel, InstantClasses;

{ TTestMinimalModel }

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

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

procedure TTestMinimalModel.TestCreateModelMdx;
var
  InstantClassMetadata : TInstantClassMetadata;
  InstantAttributeMetadata : TInstantAttributeMetadata;
begin
//code from CreateMinimalModel;
  InstantModel.ClassMetadatas.Create(InstantModel);

  AssertNotNull('InstantModel',InstantModel);
  AssertNotNull('ClassMetadatas',InstantModel.ClassMetadatas);
  InstantClassMetadata := InstantModel.ClassMetadatas.Add;
  AssertNotNull('InstantClassMetadata',InstantClassMetadata);

  InstantClassMetadata.Name := 'TSimpleClass';
  InstantClassMetadata.Persistence := peStored;
  InstantClassMetadata.StorageName := 'SIMPLE';
  InstantAttributeMetadata := InstantClassMetadata.AttributeMetadatas.Add;
  AssertNotNull('InstantAttributeMetadata',InstantAttributeMetadata);

  InstantAttributeMetadata.Name := 'StringProperty';
  InstantAttributeMetadata.AttributeType := atString;
  InstantAttributeMetadata.IsIndexed := FALSE;
  InstantAttributeMetadata.IsRequired := FALSE;
  InstantAttributeMetadata.Size := 10;
  InstantAttributeMetadata.StorageName := 'STRING';

  AssertNotNull('ClassMetadatas.Find',InstantModel.ClassMetadatas.Find('TSimpleClass'));
end;

procedure TTestMinimalModel.TestSaveModelMdx;
var
  Stream: TStringStream;
  s, r: string;
begin
  CreateMinimalModel;
{$IFNDEF FPC}
//delphi and fpc differs only in property order
  r := '<TInstantClassMetadatas><TInstantClassMetadata><Name>TSimpleClass</Name>';
  r := r + '<Persistence>peStored</Persistence><StorageName>SIMPLE</StorageName>';
  r := r + '<AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata>';
  r := r + '<Name>StringProperty</Name><AttributeType>atString</AttributeType>';
  r := r + '<IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>10</Size>';
  r := r + '<StorageName>STRING</StorageName></TInstantAttributeMetadata>';
  r := r + '</TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata></TInstantClassMetadatas>';
{$ELSE}
  r := '<TInstantClassMetadatas><TInstantClassMetadata><Persistence>peStored</Persistence>';
  r := r + '<StorageName>SIMPLE</StorageName><Name>TSimpleClass</Name><AttributeMetadatas>';
  r := r + '<TInstantAttributeMetadatas><TInstantAttributeMetadata><AttributeType>atString</AttributeType>';
  r := r + '<ClassMetadata.Persistence>peStored</ClassMetadata.Persistence>';
  r := r + '<ClassMetadata.StorageName>SIMPLE</ClassMetadata.StorageName>';
  r := r + '<ClassMetadata.Name>TSimpleClass</ClassMetadata.Name><Size>10</Size>';
  r := r + '<StorageName>STRING</StorageName><Name>StringProperty</Name></TInstantAttributeMetadata>';
  r := r + '</TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata></TInstantClassMetadatas>';
{$ENDIF}
  s := '';
  Stream := TStringStream.Create(s);
  try
    InstantWriteObject(Stream, sfXML, InstantModel.ClassMetadatas);
    AssertEquals(r, Stream.DataString);
  finally
    Stream.Free;
  end;
end;

procedure TTestMinimalModel.TestRestoreModelMdx;
var
  Stream: TStringStream;
  s: string;
begin
  CreateMinimalModel;
  s := '';
  Stream := TStringStream.Create(s);
  try
    InstantWriteObject(Stream, sfXML, InstantModel.ClassMetadatas);
    Stream.Position := 0;
    InstantModel.ClassMetadatas.Clear;
    AssertEquals(0, InstantModel.ClassMetadatas.Count);

    InstantReadObject(Stream, sfXML, InstantModel.ClassMetadatas);
    AssertEquals(1, InstantModel.ClassMetadatas.Count);
    AssertNotNull('ClassMetadatas.Find',InstantModel.ClassMetadatas.Find('TSimpleClass'));
  finally
    Stream.Free;
  end;
end;

procedure TTestMinimalModel.TestStoreSimpleClass;
var
  conn: TInstantMockConnector;
  i: integer;
  SimpleClass : TSimpleClass;
begin
  CreateMinimalModel;
  conn := TInstantMockConnector.Create(nil);
  conn.IsDefault := True;
  conn.BrokerClass := TInstantMockBroker;
  conn.Connect;
  for i := 0 to 100 do
  begin
    SimpleClass := TSimpleClass.Create;
    try
      SimpleClass.StringProperty := IntToStr(Random(MaxInt));
      SimpleClass.Store;
      AssertTrue('Id ' + SimpleClass.Id, SimpleClass.Id <> '');
    finally
      SimpleClass.Free;
    end;
  end;
end;

procedure TTestMinimalModel.TestRetrieveSimpleClass;
var
  conn: TInstantMockConnector;
  i: integer;
  SimpleClass : TSimpleClass;
  Id : string;
begin
  CreateMinimalModel;
  conn := TInstantMockConnector.Create(nil);
  conn.IsDefault := True;
  conn.BrokerClass := TInstantMockBroker;
  conn.Connect;
  Id := '';
  for i := 0 to 100 do
  begin
    SimpleClass := TSimpleClass.Create;
    try
      SimpleClass.StringProperty := IntToStr(Random(MaxInt));
      SimpleClass.Store;
      Id := SimpleClass.Id;
    finally
      SimpleClass.Free;
    end;

    SimpleClass := TSimpleClass.Create;
    try
      SimpleClass.StringProperty := IntToStr(Random(MaxInt));
      SimpleClass.Retrieve(Id);
      AssertEquals(Id, SimpleClass.Id);
    finally
      SimpleClass.Free;
    end;
  end;
end;

(*
program IOMinimal;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Model in 'Model.pas',
  InstantPersistence;
  //,InstantUIBConnection, InstantUIB;

//{$R *.mdr} {Model}

var
  ApplicationPath : string;
  Connection : TInstantUIBConnection;
  Connector : TInstantUIBConnector;
  SimpleClass : TSimpleClass;
  Id : string;
  i : integer;
begin
  ApplicationPath := ExtractFilePath(ParamStr(0));
  Try
//    InstantModel.LoadFromFile(ApplicationPath+'MinimalModel.xml');
    CreateInstantModel;

    //Connect to database
    Connection := nil;
    Connector := nil;
    Try
      Connection := TInstantUIBConnection.Create(nil);
      Connection.Database.DatabaseName := ApplicationPath+'MINIMAL.FDB';
      Connection.Database.UserName := 'SYSDBA';
      Connection.Database.Password := 'a';
      Connector := TInstantUIBConnector.Create(nil);
      Connector.Connection := Connection;
      Connector.LoginPrompt := False;
      Connector.IsDefault := True;
      WriteLn('Connecting to Database.');
      Connector.Connect;

      for i := 0 to 100 do
      begin
        WriteLn('Storing Object.');
        SimpleClass := TSimpleClass.Create;
        Try
          SimpleClass.StringProperty := IntToStr(Random(MaxInt));
          SimpleClass.Store;
          Id := SimpleClass.Id;
        Finally
          SimpleClass.Free;
        End;

        WriteLn('Retrieving and changing Object.');
        SimpleClass := TSimpleClass.Retrieve(Id);
        Try
          SimpleClass.StringProperty := IntToStr(Random(MaxInt));
          SimpleClass.Store;
        Finally
          SimpleClass.Free;
        End;

        WriteLn('Retrieving and deleting Object.');
        SimpleClass := TSimpleClass.Retrieve(Id);
        Try
          SimpleClass.Dispose;
        Finally
          SimpleClass.Free;
        End;
      end;

      WriteLn('Disconnecting from Database.');
      Connector.Disconnect;
    Finally
      Connector.Free;
      Connection.Free;
    End;
    WriteLn('Done!');
  Except
    on E: Exception do WriteLn(E.Message);
  End;
end.

*)


initialization
  RegisterTests([TTestMinimalModel]);

end.



Index: TestMockConnector.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestMockConnector.pas,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** TestMockConnector.pas	26 Feb 2005 16:43:04 -0000	1.3
--- TestMockConnector.pas	2 May 2005 23:26:34 -0000	1.4
***************
*** 8,13 ****
    fpcunit,
    testregistry,
!   InstantMock,
!   UbMockObject;
  
  type
--- 8,12 ----
    fpcunit,
    testregistry,
!   InstantMock;
  
  type

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

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fpcunit, InstantMock;

type

  { TTestSimpleModel }

  TTestMinimalModel = class(TTestCase)
  protected
    FConn: TInstantMockConnector;
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCreateModelMdx;
    procedure TestStoreSimpleClass;
    procedure TestRetrieveSimpleClass;
  end;

implementation

uses
  InstantPersistence, testregistry, MinimalModel;

{ TTestMinimalModel }

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

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

procedure TTestMinimalModel.TestCreateModelMdx;
var
  InstantClassMetadata : TInstantClassMetadata;
  InstantAttributeMetadata : TInstantAttributeMetadata;
begin
//codice da  CreateMinimalModel;
  InstantModel.ClassMetadatas.Create(InstantModel);
  AssertNotNull('!',InstantModel);
  InstantClassMetadata := InstantModel.ClassMetadatas.Add;
  AssertNotNull('!!',InstantClassMetadata);
  InstantClassMetadata.Name := 'TSimpleClass';
  InstantClassMetadata.Persistence := peStored;
  InstantClassMetadata.StorageName := 'SIMPLE';
  InstantAttributeMetadata := InstantClassMetadata.AttributeMetadatas.Add;
  AssertNotNull('!!!',InstantAttributeMetadata);
  InstantAttributeMetadata.Name := 'StringProperty';
  InstantAttributeMetadata.AttributeType := atString;
  InstantAttributeMetadata.IsIndexed := FALSE;
  InstantAttributeMetadata.IsRequired := FALSE;
  InstantAttributeMetadata.Size := 10;
  InstantAttributeMetadata.StorageName := 'STRING';


  AssertNotNull('1',InstantModel);
  AssertNotNull('11',InstantModel.ClassMetadatas);
  AssertNotNull('111',InstantModel.ClassMetadatas.Find('TSimpleClass'));
end;

procedure TTestMinimalModel.TestStoreSimpleClass;
var
  conn: TInstantMockConnector;
  i: integer;
  SimpleClass : TSimpleClass;
begin
  CreateMinimalModel;
  conn := TInstantMockConnector.Create(nil);
  conn.IsDefault := True;
  conn.BrokerClass := TInstantMockBroker;
  conn.Connect;
  for i := 0 to 100 do
  begin
    SimpleClass := TSimpleClass.Create;
    try
      SimpleClass.StringProperty := IntToStr(Random(MaxInt));
      SimpleClass.Store;
      AssertTrue('Id ' + SimpleClass.Id, SimpleClass.Id <> '');
    finally
      SimpleClass.Free;
    end;
  end;
end;

procedure TTestMinimalModel.TestRetrieveSimpleClass;
var
  conn: TInstantMockConnector;
  i: integer;
  SimpleClass : TSimpleClass;
  Id : string;
begin
  CreateMinimalModel;
  conn := TInstantMockConnector.Create(nil);
  conn.IsDefault := True;
  conn.BrokerClass := TInstantMockBroker;
  conn.Connect;
  Id := '';
  for i := 0 to 100 do
  begin
    SimpleClass := TSimpleClass.Create;
    try
      SimpleClass.StringProperty := IntToStr(Random(MaxInt));
      SimpleClass.Store;
      Id := SimpleClass.Id;
    finally
      SimpleClass.Free;
    end;

    SimpleClass := TSimpleClass.Create;
    try
      SimpleClass.StringProperty := IntToStr(Random(MaxInt));
      SimpleClass.Retrieve(Id);
      AssertEquals(Id, SimpleClass.Id);
    finally
      SimpleClass.Free;
    end;
  end;
end;

(*
program IOMinimal;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Model in 'Model.pas',
  InstantPersistence;
  //,InstantUIBConnection, InstantUIB;

//{$R *.mdr} {Model}

var
  ApplicationPath : string;
  Connection : TInstantUIBConnection;
  Connector : TInstantUIBConnector;
  SimpleClass : TSimpleClass;
  Id : string;
  i : integer;
begin
  ApplicationPath := ExtractFilePath(ParamStr(0));
  Try
//    InstantModel.LoadFromFile(ApplicationPath+'MinimalModel.xml');
    CreateInstantModel;

    //Connect to database
    Connection := nil;
    Connector := nil;
    Try
      Connection := TInstantUIBConnection.Create(nil);
      Connection.Database.DatabaseName := ApplicationPath+'MINIMAL.FDB';
      Connection.Database.UserName := 'SYSDBA';
      Connection.Database.Password := 'a';
      Connector := TInstantUIBConnector.Create(nil);
      Connector.Connection := Connection;
      Connector.LoginPrompt := False;
      Connector.IsDefault := True;
      WriteLn('Connecting to Database.');
      Connector.Connect;

      for i := 0 to 100 do
      begin
        WriteLn('Storing Object.');
        SimpleClass := TSimpleClass.Create;
        Try
          SimpleClass.StringProperty := IntToStr(Random(MaxInt));
          SimpleClass.Store;
          Id := SimpleClass.Id;
        Finally
          SimpleClass.Free;
        End;

        WriteLn('Retrieving and changing Object.');
        SimpleClass := TSimpleClass.Retrieve(Id);
        Try
          SimpleClass.StringProperty := IntToStr(Random(MaxInt));
          SimpleClass.Store;
        Finally
          SimpleClass.Free;
        End;

        WriteLn('Retrieving and deleting Object.');
        SimpleClass := TSimpleClass.Retrieve(Id);
        Try
          SimpleClass.Dispose;
        Finally
          SimpleClass.Free;
        End;
      end;

      WriteLn('Disconnecting from Database.');
      Connector.Disconnect;
    Finally
      Connector.Free;
      Connection.Free;
    End;
    WriteLn('Done!');
  Except
    on E: Exception do WriteLn(E.Message);
  End;
end.

*)


initialization
  RegisterTests([TTestMinimalModel]);

end.



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

interface

uses
  InstantPersistence;

type
  TSimpleClass = class(TInstantObject)
  {IOMETADATA stored 'SIMPLE';
    StringProperty: String(20) stored 'STRING'; }
    _StringProperty: TInstantString;
  private
    function GetStringProperty: string;
    procedure SetStringProperty(const Value: string);
  published
    property StringProperty: string read GetStringProperty write SetStringProperty;
  end;

procedure CreateMinimalModel;

implementation

procedure CreateMinimalModel;
var
  InstantClassMetadata : TInstantClassMetadata;
  InstantAttributeMetadata : TInstantAttributeMetadata;
begin
(*
<TInstantClassMetadatas>
  <TInstantClassMetadata>
    <Name>TSimpleClass</Name>
    <Persistence>peStored</Persistence>
    <StorageName>SIMPLE</StorageName>
    <AttributeMetadatas>
      <TInstantAttributeMetadatas>
        <TInstantAttributeMetadata>
          <Name>StringProperty</Name>
          <AttributeType>atString</AttributeType>
          <IsIndexed>FALSE</IsIndexed>
          <IsRequired>FALSE</IsRequired>
          <Size>10</Size>
          <StorageName>STRING</StorageName>
        </TInstantAttributeMetadata>
      </TInstantAttributeMetadatas>
    </AttributeMetadatas>
  </TInstantClassMetadata>
</TInstantClassMetadatas>
*)
  InstantModel.ClassMetadatas.Create(InstantModel);
  InstantClassMetadata := InstantModel.ClassMetadatas.Add;
  InstantClassMetadata.Name := 'TSimpleClass';
  InstantClassMetadata.Persistence := peStored;
  InstantClassMetadata.StorageName := 'SIMPLE';
  InstantAttributeMetadata := InstantClassMetadata.AttributeMetadatas.Add;
  InstantAttributeMetadata.Name := 'StringProperty';
  InstantAttributeMetadata.AttributeType := atString;
  InstantAttributeMetadata.IsIndexed := FALSE;
  InstantAttributeMetadata.IsRequired := FALSE;
  InstantAttributeMetadata.Size := 10;
  InstantAttributeMetadata.StorageName := 'STRING';
end;

{ TSimpleClass }

function TSimpleClass.GetStringProperty: string;
begin
  Result := _StringProperty.Value;
end;

procedure TSimpleClass.SetStringProperty(const Value: string);
begin
  _StringProperty.Value := Value;
end;

initialization
  InstantRegisterClasses([
    TSimpleClass
  ]);

end.

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

{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}

interface

uses
  Classes, SysUtils, fpcunit, testregistry,
  InstantPersistence, InstantUIBConnection, MinimalModel,
  InstantUIB, InstantXML;

type

  { TestMinimalModel }

  TTestMinimalModel=class(TTestCase)
  private
    _Connector : TInstantConnector;
    function GetApplicationPath: string;
    function CreateObject : TSimpleClass;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
    function CreateConnector : TInstantConnector; virtual; abstract;
  public
    property ApplicationPath : string read GetApplicationPath;
  published
    procedure TestAll;
    procedure TestConnected;
    procedure TestStoring;
  end;

  { TestMinimalModelUIB }

  TTestMinimalModelUIB=class(TTestMinimalModel)
  private
    _Connection: TInstantUIBConnection;
  protected
    function CreateConnector : TInstantConnector; override;
  end;

  { TestMinimalModelXML }

  TTestMinimalModelXML=class(TTestMinimalModel)
  private
    _ApplicationPath : string;
    _Connection: TXMLFilesAccessor;
  protected
    function CreateConnector : TInstantConnector; override;
  end;

implementation

uses
  InstantClasses;

{ TestMinimalModel }
function TTestMinimalModel.GetApplicationPath : string;
begin
  Result := ExtractFilePath(ParamStr(0));
end;

procedure TTestMinimalModel.Setup;
begin
//  InstantModel.LoadFromFile(_ApplicationPath+'MinimalModel.xml');
  Randomize;
  CreateMinimalModel;
  _Connector := CreateConnector;
  _Connector.BlobStreamFormat := sfXML;
  _Connector.IsDefault := True;
  _Connector.Connect;
end;

function TTestMinimalModel.CreateObject : TSimpleClass;
begin
  // Create and Store Object.
  Result := TSimpleClass.Create;
  AssertEquals('', Result.Id);
  Result.StringProperty := IntToStr(Random(MaxInt));
end;

procedure TTestMinimalModel.TearDown;
begin
  if assigned(_Connector) and _Connector.Connected then
    _Connector.Disconnect;
  FreeAndNil(_Connector); //free the connection too
end;

procedure TTestMinimalModel.TestAll;
var
  SimpleObject : TSimpleClass;
  Id : string;
  i : integer;
  s: string;
begin
  for i := 0 to 10 do
  begin
// Storing Object.
   SimpleObject := CreateObject;
   Try
     SimpleObject.Store;
     Id := SimpleObject.Id;
     s := SimpleObject.StringProperty;
   Finally
     SimpleObject.Free;
   End;

// Retrieving and changing Object.
    SimpleObject := TSimpleClass.Retrieve(Id);
    Try
      AssertEquals(s, SimpleObject.StringProperty);
      SimpleObject.StringProperty := IntToStr(Random(MaxInt));
      s := SimpleObject.StringProperty;
      SimpleObject.Store;
    Finally
      SimpleObject.Free;
    End;

// Retrieving and deleting Object.
    SimpleObject := TSimpleClass.Retrieve(Id);
    Try
      AssertEquals(s, SimpleObject.StringProperty);
      SimpleObject.Dispose;
    Finally
      SimpleObject.Free;
    End;


// Trying to retrive deleted object
    SimpleObject := nil;
    SimpleObject := TSimpleClass.Retrieve(Id);
    AssertNull(SimpleObject);

  end;
end;

procedure TTestMinimalModel.TestConnected;
begin
  AssertTrue(_Connector.Connected);
  _Connector.Disconnect;
  AssertFalse(_Connector.Connected);
end;

procedure TTestMinimalModel.TestStoring;
var
  i: integer;
  SimpleObject : TSimpleClass;
begin
  for i := 0 to 10 do
  begin
    // Storing Object.
    SimpleObject := CreateObject;
    Try
     SimpleObject.Store;
    Finally
     SimpleObject.Free;
    End;
  end;
end;

{ TTestMinimalModelUIB }
function TTestMinimalModelUIB.CreateConnector : TInstantConnector;
var
  Connector : TInstantUIBConnector;
begin
  //Connect to database
  _Connection := TInstantUIBConnection.Create(nil);
  _Connection.Database.DatabaseName :=  ApplicationPath + 'MINIMAL.FDB';
  _Connection.Database.UserName := 'SYSDBA';
  _Connection.Database.Password := 'a'; //'a';
  Connector := TInstantUIBConnector.Create(nil);
  Connector.Connection := _Connection;
  Connector.LoginPrompt := False;
  Result := Connector;
end;

{ TTestMinimalModelXML }
function TTestMinimalModelXML.CreateConnector : TInstantConnector;
var
  Connector : TInstantXMLConnector;
begin
  _Connection :=  TXMLFilesAccessor.Create(nil);
  _Connection.RootFolder :=  ApplicationPath + 'XMLMinimalModel'+PathDelim;
//  _Connection.XMLFileFormat := xffIso;
  Connector := TInstantXMLConnector.Create(nil);
  Connector.Connection := _Connection;
  Connector.BuildDatabase;
  Result := Connector;
end;

initialization

  RegisterTest(TTestMinimalModelUIB);
  RegisterTest(TTestMinimalModelXML);

end.


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

interface

uses
  Classes, SysUtils,
  InstantClasses,
  fpcunit,
  testregistry;

type

  { TTestInstantClasses }

  TTestInstantClasses = class(TTestCase)
  published
    procedure TestInstantCollection;
    procedure TestInstantWriter;
    procedure TestInstantReader;
    procedure TestInstantReadWriteProperty;
    procedure TestInstantReadWriteClass;
    procedure TestInstantReadWriteObjectToStream;
    procedure TestInstantConverters;
    procedure TestInstantXMLProducer;
  end;


  TInstantGuineaPig = class(TInstantCollectionItem)
  private
    FPigName: string;
    FWeight: double;
    FAge: integer;
    procedure SetPigName(const Value: string);
    procedure SetAge(const Value: integer);
    procedure SetWeight(const Value: double);
  public
    constructor Create(Collection: TCollection); override;
  published
    property Age: integer read FAge write SetAge;
    property Weight: double read FWeight write SetWeight;
    property PigName: string read FPigName write SetPigName;
  end;



implementation

{ TTestInstantClasses }

procedure TTestInstantClasses.TestInstantCollection;
var
  i: TInstantCollectionItem;
  c: TInstantCollection;
begin
  c := TInstantCollection.Create(TInstantCollectionItem);
  AssertNotNull(c);
  AssertEquals(0, c.Count);
  i := c.add as TInstantCollectionItem;
  AssertEquals(1, c.Count);
  i.Name := 'pippo';
  AssertTrue(i = c.Find('pippo'));
end;

procedure TTestInstantClasses.TestInstantWriter;
var
  ms: TStringStream;
  iw: TInstantWriter;
  s: string;
begin
  s := '';
  ms := TStringStream.Create(s);
  iw := TInstantWriter.Create(ms);
  try
    //string
    iw.WriteString('goofy');
    iw.WriteString('mickeymouse');
    iw.FlushBuffer;
    AssertEquals(20, ms.Position);
    AssertEquals(#6#5'goofy'#6#11'mickeymouse', ms.DataString);

    //str
    iw.Position := 0;
    AssertEquals(0, ms.Position);
    iw.WriteStr('DonaldDuck');
    iw.FlushBuffer;
    AssertEquals(11, ms.Position);
    AssertEquals(#10'DonaldDuck', ms.DataString);

    //boolean
    iw.Position := 0;
    iw.WriteBoolean(False);
    iw.FlushBuffer;
    AssertEquals(1, ms.Position);
    AssertEquals('8', IntToStr(Ord(ms.DataString[1])));

    //float (controllo solo i primi 4 bytes)
    iw.Position := 0;
    iw.WriteFloat(3.14);
    iw.FlushBuffer;
    AssertEquals(11, ms.Position);
    AssertEquals('5', IntToStr(Ord(ms.DataString[1])));
    AssertEquals('195', IntToStr(Ord(ms.DataString[2])));
    AssertEquals('245', IntToStr(Ord(ms.DataString[3])));
    AssertEquals('40', IntToStr(Ord(ms.DataString[4])));

    //integer
    iw.Position := 0;
    iw.WriteInteger(123);
    iw.FlushBuffer;
    AssertEquals(2, ms.Position);
    AssertEquals('2', IntToStr(Ord(ms.DataString[1])));
    AssertEquals('123', IntToStr(Ord(ms.DataString[2])));

    //integer long
    iw.Position := 0;
    iw.WriteInteger(1234567);
    iw.FlushBuffer;
    AssertEquals(5, ms.Position);
    AssertEquals('4', IntToStr(Ord(ms.DataString[1])));
    AssertEquals('135', IntToStr(Ord(ms.DataString[2])));
    AssertEquals('214', IntToStr(Ord(ms.DataString[3])));
    AssertEquals('18', IntToStr(Ord(ms.DataString[4])));
    AssertEquals('0', IntToStr(Ord(ms.DataString[5])));

  finally
    iw.Free;
    ms.Free;
  end;
end;

procedure TTestInstantClasses.TestInstantReader;
var
  ms: TStringStream;
  ir: TInstantReader;
  iw: TInstantWriter;
  s: string;
begin
  s := '';
  ms := TStringStream.Create(s);
  ir := TInstantReader.Create(ms);
  iw := TInstantWriter.Create(ms);
  try
    //string
    iw.WriteString('goofy');
    iw.WriteString('mickeymouse');
    iw.FlushBuffer;
    ms.Position := 0;
    AssertEquals('goofy', ir.ReadString);
    AssertEquals('mickeymouse', ir.ReadString);

    //str
    iw.Position := 0;
    iw.WriteStr('DonaldDuck');
    iw.FlushBuffer;
    ms.Position := 0;
    AssertEquals('DonaldDuck', ir.ReadStr);

    //boolean
    iw.Position := 0;
    iw.WriteBoolean(False);
    iw.FlushBuffer;
    ms.Position := 0;
    AssertEquals(False, ir.ReadBoolean);

    //float (controllo solo i primi 4 bytes)
    iw.Position := 0;
    iw.WriteFloat(3.14);
    iw.FlushBuffer;
    ms.Position := 0;
    AssertEquals(3.14, ir.ReadFloat);

  finally
    iw.Free;
    ir.Free;
    ms.Free;
  end;
end;

procedure TTestInstantClasses.TestInstantReadWriteProperty;
var
  ms: TStringStream;
  ir: TInstantReader;
  iw: TInstantWriter;
  s: string;
  c: TInstantGuineaPig;
begin
  s := '';
  ms := TStringStream.Create(s);
  ir := TInstantReader.Create(ms);
  iw := TInstantWriter.Create(ms);
  c := TInstantGuineaPig.Create(nil);
  try
    iw.WriteProperties(c);
    iw.FlushBuffer;
    ms.Position := 0;

    c.PigName := 'croton';
    ir.ReadProperties(c);
    AssertEquals('Miss piggy', c.PigName);
  finally
    c.Free;
    iw.Free;
    ir.Free;
    ms.Free;
  end;
end;

procedure TTestInstantClasses.TestInstantReadWriteClass;
var
  ms: TStringStream;
  ir: TInstantReader;
  iw: TInstantWriter;
  s, hs: string;
  c: TInstantGuineaPig;
begin
  s := '';
  ms := TStringStream.Create(s);
  ir := TInstantReader.Create(ms);
  iw := TInstantWriter.Create(ms);
  c := TInstantGuineaPig.Create(nil);
  try
    c.PigName := 'AZazòèìù !$';
    c.Age := 123456;
    c.Weight := -1.2345789;

    //write class
    iw.WriteObject(c);
    iw.FlushBuffer;
    
    SetLength(hs, ms.Position * 2);
    BinToHex(PChar(ms.DataString), PChar(hs), ms.Position);

// delphi-fpc binary stream are slightly different
{$IFDEF FPC}
    AssertEquals('1154496E7374616E744775696E6561506967034167650440E20100065765696768740500A873EA6FAE069EFFBF075069674E616D65060B415A617AF2E8ECF92021240000', hs);
{$ELSE}
    AssertEquals('1154496E7374616E744775696E6561506967034167650440E20100065765696768740500A873EA6FAE069EFFBF075069674E616D65140F000000415A617AC3B2C3A8C3ACC3B92021240000', hs);
{$ENDIF}
    c.PigName := '';
    c.Age := 0;
    c.Weight := 0;
    ms.Position := 0;

    ir.ReadObject(c);
    AssertEquals('AZazòèìù !$', c.PigName);
    AssertEquals(123456, c.Age);
    AssertEquals(-1.2345789, c.Weight);

  finally
    iw.Free;
    ir.Free;
    ms.Free;
  end;
end;

procedure TTestInstantClasses.TestInstantReadWriteObjectToStream;
var
  ms: TStringStream;
  ir: TInstantReader;
  iw: TInstantWriter;
  s: string;
  c: TInstantGuineaPig;
begin
  s := '';
  ms := TStringStream.Create(s);
  ir := TInstantReader.Create(ms);
  iw := TInstantWriter.Create(ms);
  c := TInstantGuineaPig.Create(nil);
  try
    c.PigName := 'AZazòèìù !$';
    c.Age := 123456;
    c.Weight := -1.2345789;

    //write class
    InstantWriteObjectToStream(ms, c, nil);
    ms.Position := 0;

    c.PigName := '';
    c.Age := 0;
    c.Weight := 0;
    
    //read class
    InstantReadObjectFromStream(ms, c, nil);
    AssertEquals('AZazòèìù !$', c.PigName);
    AssertEquals(123456, c.Age);
    AssertEquals(-1.2345789, c.Weight);

  finally
    iw.Free;
    ir.Free;
    ms.Free;
  end;
end;


procedure TTestInstantClasses.TestInstantConverters;
var
  ins: TInstantStringStream;
  outs: TInstantStringStream;
  s1, s2: string;
  c: TInstantGuineaPig;
  ic: TInstantBinaryToTextConverter;
begin
  s1 := '';
  s2 := '';
  ins := TInstantStringStream.Create(s1);
  outs := TInstantStringStream.Create(s2);
  c := TInstantGuineaPig.Create(nil);
  ic := TInstantBinaryToTextConverter.Create(ins, outs);
  try
  //prepara
    InstantWriteObjectToStream(ins, c, nil);
    ins.Position := 0;

  //prova col convertitore da solo
    AssertEquals('TInstantGuineaPig', ic.Reader.ReadStr); //la stringa con il classname
    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
    ins.Position := 0;
    outs.Position := 0;
    s2 := '';
    InstantObjectBinaryToText(ins, outs);
    AssertEquals('InstantObjectBinaryToText', '<TInstantGuineaPig><Age>2</Age><Weight>1,123</Weight><PigName>Miss piggy</PigName></TInstantGuineaPig>', outs.DataString);
  finally
    ic.Free;
    c.Free;
    ins.Free;
    outs.Free;
  end;

end;

procedure TTestInstantClasses.TestInstantXMLProducer;
var
  ms: TInstantStringStream;
  s: string;
  c: TInstantGuineaPig;
begin
  s := '';
  ms := TInstantStringStream.Create(s);
  c := TInstantGuineaPig.Create(nil);
  try
    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;
    ms.Free;
  end;
end;


{ TInstantGuineaPig }

constructor TInstantGuineaPig.Create;
begin
  inherited Create(Collection);
  PigName := 'Miss piggy';
  Age := 2;
  Weight := 1.123;
end;

procedure TInstantGuineaPig.SetAge(const Value: integer);
begin
  FAge := Value;
end;

procedure TInstantGuineaPig.SetPigName(const Value: string);
begin
  FPigName := Value;
end;

procedure TInstantGuineaPig.SetWeight(const Value: double);
begin
  FWeight := Value;
end;

initialization
  RegisterTests([TTestInstantClasses]);
  RegisterClass(TInstantGuineaPig);

end.