instantobjects-cvscommit — Generates a message for every commit made on CVS

[Instantobjects-cvscommit] Source/Tests TestInstantCurrency.pas,NONE,1.1 TestInstantFloat.pas,NONE,1.1 TestInstantNumeric.pas,NONE,1.1 TestInstantAttribute.pas,NONE,1.1 TestInstantBoolean.pas,NONE,1.1 TestIO.dpr,1.7,1.8 TestInstantInteger.pas,1.2,1.3 TestInstantDateTime.pas,1.1,1.2 TestInstantString.pas,1.1,1.2

[Steven M. <sr...@us...>]

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

Modified Files:
	TestIO.dpr TestInstantInteger.pas TestInstantDateTime.pas 
	TestInstantString.pas 
Added Files:
	TestInstantCurrency.pas TestInstantFloat.pas 
	TestInstantNumeric.pas TestInstantAttribute.pas 
	TestInstantBoolean.pas 
Log Message:
Added Test for the following classes:
TInstantAttribute
TInstantNumeric
TInstantFloat
TInstantCurrency
TInstantBoolean
Refactored tests for the following classes:
TInstantInteger
TInstantDateTime
TInstantString

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

interface

uses fpcunit, InstantPersistence, InstantMock;

type

  // Test methods for class TInstantNumeric
  TestTInstantNumeric = class(TTestCase)
  private
    FAttrMetadata: TInstantAttributeMetadata;
    FConn: TInstantMockConnector;
    FInstantNumeric: TInstantNumeric;
    FOwner: TInstantObject;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAsBoolean;
    procedure TestAsDateTime;
    procedure TestAsObject;
    procedure TestDisplayText;
    procedure TestIsDefault;
  end;

implementation

uses SysUtils, testregistry, InstantClasses;

procedure TestTInstantNumeric.SetUp;
begin
  FConn := TInstantMockConnector.Create(nil);
  FConn.BrokerClass := TInstantMockBroker;
  FOwner := TInstantObject.Create(FConn);
  FAttrMetadata := TInstantAttributeMetadata.Create(nil);
  FAttrMetadata.AttributeClass := TInstantInteger;
  FAttrMetadata.Name := 'AttrMetadataName';
  // TInstantNumeric is abstract so use TInstantInteger
  FInstantNumeric := TInstantInteger.Create(FOwner, FAttrMetadata);
end;

procedure TestTInstantNumeric.TearDown;
begin
  FreeAndNil(FInstantNumeric);
  FreeAndNil(FAttrMetadata);
  FreeAndNil(FOwner);
  FreeAndNil(FConn);
end;

procedure TestTInstantNumeric.TestAsBoolean;
begin
  FInstantNumeric.AsBoolean := True;
  AssertEquals('Set AsBoolean is incorrect!', 1, FInstantNumeric.Value);
  AssertTrue('Get AsBoolean is false!', FInstantNumeric.AsBoolean);

  FInstantNumeric.AsBoolean := False;
  AssertEquals('Set AsBoolean is incorrect!', 0, FInstantNumeric.Value);
  AssertFalse('Get AsBoolean is true!', FInstantNumeric.AsBoolean);
end;

procedure TestTInstantNumeric.TestAsDateTime;
begin
  FInstantNumeric.AsDateTime := 12.45;
  AssertEquals('Set AsDateTime is incorrect!', 12, FInstantNumeric.Value);
  AssertEquals('Get AsDateTime is incorrect!', 12.0,
    FInstantNumeric.AsDateTime);
end;

procedure TestTInstantNumeric.TestAsObject;
begin
  try
    FInstantNumeric.AsObject := TInstantObject.Create(FConn);
    Fail('Exception was not thrown for Set AsObject!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
  try
    FInstantNumeric.AsObject;
    Fail('Exception was not thrown for Get AsObject!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
end;

procedure TestTInstantNumeric.TestDisplayText;
begin
  FInstantNumeric.Value := 1;
  AssertEquals('DisplayText is incorrect!', '1', FInstantNumeric.DisplayText);

  FInstantNumeric.Metadata.EditMask := '000';
  AssertEquals('DisplayText is incorrect!', '001', FInstantNumeric.DisplayText);

  FInstantNumeric.Value := 1000;
  FInstantNumeric.Metadata.EditMask := '#' + ThousandSeparator + '000';
  AssertEquals('DisplayText is incorrect!', '1' + ThousandSeparator + '000',
    FInstantNumeric.DisplayText);
end;

procedure TestTInstantNumeric.TestIsDefault;
begin
  AssertTrue('Value is not default!', FInstantNumeric.IsDefault);

  FInstantNumeric.Value := 100;
  AssertFalse('Value is default!', FInstantNumeric.IsDefault);
end;

initialization
  // Register any test cases with the test runner
{$IFNDEF CURR_TESTS}
  RegisterTests([TestTInstantNumeric]);
{$ENDIF}

end.
 
--- NEW FILE: TestInstantFloat.pas ---
unit TestInstantFloat;

interface

uses fpcunit, InstantPersistence, InstantMock;

type

  // Test methods for class TInstantFloat
  TestTInstantFloat = class(TTestCase)
  private
    FAttrMetadata: TInstantAttributeMetadata;
    FConn: TInstantMockConnector;
    FInstantFloat: TInstantFloat;
    FOwner: TInstantObject;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAsCurrency;
    procedure TestAsFloat;
    procedure TestAsInteger;
    procedure TestAssign;
    procedure TestAsString;
    procedure TestAsVariant;
    procedure TestReset;
    procedure TestValue;
  end;

implementation

uses SysUtils, testregistry, InstantClasses;

procedure TestTInstantFloat.SetUp;
begin
  FConn := TInstantMockConnector.Create(nil);
  FConn.BrokerClass := TInstantMockBroker;
  FOwner := TInstantObject.Create(FConn);
  FAttrMetadata := TInstantAttributeMetadata.Create(nil);
  FAttrMetadata.AttributeClass := TInstantFloat;
  FAttrMetadata.Name := 'AttrMetadataName';
  FInstantFloat := TInstantFloat.Create(FOwner, FAttrMetadata);
  FInstantFloat.Value := 1.3;
end;

procedure TestTInstantFloat.TearDown;
begin
  FreeAndNil(FInstantFloat);
  FreeAndNil(FAttrMetadata);
  FreeAndNil(FOwner);
  FreeAndNil(FConn);
end;

procedure TestTInstantFloat.TestAsCurrency;
begin
  FInstantFloat.AsCurrency := 23.45;
  AssertEquals('Set AsCurrency is incorrect!', 23.45, FInstantFloat.Value);
  AssertEquals('Get AsCurrency is incorrect!', 23.45,
    FInstantFloat.AsCurrency);
end;

procedure TestTInstantFloat.TestAsFloat;
begin
  FInstantFloat.AsFloat := 89.45;
  AssertEquals('Set AsFloat is incorrect!', 89.45, FInstantFloat.Value);
  AssertEquals('Get AsFloat is incorrect!', 89.45, FInstantFloat.AsFloat);
end;

procedure TestTInstantFloat.TestAsInteger;
begin
  FInstantFloat.AsInteger := 89;
  AssertEquals('Set AsInteger is incorrect!', 89.0, FInstantFloat.Value);
  AssertEquals('Get AsInteger is incorrect!', 89.0, FInstantFloat.AsInteger);
end;

procedure TestTInstantFloat.TestAssign;
var
  vSource: TInstantFloat;
begin
  AssertEquals('Value is incorrect!', 1.3, FInstantFloat.Value);
  vSource := TInstantFloat.Create;
  try
    VSource.Value := 4.3;
    FInstantFloat.Assign(vSource);
    AssertEquals('Value is incorrect!', 4.3, FInstantFloat.Value);
  finally
    vSource.Free;
  end;
end;

procedure TestTInstantFloat.TestAsString;
begin
  FInstantFloat.AsString := '1.3';
  AssertEquals('Set AsString is incorrect!', 1.3, FInstantFloat.Value);
  AssertEquals('Get AsString is incorrect!', '1.3', FInstantFloat.AsString);
end;

procedure TestTInstantFloat.TestAsVariant;
begin                                           
  FInstantFloat.AsVariant := 15.1;
  AssertEquals('Set AsVariant is incorrect!', 15.1, FInstantFloat.Value);
  AssertEquals('Get AsVariant is incorrect!', 15.1, FInstantFloat.AsVariant);
end;

procedure TestTInstantFloat.TestReset;
begin
  AssertNotNull('Metadata is nil!', FInstantFloat.Metadata);
  // Metadata.DefaultValue is '';
  FInstantFloat.Reset;
  AssertEquals('Reset value is incorrect!', 1.3, FInstantFloat.Value);

  FInstantFloat.Metadata.DefaultValue := '15.7';
  FInstantFloat.Reset;
  AssertEquals('Reset value is incorrect!', 15.7, FInstantFloat.Value);

  FInstantFloat.Metadata := nil;
  AssertNull('Metadata is not nil!', FInstantFloat.Metadata);
  FInstantFloat.Reset;
  AssertEquals('Reset value is incorrect!', 0.0, FInstantFloat.Value);
end;

procedure TestTInstantFloat.TestValue;
begin
  AssertEquals('Value is incorrect!', 1.3, FInstantFloat.Value);
  FInstantFloat.Value := 97.2;
  AssertEquals('Value is incorrect!', 97.2, FInstantFloat.Value);
end;

initialization
  // Register any test cases with the test runner
{$IFNDEF CURR_TESTS}
  RegisterTests([TestTInstantFloat]);
{$ENDIF}

end.
 
--- NEW FILE: TestInstantAttribute.pas ---
unit TestInstantAttribute;

interface

uses fpcunit, InstantPersistence, InstantMock;

type

  // Test methods for class TInstantAttribute
  TestTInstantAttribute = class(TTestCase)
  private
    FAttrMetadata: TInstantAttributeMetadata;
    FConn: TInstantMockConnector;
    FInstantAttribute: TInstantAttribute;
    FOwner: TInstantObject;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestChange;
    procedure TestCheckHasMetadata;
    procedure TestDisplayText;
    procedure TestIsDefault;
    procedure TestIsIndexed;
    procedure TestIsMandatory;
    procedure TestIsRequired;
    procedure TestMetadata;
  end;

implementation

uses SysUtils, testregistry, InstantClasses;

procedure TestTInstantAttribute.SetUp;
begin
  FConn := TInstantMockConnector.Create(nil);
  FConn.BrokerClass := TInstantMockBroker;
  FOwner := TInstantObject.Create(FConn);
  FAttrMetadata := TInstantAttributeMetadata.Create(nil);
  FAttrMetadata.AttributeClass := TInstantString;
  FAttrMetadata.Name := 'AttrMetadataName';
  // TInstantAttribute is abstract so use TInstantString
  FInstantAttribute := TInstantString.Create(FOwner, FAttrMetadata);
end;

procedure TestTInstantAttribute.TearDown;
begin
  FreeAndNil(FInstantAttribute);
  FreeAndNil(FAttrMetadata);
  FreeAndNil(FOwner);
  FreeAndNil(FConn);
end;

procedure TestTInstantAttribute.TestChange;
begin
  AssertFalse('IsChanged is true!', FInstantAttribute.IsChanged);
  FInstantAttribute.Value := 'NewString';
  AssertTrue('IsChanged is false!', FInstantAttribute.IsChanged);
  FInstantAttribute.UnChanged;
  AssertFalse('IsChanged is true!', FInstantAttribute.IsChanged);
  FInstantAttribute.Changed;
  AssertTrue('IsChanged is false!', FInstantAttribute.IsChanged);
end;

procedure TestTInstantAttribute.TestCheckHasMetadata;
begin
  try
    FInstantAttribute.CheckHasMetadata;
  except
    Fail('CheckHasMetadata failed!');
  end;

  FInstantAttribute.Metadata := nil;
  AssertException(EInstantError, FInstantAttribute.CheckHasMetadata);
end;

procedure TestTInstantAttribute.TestDisplayText;
begin
  FInstantAttribute.Value := 'StringValue';
  AssertEquals('DisplayText is incorrect!', 'StringValue',
    FInstantAttribute.DisplayText);

  FInstantAttribute.Metadata.EditMask := '!CCCCCC';
  AssertEquals('DisplayText is incorrect!', 'gValue',
  FInstantAttribute.DisplayText);

  FInstantAttribute.Value := 'NewString';
  FInstantAttribute.Metadata.EditMask := 'CCCCCC';
  AssertEquals('DisplayText is incorrect!', 'NewStr',
    FInstantAttribute.DisplayText);
end;

procedure TestTInstantAttribute.TestIsDefault;
begin
  AssertTrue('Value is not default!', FInstantAttribute.IsDefault);

  FInstantAttribute.Value := 'NewString';
  AssertFalse('Value is default!', FInstantAttribute.IsDefault);
end;

procedure TestTInstantAttribute.TestIsIndexed;
begin
  AssertFalse('Attribute is indexed!', FInstantAttribute.IsIndexed);

  FInstantAttribute.Metadata.IsIndexed := True;
  AssertTrue('Attribute is not indexed!', FInstantAttribute.IsIndexed);
end;

procedure TestTInstantAttribute.TestIsMandatory;
begin
  AssertFalse('Attribute is Mandatory!', FInstantAttribute.IsMandatory);

  FInstantAttribute.Metadata.IsIndexed := True;
  AssertTrue('Attribute is not Mandatory!', FInstantAttribute.IsMandatory);
  FInstantAttribute.Metadata.IsRequired := True;
  AssertTrue('Attribute is not Mandatory!', FInstantAttribute.IsMandatory);
  FInstantAttribute.Metadata.IsIndexed := False;
  AssertTrue('Attribute is not Mandatory!', FInstantAttribute.IsMandatory);
end;

procedure TestTInstantAttribute.TestIsRequired;
begin
  AssertFalse('Attribute is required!', FInstantAttribute.IsRequired);

  FInstantAttribute.Metadata.IsRequired := True;
  AssertTrue('Attribute is not required!', FInstantAttribute.IsRequired);
end;

procedure TestTInstantAttribute.TestMetadata;
begin
  AssertNotNull('Metadata is nil!', FInstantAttribute.Metadata);
  AssertEquals('Metdata name is incorrect!', 'AttrMetadataName',
    FInstantAttribute.Metadata.Name);

  FInstantAttribute.Metadata := nil;
  AssertNull('Metadata is not nil!', FInstantAttribute.Metadata);
  FInstantAttribute.Reset;

  FInstantAttribute.Metadata := FAttrMetadata;
  AssertNotNull('Metadata is nil!', FInstantAttribute.Metadata);
  AssertEquals('Metdata name is incorrect!', 'AttrMetadataName',
    FInstantAttribute.Metadata.Name);
end;

initialization
  // Register any test cases with the test runner
{$IFNDEF CURR_TESTS}
  RegisterTests([TestTInstantAttribute]);
{$ENDIF}

end.
 
Index: TestInstantInteger.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestInstantInteger.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** TestInstantInteger.pas	6 May 2005 05:41:28 -0000	1.2
--- TestInstantInteger.pas	7 May 2005 04:59:48 -0000	1.3
***************
*** 18,40 ****
      procedure TearDown; override;
    published
-     procedure TestAsBoolean;
      procedure TestAsCurrency;
-     procedure TestAsDateTime;
      procedure TestAsFloat;
      procedure TestAsInteger;
-     procedure TestAsObject;
      procedure TestAssign;
      procedure TestAsString;
      procedure TestAsVariant;
-     procedure TestChange;
-     procedure TestCheckHasMetadata;
-     procedure TestDisplayText;
-     procedure TestIsDefault;
-     procedure TestIsIndexed;
-     procedure TestIsMandatory;
-     procedure TestIsRequired;
-     procedure TestMetadata;
-     procedure TestName;
-     procedure TestOwner;
      procedure TestReset;
      procedure TestValue;
--- 18,27 ----
***************
*** 65,79 ****
  end;
  
- procedure TestTInstantInteger.TestAsBoolean;
- begin
-   FInstantInteger.AsBoolean := True;
-   AssertEquals('Set AsBoolean is incorrect!', 1, FInstantInteger.Value);
-   AssertTrue('Get AsBoolean is false!', FInstantInteger.AsBoolean);
- 
-   FInstantInteger.AsBoolean := False;
-   AssertEquals('Set AsBoolean is incorrect!', 0, FInstantInteger.Value);
-   AssertFalse('Get AsBoolean is true!', FInstantInteger.AsBoolean);
- end;
- 
  procedure TestTInstantInteger.TestAsCurrency;
  begin
--- 52,55 ----
***************
*** 84,95 ****
  end;
  
- procedure TestTInstantInteger.TestAsDateTime;
- begin
-   FInstantInteger.AsDateTime := 12.45;
-   AssertEquals('Set AsDateTime is incorrect!', 12, FInstantInteger.Value);
-   AssertEquals('Get AsDateTime is incorrect!', 12.0,
-     FInstantInteger.AsDateTime);
- end;
- 
  procedure TestTInstantInteger.TestAsFloat;
  begin
--- 60,63 ----
***************
*** 106,129 ****
  end;
  
- procedure TestTInstantInteger.TestAsObject;
- begin
-   try
-     FInstantInteger.AsObject := TInstantObject.Create(FConn);
-     Fail('Exception was not thrown for Set AsObject!'); // should never get here
-   except
-     on E: EInstantAccessError do ; // do nothing as this is expected
-     else
-       raise;
-   end;
-   try
-     FInstantInteger.AsObject;
-     Fail('Exception was not thrown for Get AsObject!'); // should never get here
-   except
-     on E: EInstantAccessError do ; // do nothing as this is expected
-     else
-       raise;
-   end;
- end;
- 
  procedure TestTInstantInteger.TestAssign;
  var
--- 74,77 ----
***************
*** 156,260 ****
  end;
  
- procedure TestTInstantInteger.TestChange;
- begin
-   AssertTrue('IsChanged is false!', FInstantInteger.IsChanged);
-   FInstantInteger.UnChanged;
-   AssertFalse('IsChanged is true!', FInstantInteger.IsChanged);
-   FInstantInteger.Value := FInstantInteger.Value + 1;
-   AssertTrue('IsChanged is false!', FInstantInteger.IsChanged);
-   FInstantInteger.UnChanged;
-   AssertFalse('IsChanged is true!', FInstantInteger.IsChanged);
-   FInstantInteger.Changed;
-   AssertTrue('IsChanged is false!', FInstantInteger.IsChanged);
- end;
- 
- procedure TestTInstantInteger.TestCheckHasMetadata;
- begin
-   try
-     FInstantInteger.CheckHasMetadata;
-   except
-     Fail('CheckHasMetadata failed!');
-   end;
- 
-   FInstantInteger.Metadata := nil;
-   AssertException(EInstantError, FInstantInteger.CheckHasMetadata);
- end;
- 
- procedure TestTInstantInteger.TestDisplayText;
- begin
-   AssertEquals('DisplayText is incorrect!', '1', FInstantInteger.DisplayText);
- 
-   FInstantInteger.Metadata.EditMask := '000';
-   AssertEquals('DisplayText is incorrect!', '001', FInstantInteger.DisplayText);
- 
-   FInstantInteger.Value := 1000;
-   FInstantInteger.Metadata.EditMask := '#' + ThousandSeparator + '000';
-   AssertEquals('DisplayText is incorrect!', '1' + ThousandSeparator + '000',
-     FInstantInteger.DisplayText);
- end;
- 
- procedure TestTInstantInteger.TestIsDefault;
- begin
-   AssertFalse('Value is default!', FInstantInteger.IsDefault);
- 
-   FInstantInteger.Value := 0;
-   AssertTrue('Value is not default!', FInstantInteger.IsDefault);
- end;
- 
- procedure TestTInstantInteger.TestIsIndexed;
- begin
-   AssertFalse('Attribute is indexed!', FInstantInteger.IsIndexed);
- 
-   FInstantInteger.Metadata.IsIndexed := True;
-   AssertTrue('Attribute is not indexed!', FInstantInteger.IsIndexed);
- end;
- 
- procedure TestTInstantInteger.TestIsMandatory;
- begin
-   AssertFalse('Attribute is Mandatory!', FInstantInteger.IsMandatory);
- 
-   FInstantInteger.Metadata.IsIndexed := True;
-   AssertTrue('Attribute is not Mandatory!', FInstantInteger.IsMandatory);
-   FInstantInteger.Metadata.IsRequired := True;
-   AssertTrue('Attribute is not Mandatory!', FInstantInteger.IsMandatory);
-   FInstantInteger.Metadata.IsIndexed := False;
-   AssertTrue('Attribute is not Mandatory!', FInstantInteger.IsMandatory);
- end;
- 
- procedure TestTInstantInteger.TestIsRequired;
- begin
-   AssertFalse('Attribute is required!', FInstantInteger.IsRequired);
- 
-   FInstantInteger.Metadata.IsRequired := True;
-   AssertTrue('Attribute is not required!', FInstantInteger.IsRequired);
- end;
- 
- procedure TestTInstantInteger.TestMetadata;
- begin
-   AssertNotNull('Metadata is nil!', FInstantInteger.Metadata);
-   AssertEquals('Metdata name is incorrect!', 'AttrMetadataName',
-     FInstantInteger.Metadata.Name);
- 
-   FInstantInteger.Metadata := nil;
-   AssertNull('Metadata is not nil!', FInstantInteger.Metadata);
-   FInstantInteger.Reset;
- 
-   FInstantInteger.Metadata := FAttrMetadata;
-   AssertNotNull('Metadata is nil!', FInstantInteger.Metadata);
-   AssertEquals('Metdata name is incorrect!', 'AttrMetadataName',
-     FInstantInteger.Metadata.Name);
- end;
- 
- procedure TestTInstantInteger.TestName;
- begin
-   AssertEquals('Attribute name is incorrect!', 'AttrMetadataName',
-     FInstantInteger.Name);
- end;
- 
- procedure TestTInstantInteger.TestOwner;
- begin
-   AssertSame('Owner is incorrect!', FOwner, FInstantInteger.Owner);
- end;
- 
  procedure TestTInstantInteger.TestReset;
  begin
--- 104,107 ----

Index: TestInstantString.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestInstantString.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** TestInstantString.pas	6 May 2005 05:41:28 -0000	1.1
--- TestInstantString.pas	7 May 2005 04:59:49 -0000	1.2
***************
*** 27,38 ****
      procedure TestAsString;
      procedure TestAsVariant;
-     procedure TestChange;
-     procedure TestCheckHasMetadata;
-     procedure TestDisplayText;
-     procedure TestIsDefault;
-     procedure TestIsIndexed;
-     procedure TestIsMandatory;
-     procedure TestIsRequired;
-     procedure TestMetadata;
      procedure TestName;
      procedure TestOwner;
--- 27,30 ----
***************
*** 163,258 ****
  end;
  
- procedure TestTInstantString.TestChange;
- begin
-   AssertTrue('IsChanged is false!', FInstantString.IsChanged);
-   FInstantString.UnChanged;
-   AssertFalse('IsChanged is true!', FInstantString.IsChanged);
-   FInstantString.Value := FInstantString.Value + 's';
-   AssertTrue('IsChanged is false!', FInstantString.IsChanged);
-   FInstantString.UnChanged;
-   AssertFalse('IsChanged is true!', FInstantString.IsChanged);
-   FInstantString.Changed;
-   AssertTrue('IsChanged is false!', FInstantString.IsChanged);
- end;
- 
- procedure TestTInstantString.TestCheckHasMetadata;
- begin
-   try
-     FInstantString.CheckHasMetadata;
-   except
-     Fail('CheckHasMetadata failed!');
-   end;
- 
-   FInstantString.Metadata := nil;
-   AssertException(EInstantError, FInstantString.CheckHasMetadata);
- end;
- 
- procedure TestTInstantString.TestDisplayText;
- begin
-   AssertEquals('DisplayText is incorrect!', 'StringValue',
-     FInstantString.DisplayText);
- 
-   FInstantString.Metadata.EditMask := '!CCCCCC';
-   AssertEquals('DisplayText is incorrect!', 'gValue',
-   FInstantString.DisplayText);
- 
-   FInstantString.Value := 'NewString';
-   FInstantString.Metadata.EditMask := 'CCCCCC';
-   AssertEquals('DisplayText is incorrect!', 'NewStr',
-     FInstantString.DisplayText);
- end;
- 
- procedure TestTInstantString.TestIsDefault;
- begin
-   AssertFalse('Value is default!', FInstantString.IsDefault);
- 
-   FInstantString.Value := '';
-   AssertTrue('Value is not default!', FInstantString.IsDefault);
- end;
- 
- procedure TestTInstantString.TestIsIndexed;
- begin
-   AssertFalse('Attribute is indexed!', FInstantString.IsIndexed);
- 
-   FInstantString.Metadata.IsIndexed := True;
-   AssertTrue('Attribute is not indexed!', FInstantString.IsIndexed);
- end;
- 
- procedure TestTInstantString.TestIsMandatory;
- begin
-   AssertFalse('Attribute is Mandatory!', FInstantString.IsMandatory);
- 
-   FInstantString.Metadata.IsIndexed := True;
-   AssertTrue('Attribute is not Mandatory!', FInstantString.IsMandatory);
-   FInstantString.Metadata.IsRequired := True;
-   AssertTrue('Attribute is not Mandatory!', FInstantString.IsMandatory);
-   FInstantString.Metadata.IsIndexed := False;
-   AssertTrue('Attribute is not Mandatory!', FInstantString.IsMandatory);
- end;
- 
- procedure TestTInstantString.TestIsRequired;
- begin
-   AssertFalse('Attribute is required!', FInstantString.IsRequired);
- 
-   FInstantString.Metadata.IsRequired := True;
-   AssertTrue('Attribute is not required!', FInstantString.IsRequired);
- end;
- 
- procedure TestTInstantString.TestMetadata;
- begin
-   AssertNotNull('Metadata is nil!', FInstantString.Metadata);
-   AssertEquals('Metdata name is incorrect!', 'AttrMetadataName',
-     FInstantString.Metadata.Name);
- 
-   FInstantString.Metadata := nil;
-   AssertNull('Metadata is not nil!', FInstantString.Metadata);
-   FInstantString.Reset;
- 
-   FInstantString.Metadata := FAttrMetadata;
-   AssertNotNull('Metadata is nil!', FInstantString.Metadata);
-   AssertEquals('Metdata name is incorrect!', 'AttrMetadataName',
-     FInstantString.Metadata.Name);
- end;
- 
  procedure TestTInstantString.TestName;
  begin
--- 155,158 ----

Index: TestInstantDateTime.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestInstantDateTime.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** TestInstantDateTime.pas	6 May 2005 05:41:28 -0000	1.1
--- TestInstantDateTime.pas	7 May 2005 04:59:48 -0000	1.2
***************
*** 27,40 ****
      procedure TestAsString;
      procedure TestAsVariant;
-     procedure TestChange;
-     procedure TestCheckHasMetadata;
      procedure TestDisplayText;
      procedure TestIsDefault;
-     procedure TestIsIndexed;
-     procedure TestIsMandatory;
-     procedure TestIsRequired;
-     procedure TestMetadata;
-     procedure TestName;
-     procedure TestOwner;
      procedure TestReset;
      procedure TestValue;
--- 27,32 ----
***************
*** 210,238 ****
  end;
  
- procedure TestTInstantDateTime.TestChange;
- begin
-   AssertTrue('IsChanged is false!', FInstantDateTime.IsChanged);
-   FInstantDateTime.UnChanged;
-   AssertFalse('IsChanged is true!', FInstantDateTime.IsChanged);
-   FInstantDateTime.Value := FInstantDateTime.Value + 30;
-   AssertTrue('IsChanged is false!', FInstantDateTime.IsChanged);
-   FInstantDateTime.UnChanged;
-   AssertFalse('IsChanged is true!', FInstantDateTime.IsChanged);
-   FInstantDateTime.Changed;
-   AssertTrue('IsChanged is false!', FInstantDateTime.IsChanged);
- end;
- 
- procedure TestTInstantDateTime.TestCheckHasMetadata;
- begin
-   try
-     FInstantDateTime.CheckHasMetadata;
-   except
-     Fail('CheckHasMetadata failed!');
-   end;
- 
-   FInstantDateTime.Metadata := nil;
-   AssertException(EInstantError, FInstantDateTime.CheckHasMetadata);
- end;
- 
  procedure TestTInstantDateTime.TestDisplayText;
  var
--- 202,205 ----
***************
*** 263,321 ****
  end;
  
- procedure TestTInstantDateTime.TestIsIndexed;
- begin
-   AssertFalse('Attribute is indexed!', FInstantDateTime.IsIndexed);
- 
-   FInstantDateTime.Metadata.IsIndexed := True;
-   AssertTrue('Attribute is not indexed!', FInstantDateTime.IsIndexed);
- end;
- 
- procedure TestTInstantDateTime.TestIsMandatory;
- begin
-   AssertFalse('Attribute is Mandatory!', FInstantDateTime.IsMandatory);
- 
-   FInstantDateTime.Metadata.IsIndexed := True;
-   AssertTrue('Attribute is not Mandatory!', FInstantDateTime.IsMandatory);
-   FInstantDateTime.Metadata.IsRequired := True;
-   AssertTrue('Attribute is not Mandatory!', FInstantDateTime.IsMandatory);
-   FInstantDateTime.Metadata.IsIndexed := False;
-   AssertTrue('Attribute is not Mandatory!', FInstantDateTime.IsMandatory);
- end;
- 
- procedure TestTInstantDateTime.TestIsRequired;
- begin
-   AssertFalse('Attribute is required!', FInstantDateTime.IsRequired);
- 
-   FInstantDateTime.Metadata.IsRequired := True;
-   AssertTrue('Attribute is not required!', FInstantDateTime.IsRequired);
- end;
- 
- procedure TestTInstantDateTime.TestMetadata;
- begin
-   AssertNotNull('Metadata is nil!', FInstantDateTime.Metadata);
-   AssertEquals('Metdata name is incorrect!', 'AttrMetadataName',
-     FInstantDateTime.Metadata.Name);
- 
-   FInstantDateTime.Metadata := nil;
-   AssertNull('Metadata is not nil!', FInstantDateTime.Metadata);
-   FInstantDateTime.Reset;
- 
-   FInstantDateTime.Metadata := FAttrMetadata;
-   AssertNotNull('Metadata is nil!', FInstantDateTime.Metadata);
-   AssertEquals('Metdata name is incorrect!', 'AttrMetadataName',
-     FInstantDateTime.Metadata.Name);
- end;
- 
- procedure TestTInstantDateTime.TestName;
- begin
-   AssertEquals('Attribute name is incorrect!', 'AttrMetadataName',
-     FInstantDateTime.Name);
- end;
- 
- procedure TestTInstantDateTime.TestOwner;
- begin
-   AssertSame('Owner is incorrect!', FOwner, FInstantDateTime.Owner);
- end;
- 
  procedure TestTInstantDateTime.TestReset;
  var
--- 230,233 ----

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

interface

uses fpcunit, InstantPersistence, InstantMock;

Type

  // Test methods for class TInstantBoolean
  TestTInstantBoolean = class(TTestCase)
  private
    FAttrMetadata: TInstantAttributeMetadata;
    FConn: TInstantMockConnector;
    FInstantBoolean: TInstantBoolean;
    FOwner: TInstantObject;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAsBoolean;
    procedure TestAsCurrency;
    procedure TestAsDateTime;
    procedure TestAsFloat;
    procedure TestAsInteger;
    procedure TestAsObject;
    procedure TestAssign;
    procedure TestAsString;
    procedure TestAsVariant;
    procedure TestDisplayText;
    procedure TestIsDefault;
    procedure TestReset;
    procedure TestValue;
  end;

implementation

uses SysUtils, testregistry, InstantClasses, InstantConsts;

procedure TestTInstantBoolean.SetUp;
begin
  FConn := TInstantMockConnector.Create(nil);
  FConn.BrokerClass := TInstantMockBroker;
  FOwner := TInstantObject.Create(FConn);
  FAttrMetadata := TInstantAttributeMetadata.Create(nil);
  FAttrMetadata.AttributeClass := TInstantBoolean;
  FAttrMetadata.Name := 'AttrMetadataName';
  FInstantBoolean := TInstantBoolean.Create(FOwner, FAttrMetadata);
  FInstantBoolean.Value := False;
end;

procedure TestTInstantBoolean.TearDown;
begin
  FreeAndNil(FInstantBoolean);
  FreeAndNil(FAttrMetadata);
  FreeAndNil(FOwner);
  FreeAndNil(FConn);
end;

procedure TestTInstantBoolean.TestAsBoolean;
begin
  FInstantBoolean.AsBoolean := True;
  AssertEquals('Set AsBoolean is incorrect!', True, FInstantBoolean.Value);
  AssertTrue('Get AsBoolean is false!', FInstantBoolean.AsBoolean);

  FInstantBoolean.AsBoolean := False;
  AssertEquals('Set AsBoolean is incorrect!', False, FInstantBoolean.Value);
  AssertFalse('Get AsBoolean is true!', FInstantBoolean.AsBoolean);
end;

procedure TestTInstantBoolean.TestAsCurrency;
begin
  FInstantBoolean.AsCurrency := 89.45;
  AssertTrue('Set AsCurrency is incorrect!', FInstantBoolean.Value);
  AssertEquals('Get AsCurrency is incorrect!', 89.0, FInstantBoolean.AsCurrency);
end;

procedure TestTInstantBoolean.TestAsDateTime;
begin
  try
    FInstantBoolean.AsDateTime := 12.45;
    Fail('Exception was not thrown for Set AsDateTime!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
  else
    raise;
  end;
  try
    FInstantBoolean.AsDateTime;
    Fail('Exception was not thrown for Get AsDateTime!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
  else
    raise;
  end;
end;

procedure TestTInstantBoolean.TestAsFloat;
begin
  FInstantBoolean.AsFloat := 89.45;
  AssertTrue('Set AsFloat is incorrect!', FInstantBoolean.Value);
  AssertEquals('Get AsFloat is incorrect!', 89.0, FInstantBoolean.AsFloat);
end;

procedure TestTInstantBoolean.TestAsInteger;
begin
  FInstantBoolean.AsInteger := 100;
  AssertTrue('Set AsInteger is incorrect!', FInstantBoolean.Value);
  AssertEquals('Get AsInteger is incorrect!', 100, FInstantBoolean.AsInteger);
end;

procedure TestTInstantBoolean.TestAsObject;
begin
  try
    FInstantBoolean.AsObject := TInstantObject.Create(FConn);
    Fail('Exception was not thrown for Set AsObject!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
  try
    FInstantBoolean.AsObject;
    Fail('Exception was not thrown for Get AsObject!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
end;

procedure TestTInstantBoolean.TestAssign;
var
  vSource: TInstantBoolean;
begin
  AssertEquals('String value is incorrect!', False,
    FInstantBoolean.Value);

  vSource := TInstantBoolean.Create;
  try
    VSource.Value := True;
    FInstantBoolean.Assign(vSource);
    AssertEquals('String value is incorrect!', True,
      FInstantBoolean.Value);
  finally
    vSource.Free;
  end;
end;

procedure TestTInstantBoolean.TestAsString;
begin
  FInstantBoolean.AsString := InstantTrueString;
  AssertTrue('Set AsString is incorrect!', FInstantBoolean.Value);
  AssertTrue('Get AsString is incorrect!', SameText(InstantTrueString,
    FInstantBoolean.AsString));
end;

procedure TestTInstantBoolean.TestAsVariant;
begin                                           
  FInstantBoolean.AsVariant := True;
  AssertTrue('Set AsVariant is incorrect!', FInstantBoolean.Value);
  AssertTrue('Get AsVariant is incorrect!', FInstantBoolean.AsVariant);
end;

procedure TestTInstantBoolean.TestDisplayText;
begin
  AssertTrue('DisplayText is incorrect!',
    SameText(InstantFalseString, FInstantBoolean.DisplayText));

  FInstantBoolean.Metadata.EditMask := '!CC';
  AssertEquals('DisplayText is incorrect!', 'se',
  FInstantBoolean.DisplayText);

  FInstantBoolean.Value := True;
  FInstantBoolean.Metadata.EditMask := 'CCC';
  AssertEquals('DisplayText is incorrect!', 'Tru',
    FInstantBoolean.DisplayText);
end;

procedure TestTInstantBoolean.TestIsDefault;
begin
  AssertTrue('Value is default!', FInstantBoolean.IsDefault);

  FInstantBoolean.Value := True;
  AssertFalse('Value is not default!', FInstantBoolean.IsDefault);
end;

procedure TestTInstantBoolean.TestReset;
begin
  AssertNotNull('Metadata is nil!', FInstantBoolean.Metadata);
  // Metadata.DefaultValue is '';
  FInstantBoolean.Reset;
  AssertEquals('Reset value is incorrect!', False, FInstantBoolean.Value);

  FInstantBoolean.Metadata.DefaultValue := InstantTrueString;
  FInstantBoolean.Reset;
  AssertEquals('Reset value is incorrect!', True, FInstantBoolean.Value);

  FInstantBoolean.Metadata := nil;
  AssertNull('Metadata is not nil!', FInstantBoolean.Metadata);
  FInstantBoolean.Reset;
  AssertEquals('Reset value is incorrect!', False, FInstantBoolean.Value);
end;

procedure TestTInstantBoolean.TestValue;
begin
  AssertEquals('Value is incorrect!', False, FInstantBoolean.Value);
  FInstantBoolean.Value := True;
  AssertEquals('Value is incorrect!', True, FInstantBoolean.Value);
end;

initialization
  // Register any test cases with the test runner
{$IFNDEF CURR_TESTS}
  RegisterTests([TestTInstantBoolean]);
{$ENDIF}

end.
 
Index: TestIO.dpr
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestIO.dpr,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** TestIO.dpr	6 May 2005 05:41:28 -0000	1.7
--- TestIO.dpr	7 May 2005 04:59:48 -0000	1.8
***************
*** 30,36 ****
    TestMinimalModel in 'TestMinimalModel.pas',
    TestInstantAttributeMap in 'TestInstantAttributeMap.pas',
    TestInstantInteger in 'TestInstantInteger.pas',
    TestInstantString in 'TestInstantString.pas',
!   TestInstantDateTime in 'TestInstantDateTime.pas';
  
  {$R *.res}
--- 30,41 ----
    TestMinimalModel in 'TestMinimalModel.pas',
    TestInstantAttributeMap in 'TestInstantAttributeMap.pas',
+   TestInstantAttribute in 'TestInstantAttribute.pas',
+   TestInstantNumeric in 'TestInstantNumeric.pas',
    TestInstantInteger in 'TestInstantInteger.pas',
    TestInstantString in 'TestInstantString.pas',
!   TestInstantDateTime in 'TestInstantDateTime.pas',
!   TestInstantBoolean in 'TestInstantBoolean.pas',
!   TestInstantFloat in 'TestInstantFloat.pas',
!   TestInstantCurrency in 'TestInstantCurrency.pas';
  
  {$R *.res}

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

interface

uses fpcunit, InstantPersistence, InstantMock;

type

  // Test methods for class TInstantCurrency
  TestTInstantCurrency = class(TTestCase)
  private
    FAttrMetadata: TInstantAttributeMetadata;
    FConn: TInstantMockConnector;
    FInstantCurrency: TInstantCurrency;
    FOwner: TInstantObject;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAsCurrency;
    procedure TestAsFloat;
    procedure TestAsInteger;
    procedure TestAssign;
    procedure TestAsString;
    procedure TestAsVariant;
    procedure TestReset;
    procedure TestValue;
  end;

implementation

uses SysUtils, testregistry, InstantClasses;

procedure TestTInstantCurrency.SetUp;
begin
  FConn := TInstantMockConnector.Create(nil);
  FConn.BrokerClass := TInstantMockBroker;
  FOwner := TInstantObject.Create(FConn);
  FAttrMetadata := TInstantAttributeMetadata.Create(nil);
  FAttrMetadata.AttributeClass := TInstantCurrency;
  FAttrMetadata.Name := 'AttrMetadataName';
  FInstantCurrency := TInstantCurrency.Create(FOwner, FAttrMetadata);
  FInstantCurrency.Value := 1.3;
end;

procedure TestTInstantCurrency.TearDown;
begin
  FreeAndNil(FInstantCurrency);
  FreeAndNil(FAttrMetadata);
  FreeAndNil(FOwner);
  FreeAndNil(FConn);
end;

procedure TestTInstantCurrency.TestAsCurrency;
begin
  FInstantCurrency.AsCurrency := 23.45;
  AssertEquals('Set AsCurrency is incorrect!', 23.45, FInstantCurrency.Value);
  AssertEquals('Get AsCurrency is incorrect!', 23.45,
    FInstantCurrency.AsCurrency);
end;

procedure TestTInstantCurrency.TestAsFloat;
begin
  FInstantCurrency.AsFloat := 89.45;
  AssertEquals('Set AsFloat is incorrect!', 89.45, FInstantCurrency.Value);
  AssertEquals('Get AsFloat is incorrect!', 89.45, FInstantCurrency.AsFloat);
end;

procedure TestTInstantCurrency.TestAsInteger;
begin
  FInstantCurrency.AsInteger := 89;
  AssertEquals('Set AsInteger is incorrect!', 89.0, FInstantCurrency.Value);
  AssertEquals('Get AsInteger is incorrect!', 89.0, FInstantCurrency.AsInteger);
end;

procedure TestTInstantCurrency.TestAssign;
var
  vSource: TInstantCurrency;
begin
  AssertEquals('Value is incorrect!', 1.3, FInstantCurrency.Value);
  vSource := TInstantCurrency.Create;
  try
    VSource.Value := 4.3;
    FInstantCurrency.Assign(vSource);
    AssertEquals('Value is incorrect!', 4.3, FInstantCurrency.Value);
  finally
    vSource.Free;
  end;
end;

procedure TestTInstantCurrency.TestAsString;
begin
  FInstantCurrency.AsString := '1.3';
  AssertEquals('Set AsString is incorrect!', 1.3, FInstantCurrency.Value);
  AssertEquals('Get AsString is incorrect!', '1.3', FInstantCurrency.AsString);
end;

procedure TestTInstantCurrency.TestAsVariant;
begin                                           
  FInstantCurrency.AsVariant := 15.1;
  AssertEquals('Set AsVariant is incorrect!', 15.1, FInstantCurrency.Value);
  AssertEquals('Get AsVariant is incorrect!', 15.1, FInstantCurrency.AsVariant);
end;

procedure TestTInstantCurrency.TestReset;
begin
  AssertNotNull('Metadata is nil!', FInstantCurrency.Metadata);
  // Metadata.DefaultValue is '';
  FInstantCurrency.Reset;
  AssertEquals('Reset value is incorrect!', 1.3, FInstantCurrency.Value);

  FInstantCurrency.Metadata.DefaultValue := '15.7';
  FInstantCurrency.Reset;
  AssertEquals('Reset value is incorrect!', 15.7, FInstantCurrency.Value);

  FInstantCurrency.Metadata := nil;
  AssertNull('Metadata is not nil!', FInstantCurrency.Metadata);
  FInstantCurrency.Reset;
  AssertEquals('Reset value is incorrect!', 0.0, FInstantCurrency.Value);
end;

procedure TestTInstantCurrency.TestValue;
begin
  AssertEquals('Value is incorrect!', 1.3, FInstantCurrency.Value);
  FInstantCurrency.Value := 97.2;
  AssertEquals('Value is incorrect!', 97.2, FInstantCurrency.Value);
end;

initialization
  // Register any test cases with the test runner
{$IFNDEF CURR_TESTS}
  RegisterTests([TestTInstantCurrency]);
{$ENDIF}

end.
 

[Instantobjects-cvscommit] Source/Tests TestInstantDateTime.pas,NONE,1.1 TestInstantString.pas,NONE,1.1 TestIO.dpr,1.6,1.7 TestInstantInteger.pas,1.1,1.2

[Steven M. <sr...@us...>]

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

Modified Files:
	TestIO.dpr TestInstantInteger.pas 
Added Files:
	TestInstantDateTime.pas TestInstantString.pas 
Log Message:
Add tests for TInstantString and TInstantDateTime classes.
Minor edits to TInstantInteger class tests.

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

interface

uses fpcunit, InstantPersistence, InstantMock;

type

  // Test methods for class TInstantDateTime
  TestTInstantDateTime = class(TTestCase)
  private
    FAttrMetadata: TInstantAttributeMetadata;
    FConn: TInstantMockConnector;
    FInstantDateTime: TInstantDateTime;
    FOwner: TInstantObject;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAsBoolean;
    procedure TestAsCurrency;
    procedure TestAsDateTime;
    procedure TestAsFloat;
    procedure TestAsInteger;
    procedure TestAsObject;
    procedure TestAssign;
    procedure TestAsString;
    procedure TestAsVariant;
    procedure TestChange;
    procedure TestCheckHasMetadata;
    procedure TestDisplayText;
    procedure TestIsDefault;
    procedure TestIsIndexed;
    procedure TestIsMandatory;
    procedure TestIsRequired;
    procedure TestMetadata;
    procedure TestName;
    procedure TestOwner;
    procedure TestReset;
    procedure TestValue;
  end;

implementation

uses SysUtils, testregistry, InstantClasses;

procedure TestTInstantDateTime.SetUp;
begin
  FConn := TInstantMockConnector.Create(nil);
  FConn.BrokerClass := TInstantMockBroker;
  FOwner := TInstantObject.Create(FConn);
  FAttrMetadata := TInstantAttributeMetadata.Create(nil);
  FAttrMetadata.AttributeClass := TInstantDateTime;
  FAttrMetadata.Name := 'AttrMetadataName';
  FInstantDateTime := TInstantDateTime.Create(FOwner, FAttrMetadata);
  FInstantDateTime.Value := 100.5;
end;

procedure TestTInstantDateTime.TearDown;
begin
  FreeAndNil(FInstantDateTime);
  FreeAndNil(FAttrMetadata);
  FreeAndNil(FOwner);
  FreeAndNil(FConn);
end;

procedure TestTInstantDateTime.TestAsBoolean;
begin
  try
    FInstantDateTime.AsBoolean := True;
    Fail('Exception was not thrown for Set AsBoolean!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
  try
    FInstantDateTime.AsBoolean;
    Fail('Exception was not thrown for Get AsBoolean!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
end;

procedure TestTInstantDateTime.TestAsCurrency;
begin
  try
    FInstantDateTime.AsCurrency := 20.5;
    Fail('Exception was not thrown for Set AsCurrency!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
  try
    FInstantDateTime.AsCurrency;
    Fail('Exception was not thrown for Get AsCurrency!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
end;

procedure TestTInstantDateTime.TestAsDateTime;
begin
  FInstantDateTime.AsDateTime := 12.45;
  AssertEquals('Set AsDateTime is incorrect!', 12.45,
    FInstantDateTime.Value);
  AssertEquals('Get AsDateTime is incorrect!', 12.45,
    FInstantDateTime.AsDateTime);
end;

procedure TestTInstantDateTime.TestAsFloat;
begin
  try
    FInstantDateTime.AsFloat := 20.5;
    Fail('Exception was not thrown for Set AsFloat!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
  try
    FInstantDateTime.AsFloat;
    Fail('Exception was not thrown for Get AsFloat!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
end;

procedure TestTInstantDateTime.TestAsInteger;
begin
  try
    FInstantDateTime.AsInteger := 20;
    Fail('Exception was not thrown for Set AsInteger!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
  try
    FInstantDateTime.AsInteger;
    Fail('Exception was not thrown for Get AsInteger!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
end;

procedure TestTInstantDateTime.TestAsObject;
begin
  try
    FInstantDateTime.AsObject := TInstantObject.Create(FConn);
    Fail('Exception was not thrown for Set AsObject!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
  try
    FInstantDateTime.AsObject;
    Fail('Exception was not thrown for Get AsObject!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
end;

procedure TestTInstantDateTime.TestAssign;
var
  vSource: TInstantDateTime;
begin
  AssertEquals('String value is incorrect!', 100.5,
    FInstantDateTime.Value);

  vSource := TInstantDateTime.Create;
  try
    VSource.Value := 115.3;
    FInstantDateTime.Assign(vSource);
    AssertEquals('String value is incorrect!', 115.3,
      FInstantDateTime.Value);
  finally
    vSource.Free;
  end;
end;

procedure TestTInstantDateTime.TestAsString;
begin
  FInstantDateTime.AsString := DateTimeToStr(14.5);
  AssertEquals('Set AsString is incorrect!', 14.5,
    FInstantDateTime.Value);
  AssertEquals('Get AsString is incorrect!', DateTimeToStr(14.5),
    FInstantDateTime.AsString);
end;

procedure TestTInstantDateTime.TestAsVariant;
begin                                           
  FInstantDateTime.AsVariant := 150.6;
  AssertEquals('Set AsVariant is incorrect!', 150.6,
    FInstantDateTime.Value);
  AssertEquals('Get AsVariant is incorrect!', 150.6,
    FInstantDateTime.AsVariant);
end;

procedure TestTInstantDateTime.TestChange;
begin
  AssertTrue('IsChanged is false!', FInstantDateTime.IsChanged);
  FInstantDateTime.UnChanged;
  AssertFalse('IsChanged is true!', FInstantDateTime.IsChanged);
  FInstantDateTime.Value := FInstantDateTime.Value + 30;
  AssertTrue('IsChanged is false!', FInstantDateTime.IsChanged);
  FInstantDateTime.UnChanged;
  AssertFalse('IsChanged is true!', FInstantDateTime.IsChanged);
  FInstantDateTime.Changed;
  AssertTrue('IsChanged is false!', FInstantDateTime.IsChanged);
end;

procedure TestTInstantDateTime.TestCheckHasMetadata;
begin
  try
    FInstantDateTime.CheckHasMetadata;
  except
    Fail('CheckHasMetadata failed!');
  end;

  FInstantDateTime.Metadata := nil;
  AssertException(EInstantError, FInstantDateTime.CheckHasMetadata);
end;

procedure TestTInstantDateTime.TestDisplayText;
var
  vDateTimeStr: string;
begin
  AssertEquals('DisplayText is incorrect!', FInstantDateTime.AsString,
    FInstantDateTime.DisplayText);

  DateTimeToString(vDateTimeStr, 'yyyymmddhhnnsszzz', FInstantDateTime.Value);
  FInstantDateTime.Metadata.EditMask := 'yyyymmddhhnnsszzz';
  AssertEquals('DisplayText is incorrect!', vDateTimeStr,
  FInstantDateTime.DisplayText);

  FInstantDateTime.Value := 113.8;
  DateTimeToString(vDateTimeStr, 'dd mmm yyyy hh:nn:ss ampm',
    FInstantDateTime.Value);
  FInstantDateTime.Metadata.EditMask := 'dd mmm yyyy hh:nn:ss ampm';
  AssertEquals('DisplayText is incorrect!', vDateTimeStr,
    FInstantDateTime.DisplayText);
end;

procedure TestTInstantDateTime.TestIsDefault;
begin
  AssertFalse('Value is default!', FInstantDateTime.IsDefault);

  FInstantDateTime.Value := 0;
  AssertTrue('Value is not default!', FInstantDateTime.IsDefault);
end;

procedure TestTInstantDateTime.TestIsIndexed;
begin
  AssertFalse('Attribute is indexed!', FInstantDateTime.IsIndexed);

  FInstantDateTime.Metadata.IsIndexed := True;
  AssertTrue('Attribute is not indexed!', FInstantDateTime.IsIndexed);
end;

procedure TestTInstantDateTime.TestIsMandatory;
begin
  AssertFalse('Attribute is Mandatory!', FInstantDateTime.IsMandatory);

  FInstantDateTime.Metadata.IsIndexed := True;
  AssertTrue('Attribute is not Mandatory!', FInstantDateTime.IsMandatory);
  FInstantDateTime.Metadata.IsRequired := True;
  AssertTrue('Attribute is not Mandatory!', FInstantDateTime.IsMandatory);
  FInstantDateTime.Metadata.IsIndexed := False;
  AssertTrue('Attribute is not Mandatory!', FInstantDateTime.IsMandatory);
end;

procedure TestTInstantDateTime.TestIsRequired;
begin
  AssertFalse('Attribute is required!', FInstantDateTime.IsRequired);

  FInstantDateTime.Metadata.IsRequired := True;
  AssertTrue('Attribute is not required!', FInstantDateTime.IsRequired);
end;

procedure TestTInstantDateTime.TestMetadata;
begin
  AssertNotNull('Metadata is nil!', FInstantDateTime.Metadata);
  AssertEquals('Metdata name is incorrect!', 'AttrMetadataName',
    FInstantDateTime.Metadata.Name);

  FInstantDateTime.Metadata := nil;
  AssertNull('Metadata is not nil!', FInstantDateTime.Metadata);
  FInstantDateTime.Reset;

  FInstantDateTime.Metadata := FAttrMetadata;
  AssertNotNull('Metadata is nil!', FInstantDateTime.Metadata);
  AssertEquals('Metdata name is incorrect!', 'AttrMetadataName',
    FInstantDateTime.Metadata.Name);
end;

procedure TestTInstantDateTime.TestName;
begin
  AssertEquals('Attribute name is incorrect!', 'AttrMetadataName',
    FInstantDateTime.Name);
end;

procedure TestTInstantDateTime.TestOwner;
begin
  AssertSame('Owner is incorrect!', FOwner, FInstantDateTime.Owner);
end;

procedure TestTInstantDateTime.TestReset;
var
  vDateTimeStr: string;
begin
  AssertNotNull('Metadata is nil!', FInstantDateTime.Metadata);
  // Metadata.DefaultValue is '';
  FInstantDateTime.Reset;
  AssertEquals('Reset value is incorrect!', 0, FInstantDateTime.Value);

  DateTimeToString(vDateTimeStr, 'yyyymmddhhnnsszzz', 100.5);
  FInstantDateTime.Metadata.DefaultValue := vDateTimeStr;
  FInstantDateTime.Reset;
  AssertEquals('Reset value is incorrect!', 100.5, FInstantDateTime.Value);

  FInstantDateTime.Metadata := nil;
  AssertNull('Metadata is not nil!', FInstantDateTime.Metadata);
  FInstantDateTime.Reset;
  AssertEquals('Reset value is incorrect!', 0, FInstantDateTime.Value);
end;

procedure TestTInstantDateTime.TestValue;
begin
  AssertEquals('Value is incorrect!', 100.5, FInstantDateTime.Value);
  FInstantDateTime.Value := 151.3;
  AssertEquals('Value is incorrect!', 151.3, FInstantDateTime.Value);
end;

initialization
  // Register any test cases with the test runner
{$IFNDEF CURR_TESTS}
  RegisterTests([TestTInstantDateTime]);
{$ENDIF}

end.
 
--- NEW FILE: TestInstantString.pas ---
unit TestInstantString;

interface

uses fpcunit, InstantPersistence, InstantMock;

type

  // Test methods for class TInstantString
  TestTInstantString = class(TTestCase)
  private
    FAttrMetadata: TInstantAttributeMetadata;
    FConn: TInstantMockConnector;
    FInstantString: TInstantString;
    FOwner: TInstantObject;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAsBoolean;
    procedure TestAsCurrency;
    procedure TestAsDateTime;
    procedure TestAsFloat;
    procedure TestAsInteger;
    procedure TestAsObject;
    procedure TestAssign;
    procedure TestAsString;
    procedure TestAsVariant;
    procedure TestChange;
    procedure TestCheckHasMetadata;
    procedure TestDisplayText;
    procedure TestIsDefault;
    procedure TestIsIndexed;
    procedure TestIsMandatory;
    procedure TestIsRequired;
    procedure TestMetadata;
    procedure TestName;
    procedure TestOwner;
    procedure TestReset;
    procedure TestValue;
  end;

implementation

uses SysUtils, testregistry, InstantClasses;

procedure TestTInstantString.SetUp;
begin
  FConn := TInstantMockConnector.Create(nil);
  FConn.BrokerClass := TInstantMockBroker;
  FOwner := TInstantObject.Create(FConn);
  FAttrMetadata := TInstantAttributeMetadata.Create(nil);
  FAttrMetadata.AttributeClass := TInstantString;
  FAttrMetadata.Name := 'AttrMetadataName';
  FInstantString := TInstantString.Create(FOwner, FAttrMetadata);
  FInstantString.Value := 'StringValue';
end;

procedure TestTInstantString.TearDown;
begin
  FreeAndNil(FInstantString);
  FreeAndNil(FAttrMetadata);
  FreeAndNil(FOwner);
  FreeAndNil(FConn);
end;

procedure TestTInstantString.TestAsBoolean;
begin
  FInstantString.AsBoolean := True;
  AssertEquals('Set AsBoolean is incorrect!', 'True', FInstantString.Value);
  AssertTrue('Get AsBoolean is false!', FInstantString.AsBoolean);

  FInstantString.AsBoolean := False;
  AssertEquals('Set AsBoolean is incorrect!', 'False', FInstantString.Value);
  AssertFalse('Get AsBoolean is true!', FInstantString.AsBoolean);
end;

procedure TestTInstantString.TestAsCurrency;
begin
  FInstantString.AsCurrency := 23.45;
  AssertEquals('Set AsCurrency is incorrect!', '23.45', FInstantString.Value);
  AssertEquals('Get AsCurrency is incorrect!', 23.45,
    FInstantString.AsCurrency);
end;

procedure TestTInstantString.TestAsDateTime;
begin
  FInstantString.AsDateTime := 12.45;
  AssertEquals('Set AsDateTime is incorrect!', DateTimeToStr(12.45),
    FInstantString.Value);
  AssertEquals('Get AsDateTime is incorrect!', 12.45,
    FInstantString.AsDateTime);
end;

procedure TestTInstantString.TestAsFloat;
begin
  FInstantString.AsFloat := 89.45;
  AssertEquals('Set AsFloat is incorrect!', '89.45', FInstantString.Value);
  AssertEquals('Get AsFloat is incorrect!', 89.45, FInstantString.AsFloat);
end;

procedure TestTInstantString.TestAsInteger;
begin
  FInstantString.AsInteger := 100;
  AssertEquals('Set AsInteger is incorrect!', '100', FInstantString.Value);
  AssertEquals('Get AsInteger is incorrect!', 100, FInstantString.AsInteger);
end;

procedure TestTInstantString.TestAsObject;
begin
  try
    FInstantString.AsObject := TInstantObject.Create(FConn);
    Fail('Exception was not thrown for Set AsObject!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
  try
    FInstantString.AsObject;
    Fail('Exception was not thrown for Get AsObject!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
end;

procedure TestTInstantString.TestAssign;
var
  vSource: TInstantString;
begin
  AssertEquals('String value is incorrect!', 'StringValue',
    FInstantString.Value);

  vSource := TInstantString.Create;
  try
    VSource.Value := 'DifferentString';
    FInstantString.Assign(vSource);
    AssertEquals('String value is incorrect!', 'DifferentString',
      FInstantString.Value);
  finally
    vSource.Free;
  end;
end;

procedure TestTInstantString.TestAsString;
begin
  FInstantString.AsString := 'DifferentString';
  AssertEquals('Set AsString is incorrect!', 'DifferentString',
    FInstantString.Value);
  AssertEquals('Get AsString is incorrect!', 'DifferentString',
    FInstantString.AsString);
end;

procedure TestTInstantString.TestAsVariant;
begin                                           
  FInstantString.AsVariant := 'DifferentString';
  AssertEquals('Set AsVariant is incorrect!', 'DifferentString',
    FInstantString.Value);
  AssertEquals('Get AsVariant is incorrect!', 'DifferentString',
    FInstantString.AsVariant);
end;

procedure TestTInstantString.TestChange;
begin
  AssertTrue('IsChanged is false!', FInstantString.IsChanged);
  FInstantString.UnChanged;
  AssertFalse('IsChanged is true!', FInstantString.IsChanged);
  FInstantString.Value := FInstantString.Value + 's';
  AssertTrue('IsChanged is false!', FInstantString.IsChanged);
  FInstantString.UnChanged;
  AssertFalse('IsChanged is true!', FInstantString.IsChanged);
  FInstantString.Changed;
  AssertTrue('IsChanged is false!', FInstantString.IsChanged);
end;

procedure TestTInstantString.TestCheckHasMetadata;
begin
  try
    FInstantString.CheckHasMetadata;
  except
    Fail('CheckHasMetadata failed!');
  end;

  FInstantString.Metadata := nil;
  AssertException(EInstantError, FInstantString.CheckHasMetadata);
end;

procedure TestTInstantString.TestDisplayText;
begin
  AssertEquals('DisplayText is incorrect!', 'StringValue',
    FInstantString.DisplayText);

  FInstantString.Metadata.EditMask := '!CCCCCC';
  AssertEquals('DisplayText is incorrect!', 'gValue',
  FInstantString.DisplayText);

  FInstantString.Value := 'NewString';
  FInstantString.Metadata.EditMask := 'CCCCCC';
  AssertEquals('DisplayText is incorrect!', 'NewStr',
    FInstantString.DisplayText);
end;

procedure TestTInstantString.TestIsDefault;
begin
  AssertFalse('Value is default!', FInstantString.IsDefault);

  FInstantString.Value := '';
  AssertTrue('Value is not default!', FInstantString.IsDefault);
end;

procedure TestTInstantString.TestIsIndexed;
begin
  AssertFalse('Attribute is indexed!', FInstantString.IsIndexed);

  FInstantString.Metadata.IsIndexed := True;
  AssertTrue('Attribute is not indexed!', FInstantString.IsIndexed);
end;

procedure TestTInstantString.TestIsMandatory;
begin
  AssertFalse('Attribute is Mandatory!', FInstantString.IsMandatory);

  FInstantString.Metadata.IsIndexed := True;
  AssertTrue('Attribute is not Mandatory!', FInstantString.IsMandatory);
  FInstantString.Metadata.IsRequired := True;
  AssertTrue('Attribute is not Mandatory!', FInstantString.IsMandatory);
  FInstantString.Metadata.IsIndexed := False;
  AssertTrue('Attribute is not Mandatory!', FInstantString.IsMandatory);
end;

procedure TestTInstantString.TestIsRequired;
begin
  AssertFalse('Attribute is required!', FInstantString.IsRequired);

  FInstantString.Metadata.IsRequired := True;
  AssertTrue('Attribute is not required!', FInstantString.IsRequired);
end;

procedure TestTInstantString.TestMetadata;
begin
  AssertNotNull('Metadata is nil!', FInstantString.Metadata);
  AssertEquals('Metdata name is incorrect!', 'AttrMetadataName',
    FInstantString.Metadata.Name);

  FInstantString.Metadata := nil;
  AssertNull('Metadata is not nil!', FInstantString.Metadata);
  FInstantString.Reset;

  FInstantString.Metadata := FAttrMetadata;
  AssertNotNull('Metadata is nil!', FInstantString.Metadata);
  AssertEquals('Metdata name is incorrect!', 'AttrMetadataName',
    FInstantString.Metadata.Name);
end;

procedure TestTInstantString.TestName;
begin
  AssertEquals('Attribute name is incorrect!', 'AttrMetadataName',
    FInstantString.Name);
end;

procedure TestTInstantString.TestOwner;
begin
  AssertSame('Owner is incorrect!', FOwner, FInstantString.Owner);
end;

procedure TestTInstantString.TestReset;
begin
  AssertNotNull('Metadata is nil!', FInstantString.Metadata);
  // Metadata.DefaultValue is '';
  FInstantString.Reset;
  AssertEquals('Reset value is incorrect!', '', FInstantString.Value);

  FInstantString.Metadata.DefaultValue := '1000';
  FInstantString.Reset;
  AssertEquals('Reset value is incorrect!', '1000', FInstantString.Value);

  FInstantString.Metadata := nil;
  AssertNull('Metadata is not nil!', FInstantString.Metadata);
  FInstantString.Reset;
  AssertEquals('Reset value is incorrect!', '', FInstantString.Value);
end;

procedure TestTInstantString.TestValue;
begin
  AssertEquals('Value is incorrect!', 'StringValue', FInstantString.Value);
  FInstantString.Value := 'NewValue';
  AssertEquals('Value is incorrect!', 'NewValue', FInstantString.Value);
end;

initialization
  // Register any test cases with the test runner
{$IFNDEF CURR_TESTS}
  RegisterTests([TestTInstantString]);
{$ENDIF}

end.
 
Index: TestInstantInteger.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestInstantInteger.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** TestInstantInteger.pas	5 May 2005 07:15:01 -0000	1.1
--- TestInstantInteger.pas	6 May 2005 05:41:28 -0000	1.2
***************
*** 224,228 ****
  procedure TestTInstantInteger.TestIsRequired;
  begin
-   // TODO -cMM: TestTInstantInteger.TestIsRequired default body inserted
    AssertFalse('Attribute is required!', FInstantInteger.IsRequired);
  
--- 224,227 ----
***************
*** 260,267 ****
  procedure TestTInstantInteger.TestReset;
  begin
    // Metadata.DefaultValue is '';
    FInstantInteger.Reset;
    AssertEquals('Reset value is incorrect!', 0, FInstantInteger.Value);
-   AssertNotNull('Metadata is nil!', FInstantInteger.Metadata);
  
    FInstantInteger.Metadata.DefaultValue := '1000';
--- 259,266 ----
  procedure TestTInstantInteger.TestReset;
  begin
+   AssertNotNull('Metadata is nil!', FInstantInteger.Metadata);
    // Metadata.DefaultValue is '';
    FInstantInteger.Reset;
    AssertEquals('Reset value is incorrect!', 0, FInstantInteger.Value);
  
    FInstantInteger.Metadata.DefaultValue := '1000';

Index: TestIO.dpr
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestIO.dpr,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** TestIO.dpr	5 May 2005 07:15:03 -0000	1.6
--- TestIO.dpr	6 May 2005 05:41:28 -0000	1.7
***************
*** 30,34 ****
    TestMinimalModel in 'TestMinimalModel.pas',
    TestInstantAttributeMap in 'TestInstantAttributeMap.pas',
!   TestInstantInteger in 'TestInstantInteger.pas';
  
  {$R *.res}
--- 30,36 ----
    TestMinimalModel in 'TestMinimalModel.pas',
    TestInstantAttributeMap in 'TestInstantAttributeMap.pas',
!   TestInstantInteger in 'TestInstantInteger.pas',
!   TestInstantString in 'TestInstantString.pas',
!   TestInstantDateTime in 'TestInstantDateTime.pas';
  
  {$R *.res}

[Instantobjects-cvscommit] Source/Tests TestInstantInteger.pas,NONE,1.1 TestIO.dpr,1.5,1.6

[Steven M. <sr...@us...>]

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

Modified Files:
	TestIO.dpr 
Added Files:
	TestInstantInteger.pas 
Log Message:
Added TInstantInteger Tests

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

interface

uses fpcunit, InstantPersistence, InstantMock;

type

  // Test methods for class TInstantInteger
  TestTInstantInteger = class(TTestCase)
  private
    FAttrMetadata: TInstantAttributeMetadata;
    FConn: TInstantMockConnector;
    FInstantInteger: TInstantInteger;
    FOwner: TInstantObject;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAsBoolean;
    procedure TestAsCurrency;
    procedure TestAsDateTime;
    procedure TestAsFloat;
    procedure TestAsInteger;
    procedure TestAsObject;
    procedure TestAssign;
    procedure TestAsString;
    procedure TestAsVariant;
    procedure TestChange;
    procedure TestCheckHasMetadata;
    procedure TestDisplayText;
    procedure TestIsDefault;
    procedure TestIsIndexed;
    procedure TestIsMandatory;
    procedure TestIsRequired;
    procedure TestMetadata;
    procedure TestName;
    procedure TestOwner;
    procedure TestReset;
    procedure TestValue;
  end;

implementation

uses SysUtils, testregistry, InstantClasses;

procedure TestTInstantInteger.SetUp;
begin
  FConn := TInstantMockConnector.Create(nil);
  FConn.BrokerClass := TInstantMockBroker;
  FOwner := TInstantObject.Create(FConn);
  FAttrMetadata := TInstantAttributeMetadata.Create(nil);
  FAttrMetadata.AttributeClass := TInstantInteger;
  FAttrMetadata.Name := 'AttrMetadataName';
  FInstantInteger := TInstantInteger.Create(FOwner, FAttrMetadata);
  FInstantInteger.Value := 1;
end;

procedure TestTInstantInteger.TearDown;
begin
  FreeAndNil(FInstantInteger);
  FreeAndNil(FAttrMetadata);
  FreeAndNil(FOwner);
  FreeAndNil(FConn);
end;

procedure TestTInstantInteger.TestAsBoolean;
begin
  FInstantInteger.AsBoolean := True;
  AssertEquals('Set AsBoolean is incorrect!', 1, FInstantInteger.Value);
  AssertTrue('Get AsBoolean is false!', FInstantInteger.AsBoolean);

  FInstantInteger.AsBoolean := False;
  AssertEquals('Set AsBoolean is incorrect!', 0, FInstantInteger.Value);
  AssertFalse('Get AsBoolean is true!', FInstantInteger.AsBoolean);
end;

procedure TestTInstantInteger.TestAsCurrency;
begin
  FInstantInteger.AsCurrency := 23.45;
  AssertEquals('Set AsCurrency is incorrect!', 23, FInstantInteger.Value);
  AssertEquals('Get AsCurrency is incorrect!', 23.0,
    FInstantInteger.AsCurrency);
end;

procedure TestTInstantInteger.TestAsDateTime;
begin
  FInstantInteger.AsDateTime := 12.45;
  AssertEquals('Set AsDateTime is incorrect!', 12, FInstantInteger.Value);
  AssertEquals('Get AsDateTime is incorrect!', 12.0,
    FInstantInteger.AsDateTime);
end;

procedure TestTInstantInteger.TestAsFloat;
begin
  FInstantInteger.AsFloat := 89.45;
  AssertEquals('Set AsFloat is incorrect!', 89, FInstantInteger.Value);
  AssertEquals('Get AsFloat is incorrect!', 89.0, FInstantInteger.AsFloat);
end;

procedure TestTInstantInteger.TestAsInteger;
begin
  FInstantInteger.AsInteger := 100;
  AssertEquals('Set AsInteger is incorrect!', 100, FInstantInteger.Value);
  AssertEquals('Get AsInteger is incorrect!', 100, FInstantInteger.AsInteger);
end;

procedure TestTInstantInteger.TestAsObject;
begin
  try
    FInstantInteger.AsObject := TInstantObject.Create(FConn);
    Fail('Exception was not thrown for Set AsObject!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
  try
    FInstantInteger.AsObject;
    Fail('Exception was not thrown for Get AsObject!'); // should never get here
  except
    on E: EInstantAccessError do ; // do nothing as this is expected
    else
      raise;
  end;
end;

procedure TestTInstantInteger.TestAssign;
var
  vSource: TInstantInteger;
begin
  AssertEquals('Integer value is incorrect!', 1, FInstantInteger.Value);

  vSource := TInstantInteger.Create;
  try
    VSource.Value := 200;
    FInstantInteger.Assign(vSource);
    AssertEquals('Integer value is incorrect!', 200, FInstantInteger.Value);
  finally
    vSource.Free;
  end;
end;

procedure TestTInstantInteger.TestAsString;
begin
  FInstantInteger.AsString := '73';
  AssertEquals('Set AsString is incorrect!', 73, FInstantInteger.Value);
  AssertEquals('Get AsString is incorrect!', '73', FInstantInteger.AsString);
end;

procedure TestTInstantInteger.TestAsVariant;
begin                                           
  FInstantInteger.AsVariant := 15;
  AssertEquals('Set AsVariant is incorrect!', 15, FInstantInteger.Value);
  AssertEquals('Get AsVariant is incorrect!', 15, FInstantInteger.AsVariant);
end;

procedure TestTInstantInteger.TestChange;
begin
  AssertTrue('IsChanged is false!', FInstantInteger.IsChanged);
  FInstantInteger.UnChanged;
  AssertFalse('IsChanged is true!', FInstantInteger.IsChanged);
  FInstantInteger.Value := FInstantInteger.Value + 1;
  AssertTrue('IsChanged is false!', FInstantInteger.IsChanged);
  FInstantInteger.UnChanged;
  AssertFalse('IsChanged is true!', FInstantInteger.IsChanged);
  FInstantInteger.Changed;
  AssertTrue('IsChanged is false!', FInstantInteger.IsChanged);
end;

procedure TestTInstantInteger.TestCheckHasMetadata;
begin
  try
    FInstantInteger.CheckHasMetadata;
  except
    Fail('CheckHasMetadata failed!');
  end;

  FInstantInteger.Metadata := nil;
  AssertException(EInstantError, FInstantInteger.CheckHasMetadata);
end;

procedure TestTInstantInteger.TestDisplayText;
begin
  AssertEquals('DisplayText is incorrect!', '1', FInstantInteger.DisplayText);

  FInstantInteger.Metadata.EditMask := '000';
  AssertEquals('DisplayText is incorrect!', '001', FInstantInteger.DisplayText);

  FInstantInteger.Value := 1000;
  FInstantInteger.Metadata.EditMask := '#' + ThousandSeparator + '000';
  AssertEquals('DisplayText is incorrect!', '1' + ThousandSeparator + '000',
    FInstantInteger.DisplayText);
end;

procedure TestTInstantInteger.TestIsDefault;
begin
  AssertFalse('Value is default!', FInstantInteger.IsDefault);

  FInstantInteger.Value := 0;
  AssertTrue('Value is not default!', FInstantInteger.IsDefault);
end;

procedure TestTInstantInteger.TestIsIndexed;
begin
  AssertFalse('Attribute is indexed!', FInstantInteger.IsIndexed);

  FInstantInteger.Metadata.IsIndexed := True;
  AssertTrue('Attribute is not indexed!', FInstantInteger.IsIndexed);
end;

procedure TestTInstantInteger.TestIsMandatory;
begin
  AssertFalse('Attribute is Mandatory!', FInstantInteger.IsMandatory);

  FInstantInteger.Metadata.IsIndexed := True;
  AssertTrue('Attribute is not Mandatory!', FInstantInteger.IsMandatory);
  FInstantInteger.Metadata.IsRequired := True;
  AssertTrue('Attribute is not Mandatory!', FInstantInteger.IsMandatory);
  FInstantInteger.Metadata.IsIndexed := False;
  AssertTrue('Attribute is not Mandatory!', FInstantInteger.IsMandatory);
end;

procedure TestTInstantInteger.TestIsRequired;
begin
  // TODO -cMM: TestTInstantInteger.TestIsRequired default body inserted
  AssertFalse('Attribute is required!', FInstantInteger.IsRequired);

  FInstantInteger.Metadata.IsRequired := True;
  AssertTrue('Attribute is not required!', FInstantInteger.IsRequired);
end;

procedure TestTInstantInteger.TestMetadata;
begin
  AssertNotNull('Metadata is nil!', FInstantInteger.Metadata);
  AssertEquals('Metdata name is incorrect!', 'AttrMetadataName',
    FInstantInteger.Metadata.Name);

  FInstantInteger.Metadata := nil;
  AssertNull('Metadata is not nil!', FInstantInteger.Metadata);
  FInstantInteger.Reset;

  FInstantInteger.Metadata := FAttrMetadata;
  AssertNotNull('Metadata is nil!', FInstantInteger.Metadata);
  AssertEquals('Metdata name is incorrect!', 'AttrMetadataName',
    FInstantInteger.Metadata.Name);
end;

procedure TestTInstantInteger.TestName;
begin
  AssertEquals('Attribute name is incorrect!', 'AttrMetadataName',
    FInstantInteger.Name);
end;

procedure TestTInstantInteger.TestOwner;
begin
  AssertSame('Owner is incorrect!', FOwner, FInstantInteger.Owner);
end;

procedure TestTInstantInteger.TestReset;
begin
  // Metadata.DefaultValue is '';
  FInstantInteger.Reset;
  AssertEquals('Reset value is incorrect!', 0, FInstantInteger.Value);
  AssertNotNull('Metadata is nil!', FInstantInteger.Metadata);

  FInstantInteger.Metadata.DefaultValue := '1000';
  FInstantInteger.Reset;
  AssertEquals('Reset value is incorrect!', 1000, FInstantInteger.Value);

  FInstantInteger.Metadata := nil;
  AssertNull('Metadata is not nil!', FInstantInteger.Metadata);
  FInstantInteger.Reset;
  AssertEquals('Reset value is incorrect!', 0, FInstantInteger.Value);
end;

procedure TestTInstantInteger.TestValue;
begin
  AssertEquals('Value is incorrect!', 1, FInstantInteger.Value);
  FInstantInteger.Value := 1000;
  AssertEquals('Value is incorrect!', 1000, FInstantInteger.Value);
end;

initialization
  // Register any test cases with the test runner
{$IFNDEF CURR_TESTS}
  RegisterTests([TestTInstantInteger]);
{$ENDIF}

end.
 
Index: TestIO.dpr
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestIO.dpr,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** TestIO.dpr	4 May 2005 05:02:44 -0000	1.5
--- TestIO.dpr	5 May 2005 07:15:03 -0000	1.6
***************
*** 29,33 ****
    TestInstantRtti in 'TestInstantRtti.pas',
    TestMinimalModel in 'TestMinimalModel.pas',
!   TestInstantAttributeMap in 'TestInstantAttributeMap.pas';
  
  {$R *.res}
--- 29,34 ----
    TestInstantRtti in 'TestInstantRtti.pas',
    TestMinimalModel in 'TestMinimalModel.pas',
!   TestInstantAttributeMap in 'TestInstantAttributeMap.pas',
!   TestInstantInteger in 'TestInstantInteger.pas';
  
  {$R *.res}

[Instantobjects-cvscommit] Source/Tests TestInstantAttributeMap.pas,NONE,1.1 TestIO.dpr,1.4,1.5

[Steven M. <sr...@us...>]

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

Modified Files:
	TestIO.dpr 
Added Files:
	TestInstantAttributeMap.pas 
Log Message:
Add InstantAttributeMap(s) tests

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

interface

uses fpcunit, InstantPersistence;

type

  // Test methods for class TInstantAttributeMap
  TestTInstantAttributeMap = class(TTestCase)
  private
    FClassMetadata: TInstantClassMetadata;
    FInstantAttributeMap: TInstantAttributeMap;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAdd;
    procedure TestAddUnique;
    procedure TestClassMetadata;
    procedure TestFind;
    procedure TestIndexOf;
    procedure TestInsert;
    procedure TestIsRootMap;
    procedure TestItems;
    procedure TestRemove;
  end;

  // Test methods for class TInstantAttributeMaps
  TestTInstantAttributeMaps = class(TTestCase)
  private
    FClassMetadata: TInstantClassMetadata;
    FInstantAttributeMaps: TInstantAttributeMaps;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAdd;
    procedure TestAddItem;
    procedure TestFind;
    procedure TestFindMap;
    procedure TestEnsureMap;
    procedure TestIndexOf;
    procedure TestInsert;
    procedure TestItems;
    procedure TestRemove;
    procedure TestRootMap;
  end;

implementation

uses SysUtils, testregistry;

procedure TestTInstantAttributeMap.SetUp;
var
  vItem: TInstantAttributeMetadata;
  i: Integer;
begin
  FClassMetadata := TInstantClassMetadata.Create(nil);
  FClassMetadata.TableName := 'TableName';

  FInstantAttributeMap := TInstantAttributeMap.Create(FClassMetadata);
  // Make it the root map
  FInstantAttributeMap.Name := 'TableName';

  for i := 1 to 3 do
  begin
    vItem := TInstantAttributeMetadata.Create(nil);
    vItem.Name := 'Item' + IntToStr(i);
    FInstantAttributeMap.Add(vItem);
  end;
  AssertEquals('AttributeMap count is incorrect!', 3,
    FInstantAttributeMap.Count);
end;

procedure TestTInstantAttributeMap.TearDown;
var
  i: Integer;
begin
  // FInstantAttributeMap is ultimately a TList descendent
  // and does not free its object contents.
  for i := FInstantAttributeMap.Count - 1 downto 0 do
    FInstantAttributeMap[i].Free;
  FreeAndNil(FInstantAttributeMap);
  FreeAndNil(FClassMetadata);
end;

procedure TestTInstantAttributeMap.TestAdd;
var
  vReturnValue: Integer;
  vItem: TInstantAttributeMetadata;
begin
  vItem := TInstantAttributeMetadata.Create(nil);
  vReturnValue := FInstantAttributeMap.Add(vItem);
  AssertEquals('AttributeMap item index is incorrect!', 3, vReturnValue);
  AssertEquals('AttributeMap count is incorrect!', 4,
    FInstantAttributeMap.Count);
end;

procedure TestTInstantAttributeMap.TestAddUnique;
var
  vReturnValue: Integer;
  vItem: TInstantAttributeMetadata;
begin
  // Add non-unique named item
  vItem := TInstantAttributeMetadata.Create(nil);
  vItem.Name := 'Item1';      // Existing name
  vReturnValue := FInstantAttributeMap.AddUnique(vItem);
  AssertEquals('AddUnique return value is incorrect!', -1, vReturnValue);
  AssertEquals('AttributeMap count is incorrect!', 3,
    FInstantAttributeMap.Count);

  // Add unique named item
  vItem := TInstantAttributeMetadata.Create(nil);
  vItem.Name := 'NewItem';    // New name
  vReturnValue := FInstantAttributeMap.AddUnique(vItem);
  AssertEquals('AddUnique return value is incorrect!', 3, vReturnValue);
  AssertEquals('AttributeMap count is incorrect!', 4,
    FInstantAttributeMap.Count);
end;

procedure TestTInstantAttributeMap.TestClassMetadata;
begin
  AssertSame('ClassMetadata value is incorrect!', FClassMetadata,
    FInstantAttributeMap.ClassMetadata);
end;

procedure TestTInstantAttributeMap.TestFind;
var
  vReturnValue: TInstantAttributeMetadata;
  vName: string;
begin
  // Find with existing name
  vName := 'Item2';
  vReturnValue := FInstantAttributeMap.Find(vName);
  AssertNotNull('Find returned nil!', vReturnValue);
  AssertEquals('AttributeMetadata name is incorrect!', vName,
    vReturnValue.Name);

  // Find with non-existing name
  vReturnValue := FInstantAttributeMap.Find('NotIn');
  AssertNull('Find returned not nil!', vReturnValue);
end;

procedure TestTInstantAttributeMap.TestIndexOf;
var
  vReturnValue: Integer;
  vItem: TInstantAttributeMetadata;
begin
  vItem := FInstantAttributeMap[1];
  AssertNotNull('Find returned nil!', vItem);

  vReturnValue := FInstantAttributeMap.IndexOf(vItem);
  AssertEquals('AttributeMetadata index is incorrect!', 1, vReturnValue);
end;

procedure TestTInstantAttributeMap.TestInsert;
var
  vItem: TInstantAttributeMetadata;
  vIndex: Integer;
begin
  vItem := TInstantAttributeMetadata.Create(nil);

  vIndex := 1;
  FInstantAttributeMap.Insert(vIndex, vItem);
  AssertEquals('AttributeMap count is incorrect!', 4,
    FInstantAttributeMap.Count);

  vIndex := FInstantAttributeMap.IndexOf(vItem);
  AssertEquals('AttributeMetadata index is incorrect!', 1, vIndex);
end;

procedure TestTInstantAttributeMap.TestIsRootMap;
begin
  AssertTrue('FInstantAttributeMap is not the root map!',
    FInstantAttributeMap.IsRootMap);

  FInstantAttributeMap.Name := 'NewName';
  AssertFalse('FInstantAttributeMap is the root map!',
    FInstantAttributeMap.IsRootMap);
end;

procedure TestTInstantAttributeMap.TestItems;
var
  vName: string;
  vItem, vNewItem,
  vReturnValue : TInstantAttributeMetadata;
begin
  vName := 'NewItem';
  vItem := FInstantAttributeMap[1];
  AssertNotNull('Find returned nil!', vItem);
  AssertEquals('Name is incorrect!', 'Item2', vItem.Name);
  vNewItem := TInstantAttributeMetadata.Create(nil);
  AssertNotNull('Find returned nil!', vNewItem);
  vNewItem.Name := vName;

  FInstantAttributeMap[1] := vNewItem;
  AssertEquals('AttributeMap Count is incorrect!', 3,
    FInstantAttributeMap.Count);
  vReturnValue := FInstantAttributeMap.Find(vName);
  AssertNotNull('Find returned nil!', vReturnValue);
  AssertEquals('Name is incorrect!', vName, vReturnValue.Name);

  vItem.Free;  // Cleanup
end;

procedure TestTInstantAttributeMap.TestRemove;
var
  vReturnValue: Integer;
  vItem: TInstantAttributeMetadata;
begin
  vItem := FInstantAttributeMap[1];
  AssertNotNull('Find returned nil!', vItem);

  vReturnValue := FInstantAttributeMap.Remove(vItem);
  AssertEquals('Remove return value is incorrect!', 1, vReturnValue);
  AssertEquals('AttributeMap count is incorrect!', 2,
    FInstantAttributeMap.Count);

  vItem.Free;  // Cleanup
end;

procedure TestTInstantAttributeMaps.SetUp;
var
  vItem: TInstantAttributeMap;
  i: Integer;
begin
  FClassMetadata := TInstantClassMetadata.Create(nil);
  FClassMetadata.TableName := 'Item3';

  FInstantAttributeMaps := TInstantAttributeMaps.Create(FClassMetadata);

  // The root map is named Item3
  for i := 1 to 3 do
  begin
    vItem := FInstantAttributeMaps.Add;
    vItem.Name := 'Item' + IntToStr(i);
  end;
  AssertEquals('AttributeMaps count is incorrect!', 3,
    FInstantAttributeMaps.Count);
end;

procedure TestTInstantAttributeMaps.TearDown;
begin
  FreeAndNil(FInstantAttributeMaps);
  FreeAndNil(FClassMetadata);
end;

procedure TestTInstantAttributeMaps.TestAdd;
var
  vItem: TInstantAttributeMap;
begin
  vItem := FInstantAttributeMaps.Add;
  AssertNotNull('AttributeMaps is nil!', vItem);
  AssertEquals('AttributeMaps count is incorrect!', 4,
    FInstantAttributeMaps.Count);
end;

procedure TestTInstantAttributeMaps.TestAddItem;
var
  vReturnValue: Integer;
  vItem: TInstantAttributeMap;
begin
  vItem := TInstantAttributeMap.Create(nil);
  vReturnValue := FInstantAttributeMaps.Add(vItem);
  AssertEquals('AttributeMaps item index is incorrect!', 3, vReturnValue);
  AssertEquals('AttributeMaps count is incorrect!', 4,
    FInstantAttributeMaps.Count);
end;

procedure TestTInstantAttributeMaps.TestEnsureMap;
var
  vReturnValue: TInstantAttributeMap;
  vName: string;
begin
  vName := 'Item2';   // Existent name
  vReturnValue := FInstantAttributeMaps.EnsureMap(vName);
  AssertNotNull('AttributeMap return value is nil!', vReturnValue);
  AssertEquals('AttributeMap name is incorrect!', vName, vReturnValue.Name);
  AssertEquals('AttributeMaps count is incorrect!', 3,
    FInstantAttributeMaps.Count);

  vName := 'NewName';   // Non-existent name
  //vItem := TInstantAttributeMap.Create(nil);
  vReturnValue := FInstantAttributeMaps.EnsureMap(vName);
  AssertNotNull('AttributeMap return value is nil!', vReturnValue);
  AssertEquals('AttributeMap name is incorrect!', vName, vReturnValue.Name);
  AssertEquals('AttributeMaps count is incorrect!', 4,
    FInstantAttributeMaps.Count);
end;

procedure TestTInstantAttributeMaps.TestFind;
var
  vReturnValue: TInstantAttributeMap;
  vName: string;
begin
  // Find with existing name
  vName := 'Item2';
  vReturnValue := FInstantAttributeMaps.Find(vName);
  AssertNotNull('Find returned nil!', vReturnValue);
  AssertEquals('AttributeMetadata name is incorrect!', vName,
    vReturnValue.Name);

  // Find with non-existing name
  vReturnValue := FInstantAttributeMaps.Find('NotIn');
  AssertNull('Find returned not nil!', vReturnValue);
end;

procedure TestTInstantAttributeMaps.TestFindMap;
var
  vReturnValue: TInstantAttributeMap;
  vAttributeName: string;
  i: Integer;
  j: Integer;
  vItem: TInstantAttributeMetadata;
begin
  // Ensure that an attribute map that has the desired attribute name
  // cannot be found
  vAttributeName := 'AttrItem11';
  vReturnValue := FInstantAttributeMaps.FindMap(vAttributeName);
  AssertNull('Map was found!', vReturnValue);

  // Add some uniquely named attribute metadatas to each attribute map
  for j := 0 to 2 do
  begin
    for i := 0 to 2 do
    begin
      vItem := TInstantAttributeMetadata.Create(nil);
      vItem.Name := 'AttrItem' + IntToStr(j) + IntToStr(i);
      FInstantAttributeMaps[j].Add(vItem);
    end;
    AssertEquals(Format('AttributeMap[%d] count is incorrect!', [j]), 3,
      FInstantAttributeMaps[j].Count);
  end;

  // Now find the attribute map that has the desired attribute name
  vReturnValue := FInstantAttributeMaps.FindMap(vAttributeName);
  AssertNotNull('Map not found!', vReturnValue);
  AssertEquals('Returned name is incorrect!', 'Item2', vReturnValue.Name);
end;

procedure TestTInstantAttributeMaps.TestIndexOf;
var
  vReturnValue: Integer;
  vItem: TInstantAttributeMap;
begin
  vItem := FInstantAttributeMaps[1];
  AssertNotNull('Find returned nil!', vItem);

  vReturnValue := FInstantAttributeMaps.IndexOf(vItem);
  AssertEquals('AttributeMetadata index is incorrect!', 1, vReturnValue);
end;

procedure TestTInstantAttributeMaps.TestInsert;
var
  vItem: TInstantAttributeMap;
  vIndex: Integer;
begin
  vItem := TInstantAttributeMap.Create(nil);

  vIndex := 1;
  FInstantAttributeMaps.Insert(vIndex, vItem);
  AssertEquals('AttributeMaps count is incorrect!', 4,
    FInstantAttributeMaps.Count);

  vIndex := FInstantAttributeMaps.IndexOf(vItem);
  AssertEquals('AttributeMaps index is incorrect!', 1, vIndex);
end;

procedure TestTInstantAttributeMaps.TestItems;
var
  vItem, vNewItem,
  vReturnValue: TInstantAttributeMap;
  vName: string;
begin
  vName := 'NewItem';
  vItem := FInstantAttributeMaps[1];
  AssertNotNull('Find returned nil!', vItem);
  AssertEquals('Name is incorrect!', 'Item2', vItem.Name);
  vNewItem := TInstantAttributeMap.Create(nil);
  AssertNotNull('Find returned nil!', vNewItem);
  vNewItem.Name := vName;

  FInstantAttributeMaps[1] := vNewItem;
  AssertEquals('AttributeMaps Count is incorrect!', 3,
    FInstantAttributeMaps.Count);
  vReturnValue := FInstantAttributeMaps.Find(vName);
  AssertNotNull('Find returned nil!', vReturnValue);
  AssertEquals('Name is incorrect!', vName, vReturnValue.Name);
end;

procedure TestTInstantAttributeMaps.TestRemove;
var
  vReturnValue: Integer;
  vItem: TInstantAttributeMap;
begin
  vItem := FInstantAttributeMaps[1];
  AssertNotNull('Find returned nil!', vItem);

  vReturnValue := FInstantAttributeMaps.Remove(vItem);
  AssertEquals('Remove return value is incorrect!', 1, vReturnValue);
  AssertEquals('AttributeMap count is incorrect!', 2,
    FInstantAttributeMaps.Count);
end;

procedure TestTInstantAttributeMaps.TestRootMap;
var
  vItem: TInstantAttributeMap;
begin
  vItem := FInstantAttributeMaps.RootMap;
  AssertNotNull('Root map was not found!', vItem);
  AssertEquals('Root map value is incorrect!', 'Item3', vItem.Name);

  FInstantAttributeMaps[2].Name := 'NewName';
  vItem := FInstantAttributeMaps.RootMap;
  AssertNull('Root map was found!', vItem);
end;

initialization
  // Register any test cases with the test runner
{$IFNDEF CURR_TESTS}
  RegisterTests([TestTInstantAttributeMap,
                 TestTInstantAttributeMaps]);
{$ENDIF}

end.
 
Index: TestIO.dpr
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestIO.dpr,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** TestIO.dpr	3 May 2005 04:52:37 -0000	1.4
--- TestIO.dpr	4 May 2005 05:02:44 -0000	1.5
***************
*** 28,32 ****
    TestInstantClasses in 'TestInstantClasses.pas',
    TestInstantRtti in 'TestInstantRtti.pas',
!   TestMinimalModel in 'TestMinimalModel.pas';
  
  {$R *.res}
--- 28,33 ----
    TestInstantClasses in 'TestInstantClasses.pas',
    TestInstantRtti in 'TestInstantRtti.pas',
!   TestMinimalModel in 'TestMinimalModel.pas',
!   TestInstantAttributeMap in 'TestInstantAttributeMap.pas';
  
  {$R *.res}

[Instantobjects-cvscommit] Source/Tests TestIO.mdr,NONE,1.1 TestInstantAttributeMetadata.pas,NONE,1.1 TestInstantClassMetadata.pas,NONE,1.1 TestInstantFieldMetadata.pas,NONE,1.1 TestInstantIndexMetadata.pas,NONE,1.1 TestInstantMetadata.pas,NONE,1.1 TestInstantScheme.pas,NONE,1.1 TestInstantTableMetadata.pas,NONE,1.1 TestModel.pas,NONE,1.1 TestIO.cfg,1.1,1.2 TestIO.dof,1.1,1.2 TestIO.dpr,1.3,1.4 TestIO.res,1.1,1.2 TestInstantClasses.pas,1.1,1.2 TestInstantRtti.pas,1.1,1.2 TestMinimalModel.pas,1.1,1.2 TestMockBroker.pas,1.6,1.7 TestMockConnector.pas,1.4,1.5 Model.pas,1.2,NONE

[Steven M. <sr...@us...>]

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

Modified Files:
	TestIO.cfg TestIO.dof TestIO.dpr TestIO.res 
	TestInstantClasses.pas TestInstantRtti.pas 
	TestMinimalModel.pas TestMockBroker.pas TestMockConnector.pas 
Added Files:
	TestIO.mdr TestInstantAttributeMetadata.pas 
	TestInstantClassMetadata.pas TestInstantFieldMetadata.pas 
	TestInstantIndexMetadata.pas TestInstantMetadata.pas 
	TestInstantScheme.pas TestInstantTableMetadata.pas 
	TestModel.pas 
Removed Files:
	Model.pas 
Log Message:
Addition/revision of Tests

Index: TestMockBroker.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestMockBroker.pas,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** TestMockBroker.pas	2 May 2005 23:26:33 -0000	1.6
--- TestMockBroker.pas	3 May 2005 04:52:37 -0000	1.7
***************
*** 5,21 ****
  uses
    Classes, SysUtils, InstantPersistence, fpcunit, testregistry, InstantMock,
!   Model;
  
  type
    TTestMockBroker = class(TTestCase)
    private
    protected
      FConn: TInstantMockConnector;
      procedure SetUp; override;
      procedure TearDown; override;
    published
!     procedure TestModelMdx;
      procedure TestGetBroker;
      procedure TestBuildDatabase;
      procedure TestStoreAndRetrieveAddress;
    end;
--- 5,24 ----
  uses
    Classes, SysUtils, InstantPersistence, fpcunit, testregistry, InstantMock,
!   TestModel;
  
  type
    TTestMockBroker = class(TTestCase)
    private
+     FClassCount: Integer;
    protected
      FConn: TInstantMockConnector;
      procedure SetUp; override;
      procedure TearDown; override;
+   public
    published
!     procedure TestModelFromToFile;
      procedure TestGetBroker;
      procedure TestBuildDatabase;
+     procedure TestModelFromToResFile;
      procedure TestStoreAndRetrieveAddress;
    end;
***************
*** 23,26 ****
--- 26,30 ----
    TTestMockRelationalBroker = class(TTestCase)
    private
+     FClassCount: Integer;
    protected
      FConn: TInstantMockConnector;
***************
*** 35,44 ****
  implementation
  
! { TTestMockBroker }
  
! procedure TTestMockBroker.TestModelMdx;
  begin
!   InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx'));
    AssertNotNull(InstantModel.ClassMetadatas.Find('TContact'));
  end;
  
--- 39,91 ----
  implementation
  
! procedure TTestMockBroker.TestModelFromToFile;
! var
!   vReturnValue: TInstantClassMetadata;
! begin
!   if FClassCount > 0 then
!   begin
!     // This ensures that the exported file is synchronised
!     // with the current model resource file.
!     InstantModel.SaveToFile(ChangeFileExt(ParamStr(0), '.mdx'));
!     InstantModel.ClassMetadatas.Clear;
!   end;
  
!   InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0), '.mdx'));
!   vReturnValue := InstantModel.ClassMetadatas.Find('TCategory');
!   AssertNotNull(vReturnValue);
!   if FClassCount = 0 then
!     FClassCount := InstantModel.ClassMetadatas.Count;
! 
!   InstantModel.ClassMetadatas.Remove(vReturnValue);
!   AssertNull('TCategory was found!',
!     InstantModel.ClassMetadatas.Find('TCategory'));
!   InstantModel.SaveToFile(ChangeFileExt(ParamStr(0), '.mdxt'));
! 
!   InstantModel.ClassMetadatas.Clear;
!   InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0), '.mdxt'));
!   AssertNotNull(InstantModel.ClassMetadatas.Find('TContact'));
!   AssertNull(InstantModel.ClassMetadatas.Find('TCategory'));
! end;
! 
! procedure TTestMockBroker.TestModelFromToResFile;
! var
!   vReturnValue: TInstantClassMetadata;
  begin
!   if FClassCount > 0 then
!     InstantModel.ClassMetadatas.Clear;
! 
!   InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
!   vReturnValue := InstantModel.ClassMetadatas.Find('TCategory');
!   AssertNotNull(vReturnValue);
! 
!   InstantModel.ClassMetadatas.Remove(vReturnValue);
!   AssertNull(InstantModel.ClassMetadatas.Find('TCategory'));
! 
!   InstantModel.SaveToResFile(ChangeFileExt(ParamStr(0), '.mdrt'));
!   InstantModel.ClassMetadatas.Clear;
! 
!   InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdrt'));
    AssertNotNull(InstantModel.ClassMetadatas.Find('TContact'));
+   AssertNull(InstantModel.ClassMetadatas.Find('TCategory'));
  end;
  
***************
*** 60,65 ****
    brok: TInstantMockBroker;
  begin
-   InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx'));
- 
    brok := Fconn.Broker as TInstantMockBroker;
    brok.MockManager.StartSetUp;
--- 107,110 ----
***************
*** 75,79 ****
    brok: TInstantMockBroker;
  begin
!   InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx'));
  
    Fconn.IsDefault := True;
--- 120,124 ----
    brok: TInstantMockBroker;
  begin
!   AssertTrue(FClassCount > 0);
  
    Fconn.IsDefault := True;
***************
*** 111,114 ****
--- 156,164 ----
    FConn := TInstantMockConnector.Create(nil);
    FConn.BrokerClass := TInstantMockBroker;
+ 
+   if FClassCount > 0 then
+     InstantModel.ClassMetadatas.Clear;
+   InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+   FClassCount := InstantModel.ClassMetadatas.Count;
  end;
  
***************
*** 126,129 ****
--- 176,184 ----
    FConn := TInstantMockConnector.Create(nil);
    FConn.BrokerClass := TInstantMockCRBroker;
+ 
+   if FClassCount > 0 then
+     InstantModel.ClassMetadatas.Clear;
+   InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+   FClassCount := InstantModel.ClassMetadatas.Count;
  end;
  
***************
*** 152,156 ****
    t: TPhone;
  begin
!   InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx'));
    Fconn.IsDefault := True;
    c := TContact.Create;
--- 207,212 ----
    t: TPhone;
  begin
!   AssertTrue(FClassCount > 0);
! 
    Fconn.IsDefault := True;
    c := TContact.Create;
***************
*** 175,184 ****
    t: TPhone;
  begin
!   InstantModel.LoadFromFile(ChangeFileExt(ParamStr(0),'.mdx'));
  
    Fconn.IsDefault := True;
    brok := Fconn.Broker as TInstantMockCRBroker;
    brok.MockManager.StartSetUp;
- 
    c := TContact.Create;
    try
--- 231,239 ----
    t: TPhone;
  begin
!   AssertTrue(FClassCount > 0);
  
    Fconn.IsDefault := True;
    brok := Fconn.Broker as TInstantMockCRBroker;
    brok.MockManager.StartSetUp;
    c := TContact.Create;
    try
***************
*** 190,194 ****
      c.AddPhone(t);
      AssertEquals(1, c.PhoneCount);
- 
      t := TPhone.Create;
      t.Name := 'Office';
--- 245,248 ----
***************
*** 220,224 ****
  
  initialization
    RegisterTests([TTestMockBroker, TTestMockRelationalBroker]);
! 
! end.
--- 274,279 ----
  
  initialization
+ {$IFNDEF CURR_TESTS}
    RegisterTests([TTestMockBroker, TTestMockRelationalBroker]);
! {$ENDIF}
! end.
\ No newline at end of file

Index: TestIO.res
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestIO.res,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
Binary files /tmp/cvs0AJSMF and /tmp/cvsbmi4wp differ

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

interface

uses fpcunit, InstantPersistence;

type

  // Test methods for class TInstantIndexMetadata
  TestTInstantIndexMetadata = class(TTestCase)
  private
    FCollection: TInstantIndexMetadatas;
    FInstantIndexMetadata: TInstantIndexMetadata;
    FOwner: TInstantTableMetadata;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCollection;
    procedure TestFields;
    procedure TestOptions;
    procedure TestTableMetadata;
  end;

  // Test methods for class TInstantIndexMetadatas
  TestTInstantIndexMetadatas = class(TTestCase)
  private
    FInstantIndexMetadatas: TInstantIndexMetadatas;
    FOwner: TInstantTableMetadata;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAddIndexMetadata;
    procedure TestAdd;
    procedure TestOwner;
  end;

implementation

uses SysUtils, Db, testregistry;

procedure TestTInstantIndexMetadata.SetUp;
begin
  FOwner := TInstantTableMetadata.Create(nil);
  FCollection := TInstantIndexMetadatas.Create(FOwner);
  FInstantIndexMetadata := TInstantIndexMetadata.Create(FCollection);
  FInstantIndexMetadata.Fields := 'IndexFields';
  FInstantIndexMetadata.Options := [ixPrimary, ixUnique];
end;

procedure TestTInstantIndexMetadata.TearDown;
begin
  FInstantIndexMetadata.Free;
  FInstantIndexMetadata := nil;
  FreeAndNil(FCollection);
  FreeAndNil(FOwner);
end;

procedure TestTInstantIndexMetadata.TestCollection;
begin
  AssertNotNull('Collection is nil!', FInstantIndexMetadata.Collection);
  AssertSame('Collection is incorrect!', FCollection,
    FInstantIndexMetadata.Collection);
end;

procedure TestTInstantIndexMetadata.TestFields;
begin
  AssertEquals('Fields value is incorrect!', 'IndexFields',
    FInstantIndexMetadata.Fields);
end;

procedure TestTInstantIndexMetadata.TestOptions;
begin
  AssertTrue('Options value is incorrect!',
    [ixPrimary, ixUnique] = FInstantIndexMetadata.Options);
end;

procedure TestTInstantIndexMetadata.TestTableMetadata;
begin
  AssertNotNull('TableMetadata is nil!', FInstantIndexMetadata.TableMetadata);
  AssertSame('TableMetadata is incorrect!', FOwner,
    FInstantIndexMetadata.TableMetadata);
end;

procedure TestTInstantIndexMetadatas.SetUp;
begin
  FOwner := TInstantTableMetadata.Create(nil);
  FInstantIndexMetadatas := TInstantIndexMetadatas.Create(FOwner);
end;

procedure TestTInstantIndexMetadatas.TearDown;
begin
  FInstantIndexMetadatas.Free;
  FInstantIndexMetadatas := nil;
  FreeAndNil(FOwner);
end;

procedure TestTInstantIndexMetadatas.TestAdd;
var
  vReturnValue: TInstantIndexMetadata;
begin
  vReturnValue := FInstantIndexMetadatas.Add;
  AssertNotNull('vReturnValue is nil!', vReturnValue);
  AssertEquals('Count is incorrect!', 1, FInstantIndexMetadatas.Count);
  AssertNotNull('Items[0] is nil!', FInstantIndexMetadatas.Items[0]);
  FInstantIndexMetadatas.Remove(vReturnValue);
  AssertEquals('Count is incorrect!', 0, FInstantIndexMetadatas.Count);
end;

procedure TestTInstantIndexMetadatas.TestAddIndexMetadata;
var
  vOptions: TIndexOptions;
  vFields: string;
  vName: string;
  vReturnValue: TInstantIndexMetadata;
begin
  vName := 'PrimaryID';
  vFields := 'IndexFields';
  vOptions := [ixPrimary, ixUnique];
  FInstantIndexMetadatas.AddIndexMetadata(vName, vFields, vOptions);
  vReturnValue := TInstantIndexMetadata(FInstantIndexMetadatas.Find(vName));
  AssertNotNull('IndexMetadata not found!', vReturnValue);
  AssertEquals('Fields value is incorrect!', vFields, vReturnValue.Fields);
  AssertTrue('Options value is incorrect!', vOptions = vReturnValue.Options);
end;

procedure TestTInstantIndexMetadatas.TestOwner;
var
  vReturnValue: TInstantTableMetadata;
begin
  vReturnValue := FInstantIndexMetadatas.Owner;
  AssertNotNull('Owner is nil!', vReturnValue);
  AssertSame('Owner value is incorrect!', FOwner, vReturnValue);
end;

initialization
  // Register any test cases with the test runner
{$IFNDEF CURR_TESTS}
  RegisterTests([TestTInstantIndexMetadata,
                 TestTInstantIndexMetadatas]);
{$ENDIF}

end.

Index: TestInstantClasses.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestInstantClasses.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** TestInstantClasses.pas	2 May 2005 23:26:34 -0000	1.1
--- TestInstantClasses.pas	3 May 2005 04:52:37 -0000	1.2
***************
*** 317,321 ****
      c.ConvertToText(ic);
      ic.Producer.eof; //to flush the buffer
!     AssertEquals('ConvertToText', '<Age>2</Age><Weight>1,123</Weight><PigName>Miss piggy</PigName>', outs.DataString);
  
    //butta via l'output e riprova col sistema completo
--- 317,322 ----
      c.ConvertToText(ic);
      ic.Producer.eof; //to flush the buffer
!     AssertEquals('ConvertToText', '<Age>2</Age><Weight>1' + DecimalSeparator +
!       '123</Weight><PigName>Miss piggy</PigName>', outs.DataString);
  
    //butta via l'output e riprova col sistema completo
***************
*** 324,328 ****
      s2 := '';
      InstantObjectBinaryToText(ins, outs);
!     AssertEquals('InstantObjectBinaryToText', '<TInstantGuineaPig><Age>2</Age><Weight>1,123</Weight><PigName>Miss piggy</PigName></TInstantGuineaPig>', outs.DataString);
    finally
      ic.Free;
--- 325,332 ----
      s2 := '';
      InstantObjectBinaryToText(ins, outs);
!     AssertEquals('InstantObjectBinaryToText',
!       '<TInstantGuineaPig><Age>2</Age><Weight>1' + DecimalSeparator +
!       '123</Weight><PigName>Miss piggy</PigName></TInstantGuineaPig>',
!       outs.DataString);
    finally
      ic.Free;
***************
*** 346,350 ****
      InstantWriteObject(ms, sfXML, c);
      AssertEquals(102, ms.Position);
!     AssertEquals('<TInstantGuineaPig><Age>2</Age><Weight>1,123</Weight><PigName>Miss piggy</PigName></TInstantGuineaPig>', ms.DataString);
    finally
      c.Free;
--- 350,356 ----
      InstantWriteObject(ms, sfXML, c);
      AssertEquals(102, ms.Position);
!     AssertEquals('<TInstantGuineaPig><Age>2</Age><Weight>1' + DecimalSeparator +
!       '123</Weight><PigName>Miss piggy</PigName></TInstantGuineaPig>',
!       ms.DataString);
    finally
      c.Free;
***************
*** 380,385 ****
  
  initialization
    RegisterTests([TTestInstantClasses]);
    RegisterClass(TInstantGuineaPig);
! 
  end.
--- 386,393 ----
  
  initialization
+   // Register any test cases with the test runner
+ {$IFNDEF CURR_TESTS}
    RegisterTests([TTestInstantClasses]);
    RegisterClass(TInstantGuineaPig);
! {$ENDIF}
  end.

Index: TestInstantRtti.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestInstantRtti.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** TestInstantRtti.pas	2 May 2005 23:26:34 -0000	1.1
--- TestInstantRtti.pas	3 May 2005 04:52:37 -0000	1.2
***************
*** 203,207 ****
--- 203,210 ----
  
  initialization
+   // Register any test cases with the test runner
+ {$IFNDEF CURR_TESTS}
    RegisterTests([TTestInstantRtti]);
+ {$ENDIF}
  
  end.

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

interface

uses fpcunit, InstantPersistence;

type

  // Test methods for class TInstantTableMetadata
  TestTInstantTableMetadata = class(TTestCase)
  private
    FCollection: TInstantTableMetadatas;
    FInstantTableMetadata: TInstantTableMetadata;
    FOwner: TInstantScheme;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestFieldMetadatas;
    procedure TestIndexMetadatas;
    procedure TestScheme;
  end;

  // Test methods for class TInstantTableMetadatas
  TestTInstantTableMetadatas = class(TTestCase)
  private
    FInstantTableMetadatas: TInstantTableMetadatas;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAdd_ReadItems;
  end;

implementation

uses SysUtils, testregistry;

procedure TestTInstantTableMetadata.SetUp;
begin
  FOwner := TInstantScheme.Create(nil);
  FCollection := TInstantTableMetadatas.Create(FOwner);
  FInstantTableMetadata := TInstantTableMetadata.Create(FCollection);
end;

procedure TestTInstantTableMetadata.TearDown;
begin
  FInstantTableMetadata.Free;
  FInstantTableMetadata := nil;
  FreeAndNil(FCollection);
  FreeAndNil(FOwner);
end;

procedure TestTInstantTableMetadata.TestFieldMetadatas;
begin
  AssertNotNull('FieldMetadatas is nil!', FInstantTableMetadata.FieldMetadatas);
end;

procedure TestTInstantTableMetadata.TestIndexMetadatas;
begin
  AssertNotNull('IndexMetadatas is nil!', FInstantTableMetadata.IndexMetadatas);
end;

procedure TestTInstantTableMetadata.TestScheme;
begin
  AssertNotNull('Scheme is nil!', FInstantTableMetadata.Scheme);
  AssertSame('Scheme value is incorrect!', FOwner,
    FInstantTableMetadata.Scheme);
end;

procedure TestTInstantTableMetadatas.SetUp;
begin
  FInstantTableMetadatas := TInstantTableMetadatas.Create(nil);
end;

procedure TestTInstantTableMetadatas.TearDown;
begin
  FInstantTableMetadatas.Free;
  FInstantTableMetadatas := nil;
end;

procedure TestTInstantTableMetadatas.TestAdd_ReadItems;
var
  vReturnValue: TInstantTableMetadata;
begin
  vReturnValue := FInstantTableMetadatas.Add;
  AssertNotNull('vReturnValue is nil!', vReturnValue);
  AssertEquals('Count is incorrect!', 1, FInstantTableMetadatas.Count);
  AssertNotNull('Items[0] is nil!', FInstantTableMetadatas.Items[0]);
  FInstantTableMetadatas.Remove(vReturnValue);
  AssertEquals('Count is incorrect!', 0, FInstantTableMetadatas.Count);
end;



initialization
  // Register any test cases with the test runner
{$IFNDEF CURR_TESTS}
  RegisterTests([TestTInstantTableMetadata,
                 TestTInstantTableMetadatas]);
{$ENDIF}

end.
 
Index: TestIO.dof
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestIO.dof,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** TestIO.dof	2 May 2005 23:26:34 -0000	1.1
--- TestIO.dof	3 May 2005 04:52:37 -0000	1.2
***************
*** 21,25 ****
  R=0
  S=0
! T=0
  U=0
  V=1
--- 21,25 ----
  R=0
  S=0
! T=1
  U=0
  V=1
***************
*** 77,83 ****
  SuspiciousTypecast=1
  PrivatePropAccessor=1
! UnsafeType=1
! UnsafeCode=1
! UnsafeCast=1
  [Linker]
  MapFile=0
--- 77,83 ----
  SuspiciousTypecast=1
  PrivatePropAccessor=1
! UnsafeType=0
! UnsafeCode=0
! UnsafeCast=0
  [Linker]
  MapFile=0
***************
*** 92,101 ****
  [Directories]
  OutputDir=
! UnitOutputDir=
  PackageDLLOutputDir=
  PackageDCPOutputDir=
! SearchPath=D:\lazarus\components\fpcunit\ubmock\src
! Packages=
! Conditionals=
  DebugSourceDirs=
  UsePackages=0
--- 92,101 ----
  [Directories]
  OutputDir=
! UnitOutputDir=D:\D\DCU\D7\Tmp
  PackageDLLOutputDir=
  PackageDCPOutputDir=
! SearchPath=D:\L\ubmock\src
! Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;adortl;vclactnband;vclshlctrls;CS30Logging70;Rz30Ctls70;Rz30DBCtls70;ip4000v7;Rave60VCL;Rave60CLX;madBasic_;madDisAsm_;CLXIB;ibxpress;VCLIB;IOCore;IOIBX
! Conditionals=CURR_TESTS
  DebugSourceDirs=
  UsePackages=0
***************
*** 109,113 ****
  ActiveLang=
  ProjectLang=
! RootDir=
  [Version Info]
  IncludeVerInfo=0
--- 109,113 ----
  ActiveLang=
  ProjectLang=
! RootDir=C:\Program Files\Borland\Delphi7\Bin\
  [Version Info]
  IncludeVerInfo=0
***************
*** 122,125 ****
  Private=0
  DLL=0
! Locale=1040
  CodePage=1252
--- 122,142 ----
  Private=0
  DLL=0
! Locale=3081
  CodePage=1252
+ [Version Info Keys]
+ CompanyName=
+ FileDescription=
+ FileVersion=1.0.0.0
+ InternalName=
+ LegalCopyright=
+ LegalTrademarks=
+ OriginalFilename=
+ ProductName=
+ ProductVersion=1.0.0.0
+ Comments=
+ [HistoryLists\hlConditionals]
+ Count=1
+ Item0=CURR_TESTS
+ [HistoryLists\hlUnitAliases]
+ Count=1
+ Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;

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

interface

uses
  InstantPersistence;

type
  TAddress = class;
  TCategory = class;
  TCompany = class;
  TContact = class;
  TContactFilter = class;
  TCountry = class;
  TEmail = class;
  TPerson = class;
  TPhone = class;

  TAddress = class(TInstantObject)
  {IOMETADATA stored;
    City: String(30) index;
    Country: Reference(TCountry);
    State: String(4);
    Street: Memo;
    Zip: String(10); }
    _City: TInstantString;
    _Country: TInstantReference;
    _State: TInstantString;
    _Street: TInstantMemo;
    _Zip: TInstantString;
  private
    function GetCity: string;
    function GetCountry: TCountry;
    function GetState: string;
    function GetStreet: string;
    function GetZip: string;
    procedure SetCity(const Value: string);
    procedure SetCountry(Value: TCountry);
    procedure SetState(const Value: string);
    procedure SetStreet(const Value: string);
    procedure SetZip(const Value: string);
  published
    property City: string read GetCity write SetCity;
    property Country: TCountry read GetCountry write SetCountry;
    property State: string read GetState write SetState;
    property Street: string read GetStreet write SetStreet;
    property Zip: string read GetZip write SetZip;
  end;

  TCountry = class(TInstantObject)
  {IOMETADATA stored;
    Name: String(30); }
    _Name: TInstantString;
  private
    function GetName: string;
    procedure SetName(const Value: string);
  protected
    procedure BeforeStore; override;
    function GetCaption: string; override;
  published
    property Id;
    property Name: string read GetName write SetName;
  end;

  TPhone = class(TInstantObject)
  {IOMETADATA stored;
    Name: String(20);
    Number: String(20) mask '(000) 000-0000;0;_'; }
    _Name: TInstantString;
    _Number: TInstantString;
  private
    function GetName: string;
    function GetNumber: string;
    procedure SetName(const Value: string);
    procedure SetNumber(const Value: string);
  published
    property Name: string read GetName write SetName;
    property Number: string read GetNumber write SetNumber;
  end;

  TEmail = class(TInstantObject)
  {IOMETADATA stored;
    Address: String(100); }
    _Address: TInstantString;
  private
    function GetAddress: string;
    procedure SetAddress(const Value: string);
  published
    property Address: string read GetAddress write SetAddress;
  end;

  TCategory = class(TInstantObject)
  {IOMETADATA stored 'Categories';
    Name: String(30); }
    _Name: TInstantString;
  private
    function GetName: string;
    procedure SetName(const Value: string);
  protected
    function GetCaption: string; override;
  published
    property Name: string read GetName write SetName;
  end;

  TContact = class(TInstantObject)
  {IOMETADATA stored;
    Address: Part(TAddress);
    Category: Reference(TCategory);
    City: String(30) index;
    Name: String(50) index;
    Phones: Parts(TPhone); }
    _Address: TInstantPart;
    _Category: TInstantReference;
    _City: TInstantString;
    _Name: TInstantString;
    _Phones: TInstantParts;
  private
    function GetAddress: TAddress;
    function GetCategory: TCategory;
    function GetCity: string;
    function GetMainPhoneNumber: string;
    function GetName: string;
    function GetPhoneCount: Integer;
    function GetPhones(Index: Integer): TPhone;
    procedure SetAddress(Value: TAddress);
    procedure SetCategory(Value: TCategory);
    procedure SetCity(const Value: string);
    procedure SetMainPhoneNumber(const Value: string);
    procedure SetName(const Value: string);
    procedure SetPhones(Index: Integer; Value: TPhone);
  protected
    procedure AfterCreate; override;
    procedure BeforeStore; override;
    function GetCaption: string; override;
  public
    function AddPhone(Phone: TPhone): Integer;
    procedure ClearPhones;
    procedure DeletePhone(Index: Integer);
    function IndexOfPhone(Phone: TPhone): Integer;
    procedure InsertPhone(Index: Integer; Phone: TPhone);
    function RemovePhone(Phone: TPhone): Integer;
    property PhoneCount: Integer read GetPhoneCount;
    property Phones[Index: Integer]: TPhone read GetPhones write SetPhones;
  published
    property Address: TAddress read GetAddress write SetAddress;
    property Category: TCategory read GetCategory write SetCategory;
    property City: string read GetCity write SetCity;
    property MainPhoneNumber: string read GetMainPhoneNumber write SetMainPhoneNumber;
    property Name: string read GetName write SetName;
  end;

  TContactFilter = class(TContact)
  private
    FIsDynamic: Boolean;
    function GetIsEmpty: Boolean;
  public
    function Matches(Contact: TContact): Boolean;
  published
    property IsDynamic: Boolean read FIsDynamic write FIsDynamic;
    property IsEmpty: Boolean read GetIsEmpty;
  end;

  TPerson = class(TContact)
  {IOMETADATA stored;
    BirthDate: DateTime;
    Emails: Parts(TEmail) externalstored 'Person_Email';
    Employer: Reference(TCompany);
    Picture: Blob;
    Salary: Currency; }
    _BirthDate: TInstantDateTime;
    _Emails: TInstantParts;
    _Employer: TInstantReference;
    _Picture: TInstantGraphic;
    _Salary: TInstantCurrency;
  private
    function GetBirthDate: TDateTime;
    function GetEmailCount: Integer;
    function GetEmails(Index: Integer): TEmail;
    function GetEmployer: TCompany;
    function GetMainEmailAddress: string;
    function GetPicture: string;
    function GetSalary: Currency;
    procedure SetBirthDate(Value: TDateTime);
    procedure SetEmails(Index: Integer; Value: TEmail);
    procedure SetMainEmailAddress(const Value: string);
    procedure SetPicture(const Value: string);
    procedure SetSalary(Value: Currency);
  protected
    procedure BeforeDispose; override;
  public
    function AddEmail(Email: TEmail): Integer;
    procedure ClearEmails;
    procedure DeleteEmail(Index: Integer);
    procedure EmployBy(NewEmployer: TCompany);
    function IndexOfEmail(Email: TEmail): Integer;
    procedure InsertEmail(Index: Integer; Email: TEmail);
    function RemoveEmail(Email: TEmail): Integer;
    property EmailCount: Integer read GetEmailCount;
    property Emails[Index: Integer]: TEmail read GetEmails write SetEmails;
  published
    property BirthDate: TDateTime read GetBirthDate write SetBirthDate;
    property Employer: TCompany read GetEmployer;
    property MainEmailAddress: string read GetMainEmailAddress write SetMainEmailAddress;
    property Picture: string read GetPicture write SetPicture;
    property Salary: Currency read GetSalary write SetSalary;
  end;

  TCompany = class(TContact)
  {IOMETADATA stored;
    Employees: References(TPerson) externalstored 'Company_Employee'; }
    _Employees: TInstantReferences;
  private
    function GetEmployeeCount: Integer;
    function GetEmployees(Index: Integer): TPerson;
  public
    function AddEmployee(Employee: TPerson): Integer;
    procedure ClearEmployees;
    procedure DeleteEmployee(Index: Integer);
    function IndexOfEmployee(Employee: TPerson): Integer;
    procedure InsertEmployee(Index: Integer; Employee: TPerson);
    function RemoveEmployee(Employee: TPerson): Integer;
    property EmployeeCount: Integer read GetEmployeeCount;
    property Employees[Index: Integer]: TPerson read GetEmployees;
  end;

implementation

uses
  SysUtils, InstantUtils;

{ TAddress }

function TAddress.GetCity: string;
begin
  Result := _City.Value;
end;

function TAddress.GetCountry: TCountry;
begin
  Result := _Country.Value as TCountry;
end;

function TAddress.GetState: string;
begin
  Result := _State.Value;
end;

function TAddress.GetStreet: string;
begin
  Result := _Street.Value;
end;

function TAddress.GetZip: string;
begin
  Result := _Zip.Value;
end;

procedure TAddress.SetCity(const Value: string);
begin
  _City.Value := Value;
end;

procedure TAddress.SetCountry(Value: TCountry);
begin
  _Country.Value := Value;
end;

procedure TAddress.SetState(const Value: string);
begin
  _State.Value := Value;
end;

procedure TAddress.SetStreet(const Value: string);
begin
  _Street.Value := Value;
end;

procedure TAddress.SetZip(const Value: string);
begin
  _Zip.Value := Value;
end;

{ TCountry }

procedure TCountry.BeforeStore;
begin
  if Id = '' then
    raise Exception.Create('Country ID missing');
  inherited;
end;

function TCountry.GetCaption: string;
begin
  Result := Name;
end;

function TCountry.GetName: string;
begin
  Result := _Name.Value;
end;

procedure TCountry.SetName(const Value: string);
begin
  _Name.Value := Value;
end;

{ TPerson }

function TPerson.AddEmail(Email: TEmail): Integer;
begin
  Result := _Emails.Add(Email);
end;

procedure TPerson.BeforeDispose;
begin
  inherited;
  EmployBy(nil);
end;

procedure TPerson.ClearEmails;
begin
  _Emails.Clear;
end;

procedure TPerson.DeleteEmail(Index: Integer);
begin
  _Emails.Delete(Index);
end;

procedure TPerson.EmployBy(NewEmployer: TCompany);

  procedure AddToEmployer(AEmployer: TCompany);
  begin
    if Assigned(AEmployer) then
      AEmployer.AddEmployee(Self);
  end;

  procedure RemoveFromEmployer(AEmployer: TCompany);
  begin
    if Assigned(AEmployer) then
      AEmployer.RemoveEmployee(Self);
  end;

  procedure StoreEmployer(AEmployer: TCompany);
  begin
    if Assigned(AEmployer) then
      AEmployer.Store;
  end;

var
  OldEmployer: TCompany;
begin
  OldEmployer := Employer;
  AddRef;
  try
    Connector.StartTransaction;
    try
      AddToEmployer(NewEmployer);
      try
        StoreEmployer(NewEmployer);
        RemoveFromEmployer(OldEmployer);
        try
          StoreEmployer(OldEmployer);
          _Employer.Value := NewEmployer;
          try
            Store;
            Connector.CommitTransaction;
          except
            _Employer.Value := OldEmployer;
            raise;
          end;
        except
          AddToEmployer(OldEmployer);
          raise;
        end;
      except
        RemoveFromEmployer(NewEmployer);
        raise;
      end;
    except
      Connector.RollbackTransaction;
      raise;
    end;
  finally
    Free;
  end;
end;

function TPerson.GetBirthDate: TDateTime;
begin
  Result := _BirthDate.Value;
end;

function TPerson.GetEmailCount: Integer;
begin
  Result := _Emails.Count
end;

function TPerson.GetEmails(Index: Integer): TEmail;
begin
  Result := _Emails[Index] as TEmail;
end;

function TPerson.GetEmployer: TCompany;
begin
  Result := _Employer.Value as TCompany;
end;

function TPerson.GetMainEmailAddress: string;
begin
  if EmailCount > 0 then
    Result := Emails[0].Address
  else
    Result := '';
end;

function TPerson.GetPicture: string;
begin
  Result := _Picture.Value;
end;

function TPerson.GetSalary: Currency;
begin
  Result := _Salary.Value;
end;

function TPerson.IndexOfEmail(Email: TEmail): Integer;
begin
  Result := _Emails.IndexOf(Email);
end;

procedure TPerson.InsertEmail(Index: Integer; Email: TEmail);
begin
  _Emails.Insert(Index, Email);
end;

function TPerson.RemoveEmail(Email: TEmail): Integer;
begin
  Result := _Emails.Remove(Email);
end;

procedure TPerson.SetBirthDate(Value: TDateTime);
begin
  _BirthDate.Value := Value;
end;

procedure TPerson.SetEmails(Index: Integer; Value: TEmail);
begin
  _Emails[Index] := Value;
end;

procedure TPerson.SetMainEmailAddress(const Value: string);
var
  Email: TEmail;
begin
  if Value <> MainEmailAddress then
  begin
    if EmailCount = 0 then
    begin
      Email := TEmail.Create;
      AddEmail(Email);
    end else
      Email := Emails[0];
    Email.Address := Value;
  end;
end;

procedure TPerson.SetPicture(const Value: string);
begin
  _Picture.Value := Value;
end;

{ TPhone }

procedure TPerson.SetSalary(Value: Currency);
begin
  _Salary.Value := Value;
end;

function TPhone.GetName: string;
begin
  Result := _Name.Value;
end;

function TPhone.GetNumber: string;
begin
  Result := _Number.Value;
end;

procedure TPhone.SetName(const Value: string);
begin
  _Name.Value := Value;
end;

procedure TPhone.SetNumber(const Value: string);
begin
  _Number.Value := Value;
end;

{ TEmail }

function TEmail.GetAddress: string;
begin
  Result := _Address.Value;
end;

procedure TEmail.SetAddress(const Value: string);
begin
  _Address.Value := Value;
end;

{ TCategory }

function TCategory.GetCaption: string;
begin
  Result := Name;
end;

function TCategory.GetName: string;
begin
  Result := _Name.Value;
end;

procedure TCategory.SetName(const Value: string);
begin
  _Name.Value := Value;
end;

{ TContact }

function TContact.AddPhone(Phone: TPhone): Integer;
begin
  Result := _Phones.Add(Phone);
end;

procedure TContact.AfterCreate;
begin
  inherited;
  Id := InstantGenerateId;
  _Category.ReferenceObject(TCategory, 'CAT000');
end;

procedure TContact.BeforeStore;
begin
  if Name = '' then
    raise Exception.Create('Contact name required');
  inherited;
  City := Address.City;
end;

procedure TContact.ClearPhones;
begin
  _Phones.Clear;
end;

procedure TContact.DeletePhone(Index: Integer);
begin
  _Phones.Delete(Index);
end;

function TContact.GetAddress: TAddress;
begin
  Result := _Address.Value as TAddress;
end;

function TContact.GetCaption: string;
begin
  Result := Name;
end;

function TContact.GetCategory: TCategory;
begin
  Result := _Category.Value as TCategory;
end;

function TContact.GetCity: string;
begin
  Result := _City.Value;
end;

function TContact.GetMainPhoneNumber: string;
begin
  if PhoneCount > 0 then
    Result := Phones[0].Number
  else
    Result := '';
end;

function TContact.GetName: string;
begin
  Result := _Name.Value;
end;

function TContact.GetPhoneCount: Integer;
begin
  Result := _Phones.Count
end;

function TContact.GetPhones(Index: Integer): TPhone;
begin
  Result := _Phones[Index] as TPhone;
end;

function TContact.IndexOfPhone(Phone: TPhone): Integer;
begin
  Result := _Phones.IndexOf(Phone);
end;

procedure TContact.InsertPhone(Index: Integer; Phone: TPhone);
begin
  _Phones.Insert(Index, Phone);
end;

function TContact.RemovePhone(Phone: TPhone): Integer;
begin
  Result := _Phones.Remove(Phone);
end;

procedure TContact.SetAddress(Value: TAddress);
begin
  _Address.Value := Value;
end;

procedure TContact.SetCategory(Value: TCategory);
begin
  _Category.Value := Value;
end;

procedure TContact.SetCity(const Value: string);
begin
  _City.Value := Value;
end;

procedure TContact.SetMainPhoneNumber(const Value: string);
var
  Phone: TPhone;
begin
  if Value <> MainPhoneNumber then
  begin
    if PhoneCount = 0 then
    begin
      Phone := TPhone.Create;
      AddPhone(Phone);
      Phone.Name := 'Main';
    end else
      Phone := Phones[0];
    Phone.Number := Value;
  end;
end;

procedure TContact.SetName(const Value: string);
begin
  _Name.Value := Value;
end;

procedure TContact.SetPhones(Index: Integer; Value: TPhone);
begin
  _Phones[Index] := Value;
end;

{ TContactFilter }

function TContactFilter.GetIsEmpty: Boolean;
begin
  Result :=
    (Name = '') and
    (Address.Street = '') and
    (Address.City = '') and
    (Address.Zip = '') and
    (Address.State = '') and
    (Address.Country = nil) and
    (Category = nil);
end;

function TContactFilter.Matches(Contact: TContact): Boolean;

  function MatchStr(const Str1, Str2: string): Boolean;
  begin
    Result := (Str1 = '') or (Pos(UpperCase(Str1), UpperCase(Str2)) > 0);
  end;

  function MatchObj(Obj1, Obj2: TObject): Boolean;
  begin
    Result := not Assigned(Obj1) or (Obj1 = Obj2);
  end;

begin
  Result := Assigned(Contact) and
    MatchStr(Name, Contact.Name) and
    MatchStr(Address.Street, Contact.Address.Street) and
    MatchStr(Address.City, Contact.Address.City) and
    MatchStr(Address.Zip, Contact.Address.Zip) and
    MatchStr(Address.State, Contact.Address.State) and
    MatchObj(Address.Country, Contact.Address.Country) and
    MatchObj(Category, Contact.Category);
end;

{ TCompany }

function TCompany.AddEmployee(Employee: TPerson): Integer;
begin
  Result := _Employees.Add(Employee)
end;

procedure TCompany.ClearEmployees;
begin
  _Employees.Clear;
end;

procedure TCompany.DeleteEmployee(Index: Integer);
begin
  _Employees.Delete(Index);
end;

function TCompany.GetEmployeeCount: Integer;
begin
  Result := _Employees.Count
end;

function TCompany.GetEmployees(Index: Integer): TPerson;
begin
  Result := _Employees[Index] as TPerson;
end;

function TCompany.IndexOfEmployee(Employee: TPerson): Integer;
begin
  Result := _Employees.IndexOf(Employee);
end;

procedure TCompany.InsertEmployee(Index: Integer; Employee: TPerson);
begin
  _Employees.Insert(Index, Employee);
end;

function TCompany.RemoveEmployee(Employee: TPerson): Integer;
begin
  Result := _Employees.Remove(Employee);
end;

initialization
  InstantRegisterClasses([
    TAddress,
    TCategory,
    TCompany,
    TContact,
    TContactFilter,
    TCountry,
    TEmail,
    TPerson,
    TPhone
  ]);

end.

Index: TestIO.dpr
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestIO.dpr,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** TestIO.dpr	2 May 2005 23:26:33 -0000	1.3
--- TestIO.dpr	3 May 2005 04:52:37 -0000	1.4
***************
*** 6,12 ****
  
  uses
! {$IFDEF FPC}  Interfaces,
  {$ENDIF}
!   Forms, GuiTestRunner,
    fpcunit,
    testregistry,
--- 6,14 ----
  
  uses
! {$IFDEF FPC}
!   Interfaces,
  {$ENDIF}
!   Forms,
!   GuiTestRunner,
    fpcunit,
    testregistry,
***************
*** 16,31 ****
    TestMockConnector in 'TestMockConnector.pas',
    TestMockBroker in 'TestMockBroker.pas',
!   TestInstantPersistence in 'TestInstantPersistence.pas',
    TestInstantClasses in 'TestInstantClasses.pas',
    TestInstantRtti in 'TestInstantRtti.pas',
!   TestMinimalModel in 'TestMinimalModel.pas',
!   TestMinimalModelDb  in 'TestMinimalModelDb.pas',
!   TestModelDb in 'TestModelDb.pas';
  
  {$R *.res}
  
  begin
    Application.Initialize;
!   Application.CreateForm(TGUITestRunner, TestRunner);
    Application.Run;
  end.
--- 18,39 ----
    TestMockConnector in 'TestMockConnector.pas',
    TestMockBroker in 'TestMockBroker.pas',
!   TestInstantMetadata in 'TestInstantMetadata.pas',
!   TestModel in 'TestModel.pas',
!   TestInstantFieldMetadata in 'TestInstantFieldMetadata.pas',
!   TestInstantClassMetadata in 'TestInstantClassMetadata.pas',
!   TestInstantAttributeMetadata in 'TestInstantAttributeMetadata.pas',
!   TestInstantIndexMetadata in 'TestInstantIndexMetadata.pas',
!   TestInstantTableMetadata in 'TestInstantTableMetadata.pas',
!   TestInstantScheme in 'TestInstantScheme.pas',
    TestInstantClasses in 'TestInstantClasses.pas',
    TestInstantRtti in 'TestInstantRtti.pas',
!   TestMinimalModel in 'TestMinimalModel.pas';
  
  {$R *.res}
+ {$R *.mdr} {TestModel}
  
  begin
    Application.Initialize;
!   Application.CreateForm(TTestRunner, TestRunner);
    Application.Run;
  end.

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

interface

uses fpcunit, InstantMock, InstantPersistence;

type
  // Test methods for class TInstantClassMetadata
  TestTInstantClassMetadata = class(TTestCase)
  private
    FClassCount: Integer;
    FConn: TInstantMockConnector;
    FInstantClassMetadata: TInstantClassMetadata;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAssign;
    procedure TestAttributeMetadatas;
    procedure TestCollection;
    procedure TestFindInstantAttributeMetadata;
    procedure TestIsEmpty;
    procedure TestIsStored;
    procedure TestMemberMap;
    procedure TestParentName;
    procedure TestPersistence;
    procedure TestStorageMaps;
    procedure TestStorageName;
    procedure TestTableName;
  end;

  // Test methods for class TInstantClassMetadatas
  TestTInstantClassMetadatas = class(TTestCase)
  private
    FInstantClassMetadatas: TInstantClassMetadatas;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAdd;
    procedure TestFind;
    procedure TestItems;
  end;

implementation

uses SysUtils, TypInfo, testregistry;

procedure TestTInstantClassMetadata.SetUp;
begin
  FConn := TInstantMockConnector.Create(nil);
  FConn.BrokerClass := TInstantMockBroker;

  if FClassCount > 0 then
    InstantModel.ClassMetadatas.Clear;
  InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
  // Load a default ClassMetadata
  FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TContact');
end;

procedure TestTInstantClassMetadata.TearDown;
begin
  FInstantClassMetadata := nil;
  FConn.Free;
end;

procedure TestTInstantClassMetadata.TestAssign;
var
  vDest, vSource: TInstantClassMetadata;
  vStr: string;
begin
  vSource := TInstantClassMetadata.Create(nil);
  vDest := TInstantClassMetadata.Create(nil);
  try
    vSource.DefaultContainerName := 'DefaultContainerName';
    vSource.StorageName := 'StorageName';
    vSource.Persistence := peStored;
    vDest.Assign(vSource);
    AssertEquals('DefaultContainerName is incorrect!', 'DefaultContainerName',
      vDest.DefaultContainerName);
    AssertEquals('StorageName is incorrect!', 'StorageName',
      vDest.StorageName);
    vStr := GetEnumName(TypeInfo(TInstantPersistence),
      Ord(vDest.Persistence));
    AssertEquals('PersistenceType incorrect', 'peStored', vStr);
  finally
    vSource.Free;
    vDest.Free;
  end;
end;

procedure TestTInstantClassMetadata.TestAttributeMetadatas;
begin
  AssertNotNull('AttributeMetadatas is nil!',
    FInstantClassMetadata.AttributeMetadatas);
end;

procedure TestTInstantClassMetadata.TestCollection;
begin
  // Collection property contains all of the class metadatas in the model
  AssertNotNull('Collection is nil!', FInstantClassMetadata.Collection);
  AssertEquals('The number of model classes is incorrect!', 9,
    FInstantClassMetadata.Collection.Count);

  FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TPhone');
  AssertEquals('The number of model classes is incorrect!', 9,
    FInstantClassMetadata.Collection.Count);
end;

procedure TestTInstantClassMetadata.TestFindInstantAttributeMetadata;
begin
  AssertNotNull(FInstantClassMetadata);
end;

procedure TestTInstantClassMetadata.TestIsEmpty;
begin
  AssertFalse('FInstantClassMetadata is empty!', FInstantClassMetadata.IsEmpty);
end;

procedure TestTInstantClassMetadata.TestIsStored;
begin
  AssertTrue('Incorrect storage flag!', FInstantClassMetadata.IsStored);

  FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TContactFilter');
  AssertFalse('Incorrect storage flag!', FInstantClassMetadata.IsStored);
end;

procedure TestTInstantClassMetadata.TestMemberMap;
begin
  AssertNotNull('MemberMap is nil!', FInstantClassMetadata.MemberMap);
end;

procedure TestTInstantClassMetadata.TestParentName;
begin
  AssertEquals('ParentName incorrect!', '',
    FInstantClassMetadata.ParentName);

  FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TPerson');
  AssertEquals('ParentName incorrect!', 'TContact',
    FInstantClassMetadata.ParentName);
end;

procedure TestTInstantClassMetadata.TestPersistence;
var
  vStr: string;
begin
  vStr := GetEnumName(TypeInfo(TInstantPersistence),
    Ord(FInstantClassMetadata.Persistence));
  AssertEquals('PersistenceType incorrect', 'peStored', vStr);

  FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TContactFilter');
  vStr := GetEnumName(TypeInfo(TInstantPersistence),
    Ord(FInstantClassMetadata.Persistence));
  AssertEquals('PersistenceType incorrect', 'peEmbedded', vStr);
end;

procedure TestTInstantClassMetadata.TestStorageMaps;
begin
  AssertNotNull('StorageMaps is nil!', FInstantClassMetadata.StorageMaps);

  FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TContactFilter');
  AssertNull('StorageMaps should be nil!', FInstantClassMetadata.StorageMaps);
end;

procedure TestTInstantClassMetadata.TestStorageName;
begin
  // Test with default class StorageName returns ''.
  AssertEquals('StorageName incorrect!', '',
    FInstantClassMetadata.StorageName);

  // Test for User entered non-default class StorageName.
  FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TCategory');
  AssertEquals('StorageName incorrect!', 'Categories',
    FInstantClassMetadata.StorageName);
end;

procedure TestTInstantClassMetadata.TestTableName;
begin
  // Test with default class StorageName (TableName).
  AssertEquals('TableName incorrect!', 'Contact',
    FInstantClassMetadata.TableName);

  // Test for User entered non-default class StorageName (TableName).
  FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TCategory');
  AssertEquals('TableName incorrect!', 'Categories',
    FInstantClassMetadata.TableName);
end;

procedure TestTInstantClassMetadatas.SetUp;
var
  TestItem: TInstantClassMetadata;
begin
  FInstantClassMetadatas := TInstantClassMetadatas.Create(nil);
  TestItem := TInstantClassMetadata(FInstantClassMetadatas.Add);
  TestItem.Name := 'TPerson';
  TestItem := TInstantClassMetadata(FInstantClassMetadatas.Add);
  TestItem.Name := 'TAddress';
  TestItem := TInstantClassMetadata(FInstantClassMetadatas.Add);
  TestItem.Name := 'TCountry';
end;

procedure TestTInstantClassMetadatas.TearDown;
begin
  FInstantClassMetadatas.Free;
  FInstantClassMetadatas := nil;
end;

procedure TestTInstantClassMetadatas.TestAdd;
var
  vReturnValue: TInstantClassMetadata;
begin
  vReturnValue := FInstantClassMetadatas.Add;
  AssertNotNull('vReturnValue is nil!', vReturnValue);
  AssertEquals('Count is incorrect!', 4, FInstantClassMetadatas.Count);
  FInstantClassMetadatas.Remove(vReturnValue);
  AssertEquals('Count is incorrect!', 3, FInstantClassMetadatas.Count);
end;

procedure TestTInstantClassMetadatas.TestFind;
var
  vReturnValue: TInstantClassMetadata;
  vName: string;
begin
  vName := 'TAddress';
  vReturnValue := FInstantClassMetadatas.Find(vName);
  AssertEquals('TestFind failed!', vName, vReturnValue.Name);
end;

procedure TestTInstantClassMetadatas.TestItems;
begin
  AssertEquals('The second item''s name is incorrect!', 'TAddress',
    FInstantClassMetadatas.Items[1].Name);
end;

initialization
  // Register any test cases with the test runner
{$IFNDEF CURR_TESTS}
  RegisterTests([TestTInstantClassMetadata,
                 TestTInstantClassMetadatas]);
{$ENDIF}

end.

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

interface

uses fpcunit, InstantPersistence;

type
  // Test methods for class TInstantFieldMetadata
  TestTInstantFieldMetadata = class(TTestCase)
  private
    FOwner: TInstantTableMetadata;
    FCollection: TInstantFieldMetadatas;
    FInstantFieldMetadata: TInstantFieldMetadata;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCollection;
    procedure TestDataType;
    procedure TestExternalTableName;
    procedure TestOptions;
    procedure TestOriginalAttributeType;
    procedure TestSize;
  end;

  // Test methods for class TInstantFieldMetadatas
  TestTInstantFieldMetadatas = class(TTestCase)
  private
    FOwner: TInstantTableMetadata;
    FInstantFieldMetadatas: TInstantFieldMetadatas;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAddFieldMetadata;
    procedure TestAddRemoveItems;
    procedure TestOwner;
  end;

implementation

uses SysUtils, TypInfo, testregistry;

procedure TestTInstantFieldMetadata.SetUp;
begin
  FOwner := TInstantTableMetadata.Create(nil);
  FCollection := TInstantFieldMetadatas.Create(FOwner);
  FInstantFieldMetadata := TInstantFieldMetadata.Create(FCollection);
  FInstantFieldMetadata.DataType := dtInteger;
  FInstantFieldMetadata.ExternalTableName := 'ExternalTableName';
  FInstantFieldMetadata.Size := 10;
  FInstantFieldMetadata.Options := [foRequired];
  FInstantFieldMetadata.OriginalAttributeType := atInteger;
end;

procedure TestTInstantFieldMetadata.TearDown;
begin
  FInstantFieldMetadata.Free;
  FInstantFieldMetadata := nil;
  FreeAndNil(FCollection);
  FreeAndNil(FOwner);
end;

procedure TestTInstantFieldMetadata.TestCollection;
begin
  AssertNotNull('Collection is nil!', FInstantFieldMetadata.Collection);
  AssertSame('Collection is incorrect!', FCollection,
    FInstantFieldMetadata.Collection);
end;

procedure TestTInstantFieldMetadata.TestDataType;
var
  vStr: string;
begin
  vStr := GetEnumName(TypeInfo(TInstantDataType),
    Ord(FInstantFieldMetadata.DataType));
  AssertEquals('DataType incorrect!', 'dtInteger', vStr);
end;

procedure TestTInstantFieldMetadata.TestExternalTableName;
begin
  AssertEquals('ExternalTableName incorrect!', 'ExternalTableName',
    FInstantFieldMetadata.ExternalTableName);
end;

procedure TestTInstantFieldMetadata.TestOptions;
begin
  AssertTrue('Options incorrect!', foRequired in FInstantFieldMetadata.Options);
end;

procedure TestTInstantFieldMetadata.TestOriginalAttributeType;
var
  vStr: string;
begin
  vStr := GetEnumName(TypeInfo(TInstantAttributeType),
    Ord(FInstantFieldMetadata.OriginalAttributeType));
  AssertEquals('OriginalAttributeType incorrect!', 'atInteger', vStr);
end;

procedure TestTInstantFieldMetadata.TestSize;
begin
  AssertEquals('Size incorrect!', 10, FInstantFieldMetadata.Size);
end;

procedure TestTInstantFieldMetadatas.SetUp;
begin
  FOwner := TInstantTableMetadata.Create(nil);
  FInstantFieldMetadatas := TInstantFieldMetadatas.Create(FOwner);
end;

procedure TestTInstantFieldMetadatas.TearDown;
begin
  FInstantFieldMetadatas.Free;
  FInstantFieldMetadatas := nil;
  FreeAndNil(FOwner);
end;

procedure TestTInstantFieldMetadatas.TestAddRemoveItems;
var
  vReturnValue: TInstantFieldMetadata;
begin
  vReturnValue := FInstantFieldMetadatas.Add;
  AssertNotNull('vReturnValue is nil!', vReturnValue);
  AssertEquals('Count is incorrect!', 1, FInstantFieldMetadatas.Count);
  AssertNotNull('Items[0] is nil!', FInstantFieldMetadatas.Items[0]);
  FInstantFieldMetadatas.Remove(vReturnValue);
  AssertEquals('Count is incorrect!', 0, FInstantFieldMetadatas.Count);
end;

procedure TestTInstantFieldMetadatas.TestAddFieldMetadata;
var
  vExternalTableName: string;
  vOptions: TInstantFieldOptions;
  vOriginalAttributeType: TInstantAttributeType;
  vSize: Integer;
  vDataType: TInstantDataType;
  vName: string;
  vInstantFieldMetadata: TInstantFieldMetadata;
  vStr: string;
begin
  vName := 'Code';
  vDataType := dtInteger;
  vSize := 10;
  vOriginalAttributeType := atInteger;
  vOptions := [foRequired];
  vExternalTableName := 'ExternalTableName';
  FInstantFieldMetadatas.AddFieldMetadata(vName, vDataType, vSize,
    vOriginalAttributeType, vOptions, vExternalTableName);

  AssertEquals('Count is incorrect!', 1, FInstantFieldMetadatas.Count);
  vInstantFieldMetadata := FInstantFieldMetadatas.Items[0];
  AssertNotNull(vInstantFieldMetadata);
  AssertEquals('Name is incorrect!', vName, vInstantFieldMetadata.Name);
  AssertEquals('Size is incorrect!', 10, vInstantFieldMetadata.Size);
  vStr := GetEnumName(TypeInfo(TInstantAttributeType),
    Ord(vInstantFieldMetadata.OriginalAttributeType));
  AssertEquals('OriginalAttributeType incorrect!', 'atInteger', vStr);
  AssertTrue('Count is incorrect!',
    foRequired in vInstantFieldMetadata.Options);
  vStr := GetEnumName(TypeInfo(TInstantDataType),
    Ord(vInstantFieldMetadata.DataType));
  AssertEquals('DataType incorrect!', 'dtInteger', vStr);
  AssertEquals('ExternalTableName is incorrect!', 'ExternalTableName',
    vInstantFieldMetadata.ExternalTableName);
end;

procedure TestTInstantFieldMetadatas.TestOwner;
begin
  AssertNotNull('Owner is nil!', FInstantFieldMetadatas.Owner);
  AssertSame('Owner value is incorrect!', FOwner, FInstantFieldMetadatas.Owner);
end;



initialization
  // Register any test cases with the test runner
{$IFNDEF CURR_TESTS}
  RegisterTests([TestTInstantFieldMetadata,
                 TestTInstantFieldMetadatas]);
{$ENDIF}

end.

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

interface

uses fpcunit, InstantPersistence;

type

  // Test methods for class TInstantRelationalScheme
  TestTInstantRelationalScheme = class(TTestCase)
  private
    FInstantRelationalScheme: TInstantRelationalScheme;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestBlobStreamFormat;
    procedure TestFindTableMetadata;
    procedure TestIdDataType;
    procedure TestIdSize;
    procedure TestTableMetadataCount;
    procedure TestTableMetadatas;
  end;

implementation

uses SysUtils, testregistry, InstantClasses, InstantConsts;

procedure TestTInstantRelationalScheme.SetUp;
begin
  if InstantModel.ClassMetadatas.Count > 0 then
    InstantModel.ClassMetadatas.Clear;
  InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));

  FInstantRelationalScheme := TInstantRelationalScheme.Create(InstantModel);
end;

procedure TestTInstantRelationalScheme.TearDown;
begin
  FInstantRelationalScheme.Free;
  FInstantRelationalScheme := nil;
end;

procedure TestTInstantRelationalScheme.TestBlobStreamFormat;
begin
  AssertTrue('Incorrect BlobStreamFormat!',
    sfBinary = FInstantRelationalScheme.BlobStreamFormat);
  FInstantRelationalScheme.BlobStreamFormat := sfXML;
  AssertTrue('Incorrect BlobStreamFormat!',
    sfXML = FInstantRelationalScheme.BlobStreamFormat);
end;

procedure TestTInstantRelationalScheme.TestFindTableMetadata;
var
  vReturnValue: TInstantTableMetadata;
  vName: string;
begin
  vName := 'Contact';
  vReturnValue := FInstantRelationalScheme.FindTableMetadata(vName);
  AssertNotNull('Could not find TableMetadata!', vReturnValue);
  AssertEquals('', vName, vReturnValue.Name);
end;

procedure TestTInstantRelationalScheme.TestIdDataType;
begin
  AssertTrue('Incorrect IdDataType!',
    dtString = FInstantRelationalScheme.IdDataType);
  FInstantRelationalScheme.IdDataType := dtInteger;
  AssertTrue('Incorrect IdDataType!',
    dtInteger = FInstantRelationalScheme.IdDataType);
end;

procedure TestTInstantRelationalScheme.TestIdSize;
begin
  AssertEquals('Incorrect IDSize!', InstantDefaultFieldSize,
    FInstantRelationalScheme.IdSize);
  FInstantRelationalScheme.IdSize := 10;
  AssertEquals('Incorrect IDSize!', 10, FInstantRelationalScheme.IdSize);
end;

procedure TestTInstantRelationalScheme.TestTableMetadataCount;
begin
  AssertEquals('Incorrect TableMetadataCount!', 8,
    FInstantRelationalScheme.TableMetadataCount);
end;

procedure TestTInstantRelationalScheme.TestTableMetadatas;
var
  vReturnValue: TInstantTableMetadata;
begin
  vReturnValue := FInstantRelationalScheme.TableMetadatas[0];
  AssertNotNull('TableMetadata is nil!', vReturnValue);
  AssertEquals('', 'Address', vReturnValue.Name);
end;

initialization
  // Register any test cases with the test runner
{$IFNDEF CURR_TESTS}
  RegisterTests([TestTInstantRelationalScheme]);
{$ENDIF}

end.
 
Index: TestIO.cfg
===================================================================
RCS file: /cvsroot/instantobjects/Source/Tests/TestIO.cfg,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** TestIO.cfg	20 Feb 2005 19:26:42 -0000	1.1
--- TestIO.cfg	3 May 2005 04:52:37 -0000	1.2
***************
*** 1,38 ****
! -$A8
! -$B-
! -$C+
! -$D+
! -$E-
! -$F-
! -$G+
! -$H+
! -$I+
! -$J-
! -$K-
! -$L+
! -$M-
! -$N+
! -$O+
! -$P+
! -$Q-
! -$R-
! -$S-
! -$T-
! -$U-
! -$V+
! -$W-
! -$X+
! -$YD
! -$Z1
! -cg
! -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
! -H+
! -W+
! -M
! -$M16384,1048576
! -K$00400000
! -LE"c:\programmi\borland\delphi7\Projects\Bpl"
! -LN"c:\programmi\borland\delphi7\Projects\Bpl"
! -w-UNSAFE_TYPE
! -w-UNSAFE_CODE
! -w-UNSAFE_CAST
--- 1,44 ----
! -$A8
! -$B-
! -$C+
! -$D+
! -$E-
! -$F-
! -$G+
! -$H+
! -$I+
! -$J-
! -$K-
! -$L+
! -$M-
! -$N+
! -$O+
! -$P+
! -$Q-
! -$R-
! -$S-
! -$T+
! -$U-
! -$V+
! -$W-
! -$X+
! -$YD
! -$Z1
! -cg
! -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
! -H+
! -W+
! -M
! -$M16384,1048576
! -K$00400000
! -N"D:\D\DCU\D7\Tmp"
! -LE"c:\program files\borland\delphi7\Projects\Bpl"
! -LN"c:\program files\borland\delphi7\Projects\Bpl"
! -U"D:\L\ubmock\src"
! -O"D:\L\ubmock\src"
! -I"D:\L\ubmock\src"
! -R"D:\L\ubmock\src"
! -DCURR_TESTS
! -w-UNSAFE_TYPE
! -w-UNSAFE_CODE
! -w-UNSAFE_CAST

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

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

interface

uses SysUtils, fpcunit, InstantMock, InstantPersistence;

type
  TRunMethodCategory = procedure(Category: TInstantAttributeCategory) of object;
  TRunMethodIAClass = procedure(AClass: TInstantAttributeClass) of object;

  // Extended test methods for class TTestCase
  TTestCaseEx = class(TTestCase)
  public
    class procedure AssertException(const AMessage: string;
                                    AExceptionClass: ExceptClass;
                                    ACategory: TInstantAttributeCategory;
                                    AMethod: TRunMethodCategory);
                                    overload;
    class procedure AssertException(AExceptionClass: ExceptClass;
                                    ACategory: TInstantAttributeCategory;
                                    AMethod: TRunMethodCategory);
                                    overload;
    class procedure AssertException(const AMessage: string;
                                    AExceptionClass: ExceptClass;
                                    AClass: TInstantAttributeClass;
                                    AMethod: TRunMethodIAClass);
                                    overload;
    class procedure AssertException(AExceptionClass: ExceptClass;
                                    AClass: TInstantAttributeClass;
                                    AMethod: TRunMethodIAClass);
                                    overload;
    class procedure AssertNoException(const AMessage: string;
                                    AExceptionClass: ExceptClass;
                                    ACategory: TInstantAttributeCategory;
                                    AMethod: TRunMethodCategory);
                                    overload;
    class procedure AssertNoException(AExceptionClass: ExceptClass;
                                    ACategory: TInstantAttributeCategory;
                                    AMethod: TRunMethodCategory);
                                    overload;
    class procedure AssertNoException(const AMessage: string;
                                    AExceptionClass: ExceptClass;
                                    AClass: TInstantAttributeClass;
                                    AMethod: TRunMethodIAClass);
                                    overload;
    class procedure AssertNoException(AExceptionClass: ExceptClass;
                                    AClass: TInstantAttributeClass;
                                    AMethod: TRunMethodIAClass);
                                    overload;
  end;

  // Test methods for class TInstantAttributeMetadata
  TestTInstantAttributeMetadata = class(TTestCaseEx)
  private
    FConn: TInstantMockConnector;
    FInstantAttributeMetadata: TInstantAttributeMetadata;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCreateAttribute;
    procedure TestAssign;
    procedure TestCheckAttributeClass;
    procedure TestCheckCategory;
    procedure TestCheckIsIndexed;
    procedure TestIsAttributeClass;
  end;

  // Test methods for class TInstantAttributeMetadatas
  TestTInstantAttributeMetadatas = class(TTestCase)
  private
    FOwner: TInstantClassMetadata;
    FInstantAttributeMetadatas: TInstantAttributeMetadatas;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAddRemove;
    procedure TestClear;
    procedure TestFind;
    procedure TestOwner;
  end;

implementation

uses Classes, TypInfo, testregistry, InstantClasses;

class procedure TTestCaseEx.AssertException(const AMessage: string;
AExceptionClass: ExceptClass; ACategory: TInstantAttributeCategory;
AMethod: TRunMethodCategory);
var
  Passed : Boolean;
  ExceptionName: string;
begin
  Passed := False;
  try
    AMethod(ACategory);
  except
    on E: Exception do
    begin
      ExceptionName := E.ClassName;
      if E.ClassType.InheritsFrom(AExceptionClass) then
      begin
        Passed := AExceptionClass.ClassName = E.ClassName;
      end;
    end;
  end;
  AssertTrue(Format(SExceptionCompare,
    [AExceptionClass.ClassName, ExceptionName])+ ': ' + AMessage, Passed);
end;

class procedure TTestCaseEx.AssertException(const AMessage: string;
AExceptionClass: ExceptClass; AClass: TInstantAttributeClass;
AMethod: TRunMethodIAClass);
var
  Passed : Boolean;
  ExceptionName: string;
begin
  Passed := False;
  try
    AMethod(AClass);
  except
    on E: Exception do
    begin
      ExceptionName := E.ClassName;
      if E.ClassType.InheritsFrom(AExceptionClass) then
      begin
        Passed := AExceptionClass.ClassName = E.ClassName;
      end;
    end;
  end;
  AssertTrue(Format(SExceptionCompare,
    [AExceptionClass.ClassName, ExceptionName])+ ': ' + AMessage, Passed);
end;

class procedure TTestCaseEx.AssertException(AExceptionClass: ExceptClass;
  ACategory: TInstantAttributeCategory; AMethod: TRunMethodCategory);
begin
  AssertException('', AExceptionClass, ACategory, AMethod);
end;

class procedure TTestCaseEx.AssertException(AExceptionClass: ExceptCl...
 
[truncated message content]

[Instantobjects-cvscommit] Source/Tests TestIO.lpi,NONE,1.1

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

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

Added Files:
	TestIO.lpi 
Log Message:
Lazarus project to Test IO.

--- NEW FILE: TestIO.lpi ---
<?xml version="1.0"?>
<CONFIG>
  <ProjectOptions>
    <PathDelim Value="\"/>
    <Version Value="5"/>
    <General>
      <MainUnit Value="0"/>
      <ActiveEditorIndexAtStart Value="0"/>
      <IconPath Value="./"/>
      <TargetFileExt Value=".exe"/>
      <Title Value="TestIO"/>
    </General>
    <JumpHistory Count="25" HistoryIndex="24">
      <Position1>
        <Filename Value="D:\SELEQT\InstantObjects1.7\Source\core\InstantPersistence.pas"/>
        <Caret Line="14313" Column="1" TopLine="14291"/>
      </Position1>
      <Position2>
        <Filename Value="D:\SELEQT\InstantObjects1.7\Source\core\InstantPersistence.pas"/>
[...1039 lines suppressed...]
      <Item1>
        <Expression Value="Command"/>
      </Item1>
      <Item2>
        <Expression Value="ClassNameField.value"/>
      </Item2>
    </Watches>
    <Exceptions Count="3">
      <Item1>
        <Name Value="ECodetoolError"/>
      </Item1>
      <Item2>
        <Name Value="EFOpenError"/>
      </Item2>
      <Item3>
        <Name Value="EVariantTypeCastError"/>
      </Item3>
    </Exceptions>
  </Debugging>
</CONFIG>

[Instantobjects-cvscommit] Source/Core InstantFpcUtils.pas,NONE,1.1 InstantClasses.pas,1.6,1.7 InstantCode.pas,1.14,1.15 InstantDefines.inc,1.4,1.5 InstantPersistence.pas,1.36,1.37 InstantPresentation.pas,1.15,1.16 InstantRtti.pas,1.4,1.5 InstantUtils.pas,1.3,1.4

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

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

Modified Files:
	InstantClasses.pas InstantCode.pas InstantDefines.inc 
	InstantPersistence.pas InstantPresentation.pas InstantRtti.pas 
	InstantUtils.pas 
Added Files:
	InstantFpcUtils.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.

Index: InstantCode.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Core/InstantCode.pas,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** InstantCode.pas	5 Apr 2005 00:35:28 -0000	1.14
--- InstantCode.pas	2 May 2005 23:26:32 -0000	1.15
***************
*** 25,29 ****
   *
   * Contributor(s):
!  * Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Steven Mitchell,
   * Joao Morais
   *
--- 25,29 ----
   *
   * Contributor(s):
!  * Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Steven Mitchell, , Uberto Barbini
   * Joao Morais
   *
***************
*** 2845,2850 ****
  end;
  
! function CompareMembers(List: TStringList;
!   Index1, Index2: Integer): Integer; overload;
  begin
    Result := CompareMembers(List.Objects[Index1], List.Objects[Index2]);
--- 2845,2850 ----
  end;
  
! function CompareMembersList(List: TStringList;
!   Index1, Index2: Integer): Integer;
  begin
    Result := CompareMembers(List.Objects[Index1], List.Objects[Index2]);
***************
*** 4912,4917 ****
  end;
  
! function CompareDivisions(List: TStringList;
!   Index1, Index2: Integer): Integer; overload;
  begin
    Result := CompareDivisions(List.Objects[Index1], List.Objects[Index2]);
--- 4912,4917 ----
  end;
  
! function CompareDivisionsList(List: TStringList;
!   Index1, Index2: Integer): Integer;
  begin
    Result := CompareDivisions(List.Objects[Index1], List.Objects[Index2]);
***************
*** 4922,4926 ****
  begin
    Result := FindNearest(FDivisions, Division, Prior, Next, nil, nil,
!     CompareDivisions);
  end;
  
--- 4922,4926 ----
  begin
    Result := FindNearest(FDivisions, Division, Prior, Next, nil, nil,
!     CompareDivisionsList);
  end;
  
***************
*** 4938,4942 ****
      List := FMembers;
    Result := FindNearest(List, Instance, Prior, Next, VisibilityFilter,
!     @Visibilities, CompareMembers);
  end;
  
--- 4938,4942 ----
      List := FMembers;
    Result := FindNearest(List, Instance, Prior, Next, VisibilityFilter,
!     @Visibilities, CompareMembersList);
  end;
  

Index: InstantPresentation.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Core/InstantPresentation.pas,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** InstantPresentation.pas	11 Apr 2005 08:29:55 -0000	1.15
--- InstantPresentation.pas	2 May 2005 23:26:33 -0000	1.16
***************
*** 638,645 ****
  uses
  {$IFDEF MSWINDOWS}
!   Controls, Mask, Forms,
  {$ENDIF}
  {$IFDEF LINUX}
!   QControls, QMask, QForms,
  {$ENDIF}
    {$IFDEF D6+}Variants, MaskUtils, FmtBcd,{$ENDIF} InstantClasses,
--- 638,645 ----
  uses
  {$IFDEF MSWINDOWS}
!   //Forms,
  {$ENDIF}
  {$IFDEF LINUX}
!   QForms,
  {$ENDIF}
    {$IFDEF D6+}Variants, MaskUtils, FmtBcd,{$ENDIF} InstantClasses,
***************
*** 1640,1647 ****
--- 1640,1649 ----
      if ATypeInfo = TypeInfo(TDateTime) then
        Result := DB.ftDateTime
+ (*
      else if ATypeInfo = TypeInfo(TDate) then
        Result := DB.ftDate
      else if ATypeInfo = TypeInfo(TTime) then
        Result := DB.ftTime
+ *)      
      else
        Result := DB.ftFloat;
***************
*** 4123,4127 ****
      Exposer.DataEvent(deFieldChange, Integer(Field));
    except
!     Application.HandleException(Self);
    end;
    inherited Destroy;
--- 4125,4130 ----
      Exposer.DataEvent(deFieldChange, Integer(Field));
    except
!     if Assigned(Classes.ApplicationHandleException) then
!       Classes.ApplicationHandleException(Self);
    end;
    inherited Destroy;

Index: InstantPersistence.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Core/InstantPersistence.pas,v
retrieving revision 1.36
retrieving revision 1.37
diff -C2 -d -r1.36 -r1.37
*** InstantPersistence.pas	8 Apr 2005 10:16:08 -0000	1.36
--- InstantPersistence.pas	2 May 2005 23:26:32 -0000	1.37
***************
*** 26,30 ****
   * Contributor(s):
   * Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell,
!  * Joao Morais, Cesar Coll
   *
   * ***** END LICENSE BLOCK ***** *)
--- 26,30 ----
   * Contributor(s):
   * Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell,
!  * Joao Morais, Cesar Coll, Uberto Barbini
   *
   * ***** END LICENSE BLOCK ***** *)
***************
*** 49,52 ****
--- 49,55 ----
    QGraphics,
  {$ENDIF}
+ {$IFDEF FPC}
+   InstantFpcUtils,
+ {$ENDIF}
    Classes, Contnrs, SysUtils, DB, InstantClasses, InstantCommand, InstantConsts;
  
***************
*** 1203,1207 ****
--- 1206,1214 ----
      function ChangesDisabled: Boolean;
      procedure CheckId;
+ {$IFDEF FPC}
+     class function ClassType: TInstantObjectClass;
+ {$ELSE}
      function ClassType: TInstantObjectClass;
+ {$ENDIF}
      procedure ClearObjects;
      function Clone(AConnector: TInstantConnector = nil): TInstantObject; overload;
***************
*** 2443,2452 ****
  uses
  {$IFDEF MSWINDOWS}
!   Windows, Mask,
  {$ENDIF}
  {$IFDEF LINUX}
    Types,
  {$ENDIF}
!   TypInfo, {$IFDEF D6+}MaskUtils, Variants,{$ENDIF}
    InstantUtils, InstantRtti, InstantDesignHook, InstantCode;
  
--- 2450,2465 ----
  uses
  {$IFDEF MSWINDOWS}
!   Windows,
  {$ENDIF}
  {$IFDEF LINUX}
    Types,
  {$ENDIF}
!   TypInfo,
! {$IFDEF D6+}
!   MaskUtils,
!   Variants,
! {$ELSE}
!   Mask,
! {$ENDIF}
    InstantUtils, InstantRtti, InstantDesignHook, InstantCode;
  
***************
*** 7259,7263 ****
--- 7272,7280 ----
  end;
  
+ {$IFDEF FPC}
+ class function TInstantObject.ClassType: TInstantObjectClass;
+ {$ELSE}
  function TInstantObject.ClassType: TInstantObjectClass;
+ {$ENDIF}
  begin
    Result := TInstantObjectClass(inherited ClassType);
***************
*** 8375,8378 ****
--- 8392,8396 ----
        Destroy;
        Self := nil;
+       {$IFNDEF FPC} //UB it raise an error in FPC, surely there'd be better ways to accomplish this
        asm
          MOV     [EBP - $09], EAX // Avoid calling AfterConstruction
***************
*** 8380,8383 ****
--- 8398,8402 ----
          ADD     ESP, $0C
        end;
+       {$ENDIF}
      end;
    end;
***************
*** 11991,11995 ****
--- 12010,12018 ----
  begin
    with Attribute do
+ {$IFDEF FPC}
+     FieldByName(Metadata.FieldName).AsFloat := Value;
+ {$ELSE}
      FieldByName(Metadata.FieldName).AsCurrency := Value;
+ {$ENDIF}
  end;
  
***************
*** 14744,14748 ****
--- 14767,14773 ----
  var
    Instance: Cardinal;
+ {$IFNDEF FPC}
    LibModule: PLibModule;
+ {$ENDIF}
  begin
    if HasModelResource(HInstance)then
***************
*** 14751,14754 ****
--- 14776,14780 ----
      LoadModelFromResource(MainInstance)
    else begin
+ {$IFNDEF FPC}
      LibModule := LibModuleList;
      while LibModule <> nil do
***************
*** 14763,14766 ****
--- 14789,14793 ----
        LibModule := LibModule.Next;
      end;
+ {$ENDIF}
    end;
  end;
***************
*** 14894,14898 ****
  {$IFDEF MSWINDOWS}
    GraphicClassList[gffBmp] := Graphics.TBitmap;
!   GraphicClassList[gffEmf] := Graphics.TMetaFile;
  {$ENDIF}
  {$IFDEF LINUX}
--- 14921,14927 ----
  {$IFDEF MSWINDOWS}
    GraphicClassList[gffBmp] := Graphics.TBitmap;
!   {$IFNDEF FPC}
!     GraphicClassList[gffEmf] := Graphics.TMetaFile;
!   {$ENDIF}
  {$ENDIF}
  {$IFDEF LINUX}

Index: InstantUtils.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Core/InstantUtils.pas,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** InstantUtils.pas	22 Feb 2005 08:05:04 -0000	1.3
--- InstantUtils.pas	2 May 2005 23:26:33 -0000	1.4
***************
*** 25,29 ****
   *
   * Contributor(s):
!  * Carlo Barazzetta, Adrea Petrelli, Nando Dessena
   *
   * ***** END LICENSE BLOCK ***** *)
--- 25,29 ----
   *
   * Contributor(s):
!  * Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Uberto Barbini
   *
   * ***** END LICENSE BLOCK ***** *)
***************
*** 96,99 ****
--- 96,102 ----
    Windows, ActiveX, ComObj,
  {$ENDIF}
+ {$IFDEF FPC}
+   InstantFpcUtils,
+ {$ENDIF}
    {$IFDEF D6+}Variants,{$ENDIF} InstantConsts, InstantRtti,
    SysUtils;
***************
*** 177,181 ****
        S2 := '';
      if coPartial in Options then
!       S := Copy(S1, 1, Length(S2))
      else
        S := S1;
--- 180,184 ----
        S2 := '';
      if coPartial in Options then
!       S := Copy(S1, 1,  Length(VarToStr(S2)))
      else
        S := S1;

Index: InstantRtti.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Core/InstantRtti.pas,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** InstantRtti.pas	23 Aug 2004 09:55:20 -0000	1.4
--- InstantRtti.pas	2 May 2005 23:26:33 -0000	1.5
***************
*** 25,29 ****
   *
   * Contributor(s):
!  * Carlo Barazzetta, Adrea Petrelli: porting Kylix
   *
   * ***** END LICENSE BLOCK ***** *)
--- 25,29 ----
   *
   * Contributor(s):
!  * Carlo Barazzetta, Adrea Petrelli, Uberto Barbini
   *
   * ***** END LICENSE BLOCK ***** *)
***************
*** 71,74 ****
--- 71,75 ----
    end;
  
+ function GetTypeInfo(PropInfo: PPropInfo) : PTypeInfo;
  procedure InstantGetEnumNames(TypeInfo: PTypeInfo; Names: TStrings;
    PrefixLen: Integer = 0);
***************
*** 84,88 ****
  uses
  {$IFDEF MSWINDOWS}
!   Controls,
  {$ENDIF}
  {$IFDEF LINUX}
--- 85,89 ----
  uses
  {$IFDEF MSWINDOWS}
! //  Controls,
  {$ENDIF}
  {$IFDEF LINUX}
***************
*** 92,95 ****
--- 93,105 ----
    {$IFDEF D6+}Variants,{$ENDIF}SysUtils;
  
+ function GetTypeInfo(PropInfo: PPropInfo) : PTypeInfo;
+ begin
+ {$IFDEF FPC}
+   Result := PropInfo^.PropType;
+ {$ELSE}
+   Result := PropInfo^.PropType^;
+ {$ENDIF}
+ end;
+ 
  function AccessProperty(AObject: TObject; PropPath: string;
    Value: Variant): Variant;
***************
*** 109,115 ****
      else if Assigned(PropInfo) then
      begin
!       if (Value <> Null) and Assigned(PropInfo.SetProc) then
        begin
!         case PropInfo^.PropType^^.Kind of
            tkClass:
              SetObjectProp(AObject, PropInfo, TObject(Integer(Value)));
--- 119,125 ----
      else if Assigned(PropInfo) then
      begin
!       if not VarIsNull(Value) and Assigned(PropInfo.SetProc) then
        begin
!         case GetTypeInfo(PropInfo)^.Kind of
            tkClass:
              SetObjectProp(AObject, PropInfo, TObject(Integer(Value)));
***************
*** 188,192 ****
          if Assigned(PInstance) and Assigned(TObject(PInstance^)) then
            TObject(PInstance^) := GetObjectProp(TObject(PInstance^), PropInfo);
!         TypeData := GetTypeData(PropInfo^.PropType^);
          if Assigned(TypeData) then
            Result := InstantGetPropInfo(TypeData.ClassType, PropPath, PInstance)
--- 198,202 ----
          if Assigned(PInstance) and Assigned(TObject(PInstance^)) then
            TObject(PInstance^) := GetObjectProp(TObject(PInstance^), PropInfo);
!         TypeData := GetTypeData(GetTypeInfo(PropInfo));
          if Assigned(TypeData) then
            Result := InstantGetPropInfo(TypeData.ClassType, PropPath, PInstance)
***************
*** 303,306 ****
--- 313,319 ----
    TypeKinds = [tkInteger, tkChar, tkEnumeration, tkFloat,
      tkString, tkSet, tkClass, tkWChar, tkLString, tkWString,
+ {$IFDEF FPC}
+     tkAString, tkBool,
+ {$ENDIF}
      tkVariant, tkArray, tkRecord, tkInt64, tkDynArray];
  begin
***************
*** 401,407 ****
    end;
    PropInfo := PropInfos[Index];
!   if PropInfo^.PropType^^.Kind = tkFloat then
    begin
!     if GetTypeData(PropInfo^.PropType^).FloatType = ftCurr then
      begin
        CurrencyValue := GetFloatProp(FInstance, PropInfo);
--- 414,420 ----
    end;
    PropInfo := PropInfos[Index];
!   if GetTypeInfo(PropInfo)^.Kind = tkFloat then
    begin
!     if GetTypeData(GetTypeInfo(PropInfo)).FloatType = ftCurr then
      begin
        CurrencyValue := GetFloatProp(FInstance, PropInfo);
***************
*** 410,416 ****
      begin
        Value := GetFloatProp(FInstance, PropInfo);
!       if (PropInfo.PropType^ = TypeInfo(TDateTime))
!         or (PropInfo.PropType^ = TypeInfo(TDate))
!         or (PropInfo.PropType^ = TypeInfo(TTime)) then
          Result := VarFromDateTime(Value)
        else
--- 423,430 ----
      begin
        Value := GetFloatProp(FInstance, PropInfo);
!       if (GetTypeInfo(PropInfo) = TypeInfo(TDateTime))
! //        or (PropInfo.PropType^ = TypeInfo(TDate))
! //        or (PropInfo.PropType^ = TypeInfo(TTime))
!         then
          Result := VarFromDateTime(Value)
        else

Index: InstantDefines.inc
===================================================================
RCS file: /cvsroot/instantobjects/Source/Core/InstantDefines.inc,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** InstantDefines.inc	25 Feb 2005 17:01:54 -0000	1.4
--- InstantDefines.inc	2 May 2005 23:26:32 -0000	1.5
***************
*** 24,26 ****
    {$DEFINE D9}
    {$DEFINE D9+}
! {$ENDIF}
\ No newline at end of file
--- 24,42 ----
    {$DEFINE D9}
    {$DEFINE D9+}
! {$ENDIF}
! 
! {$IFDEF FPC}
!   {$DEFINE D5+}
!   {$DEFINE D6+}
!   {$DEFINE D7+}
!   {$DEFINE SUPPORTS_WIDESTRING}
!   {$DEFINE SUPPORTS_INTERFACE}
!   {$DEFINE SUPPORTS_INT64}
!   {$DEFINE SUPPORTS_DYNAMICARRAYS}
!   {$DEFINE SUPPORTS_DEFAULTPARAMS}
!   {$DEFINE SUPPORTS_OVERLOAD}
!   {$ASMMODE Intel}
!   {$MODE DELPHI}
!   {$UNDEF UseRegAsm}
! {$ENDIF}
! 

--- NEW FILE: InstantFpcUtils.pas ---
unit InstantFpcUtils;
{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, RtlConsts, Db;

procedure OleError(ErrorCode: HResult);
procedure OleCheck(Result: HResult);

implementation

uses
  typinfo, variants;
  
  

function OleResult(Res: HResult): Boolean;
begin
  Result := Res and $80000000 = 0;
end;

{ Raise EOleSysError exception from an error code }

procedure OleError(ErrorCode: HResult);
begin
//  raise EOleSysError.Create('', ErrorCode, 0);
  raise Exception.CreateFmt('OleError %d',[ErrorCode]);
end;

{ Raise EOleSysError exception if result code indicates an error }

procedure OleCheck(Result: HResult);
begin
  if not OleResult(Result) then OleError(Result);
end;


end.


Index: InstantClasses.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Core/InstantClasses.pas,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** InstantClasses.pas	21 Mar 2005 16:48:04 -0000	1.6
--- InstantClasses.pas	2 May 2005 23:26:32 -0000	1.7
***************
*** 25,29 ****
   *
   * Contributor(s):
!  * Carlo Barazzetta, Adrea Petrelli, Marco Cantù, Nando Dessena
   *
   * ***** END LICENSE BLOCK ***** *)
--- 25,29 ----
   *
   * Contributor(s):
!  * Carlo Barazzetta, Adrea Petrelli, Marco Cantù, Nando Dessena, Uberto Barbini
   *
   * ***** END LICENSE BLOCK ***** *)
***************
*** 42,46 ****
  
  uses
! {$IFDEF VER130}Windows,{$ENDIF}
    Classes, InstantConsts, SysUtils;
  
--- 42,49 ----
  
  uses
! {$IFDEF MSWINDOWS}Windows,{$ENDIF}
! {$IFDEF FPC}
!   InstantFpcUtils, streamex,
! {$ENDIF}
    Classes, InstantConsts, SysUtils;
  
***************
*** 70,73 ****
--- 73,87 ----
    end;
  
+ {$IFDEF FPC}
+   TAbstractWriter = class(TDelphiWriter);
+ {$ELSE}
+   TAbstractWriter = class(TWriter);
+ {$ENDIF}
+ {$IFDEF FPC}
+   TAbstractReader = class(TDelphiReader);
+ {$ELSE}
+   TAbstractReader = class(TReader);
+ {$ENDIF}
+ 
    TInstantReader = class;
    TInstantWriter = class;
***************
*** 153,157 ****
    end;
  
!   TInstantReader = class(TReader)
    private
      FStream: TStream;
--- 167,171 ----
    end;
  
!   TInstantReader = class(TAbstractReader)
    private
      FStream: TStream;
***************
*** 170,174 ****
    end;
  
!   TInstantWriter = class(TWriter)
    private
      FStream: TStream;
--- 184,188 ----
    end;
  
!   TInstantWriter = class(TAbstractWriter)
    private
      FStream: TStream;
***************
*** 240,254 ****
      FStream: TStream;
      FTagStack: TStringList;
!     FWriter: TWriter;
      function GetCurrentTag: string;
      function GetEof: Boolean;
      function GetPosition: Integer;
      function GetTagStack: TStringList;
!     function GetWriter: TWriter;
      procedure SetPosition(Value: Integer);
      procedure WriteString(const S: string);
    protected
      property TagStack: TStringList read GetTagStack;
!     property Writer: TWriter read GetWriter;
    public
      constructor Create(Stream: TStream);
--- 254,268 ----
      FStream: TStream;
      FTagStack: TStringList;
!     FWriter: TAbstractWriter;
      function GetCurrentTag: string;
      function GetEof: Boolean;
      function GetPosition: Integer;
      function GetTagStack: TStringList;
!     function GetWriter: TAbstractWriter;
      procedure SetPosition(Value: Integer);
      procedure WriteString(const S: string);
    protected
      property TagStack: TStringList read GetTagStack;
!     property Writer: TAbstractWriter read GetWriter;
    public
      constructor Create(Stream: TStream);
***************
*** 268,276 ****
    TInstantXMLProcessor = class(TObject)
    private
!     FReader: TReader;
      FStream: TStream;
      function GetEof: Boolean;
      function GetPosition: Integer;
!     function GetReader: TReader;
      function GetToken: TInstantXMLToken;
      function ReadEscapedChar: Char;
--- 282,290 ----
    TInstantXMLProcessor = class(TObject)
    private
!     FReader: TAbstractReader;
      FStream: TStream;
      function GetEof: Boolean;
      function GetPosition: Integer;
!     function GetReader: TAbstractReader;
      function GetToken: TInstantXMLToken;
      function ReadEscapedChar: Char;
***************
*** 281,285 ****
      function ReadChar: Char;
      procedure SkipBlanks;
!     property Reader: TReader read GetReader;
    public
      constructor Create(Stream: TStream);
--- 295,299 ----
      function ReadChar: Char;
      procedure SkipBlanks;
!     property Reader: TAbstractReader read GetReader;
    public
      constructor Create(Stream: TStream);
***************
*** 1301,1308 ****
  end;
  
! function TInstantXMLProducer.GetWriter: TWriter;
  begin
    if not Assigned(FWriter) then
!     FWriter := TWriter.Create(Stream, InstantBufferSize);
    Result := FWriter;
  end;
--- 1315,1322 ----
  end;
  
! function TInstantXMLProducer.GetWriter: TAbstractWriter;
  begin
    if not Assigned(FWriter) then
!     FWriter := TAbstractWriter.Create(Stream, InstantBufferSize);
    Result := FWriter;
  end;
***************
*** 1407,1414 ****
  end;
  
! function TInstantXMLProcessor.GetReader: TReader;
  begin
    if not Assigned(FReader) then
!     FReader := TReader.Create(Stream, InstantBufferSize);
    Result := Freader;
  end;
--- 1421,1428 ----
  end;
  
! function TInstantXMLProcessor.GetReader: TAbstractReader;
  begin
    if not Assigned(FReader) then
!     FReader := TAbstractReader.Create(Stream, InstantBufferSize);
    Result := Freader;
  end;
***************
*** 1766,1772 ****
    const StopTag: string);
  
!   procedure ConvertOrdValue(PropType: PPTypeInfo; Value: Integer);
    begin
!     case PropType^^.Kind of
        tkInteger:
          Writer.WriteInteger(Value);
--- 1780,1786 ----
    const StopTag: string);
  
! (*  procedure ConvertOrdValue(PropType: PTypeInfo; Value: Integer);
    begin
!     case PropType^.Kind of
        tkInteger:
          Writer.WriteInteger(Value);
***************
*** 1774,1781 ****
          Writer.WriteChar(Chr(Value));
        tkEnumeration:
!         Writer.WriteIdent(GetEnumName(PropType^, Value));
      end;
    end;
! 
    procedure ConvertProperty(PropInfo: PPropInfo);
    var
--- 1788,1795 ----
          Writer.WriteChar(Chr(Value));
        tkEnumeration:
!         Writer.WriteIdent(GetEnumName(PropType, Value));
      end;
    end;
! *)
    procedure ConvertProperty(PropInfo: PPropInfo);
    var
***************
*** 1787,1800 ****
      ValueStr := Processor.ReadData;
      Writer.WriteStr(PropName);
!     case PropInfo^.PropType^^.Kind of
        tkInteger:
          Writer.WriteInteger(StrToInt(ValueStr));
        tkFloat:
        begin
!         if GetTypeData(PropInfo^.PropType^).FloatType = ftCurr then
            Writer.WriteCurrency(StrToCurr(ValueStr))
          else
            Writer.WriteFloat(StrToFloat(ValueStr));
        end;
        tkString, tkLString, tkChar:
          Writer.WriteString(ValueStr);
--- 1801,1820 ----
      ValueStr := Processor.ReadData;
      Writer.WriteStr(PropName);
!     case GetTypeInfo(PropInfo)^.Kind of //PropInfo^.PropType^^.Kind of
        tkInteger:
          Writer.WriteInteger(StrToInt(ValueStr));
        tkFloat:
        begin
!         if GetTypeData(GetTypeInfo(PropInfo)(*PropInfo^.PropType^*)).FloatType = ftCurr then
            Writer.WriteCurrency(StrToCurr(ValueStr))
          else
            Writer.WriteFloat(StrToFloat(ValueStr));
        end;
+       {$IFDEF FPC}
+       tkAString:
+         Writer.WriteString(ValueStr);
+       tkBool:
+         Writer.WriteIdent(ValueStr);
+       {$ENDIF}
        tkString, tkLString, tkChar:
          Writer.WriteString(ValueStr);

[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.

[Instantobjects-cvscommit] Source/Design/D7 DclIOCore.dof,1.8,1.9

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

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

Modified Files:
	DclIOCore.dof 
Log Message:
Chanfes for porting to FPC-Lazarus project. Some other little changes to remove uses to forms for non-visual level of IO.

Index: DclIOCore.dof
===================================================================
RCS file: /cvsroot/instantobjects/Source/Design/D7/DclIOCore.dof,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** DclIOCore.dof	22 Feb 2005 08:07:48 -0000	1.8
--- DclIOCore.dof	2 May 2005 23:26:33 -0000	1.9
***************
*** 102,106 ****
  [Parameters]
  RunParams=
! HostApplication=C:\Programmi\Borland\Delphi7\Bin\delphi32.exe
  Launcher=
  UseLauncher=0
--- 102,106 ----
  [Parameters]
  RunParams=
! HostApplication=
  Launcher=
  UseLauncher=0

[Instantobjects-cvscommit] Source/Brokers/NexusDbSQL/D2005 DclIONxdb.bdsproj,NONE,1.1 DclIONxdb.cfg,NONE,1.1 DclIONxdb.dof,NONE,1.1 DclIONxdb.dpk,NONE,1.1 DclIONxdb.res,NONE,1.1 IONxdb.bdsgroup,NONE,1.1 IONxdb.bdsproj,NONE,1.1 IONxdb.cfg,NONE,1.1 IONxdb.dof,NONE,1.1 IONxdb.dpk,NONE,1.1 IONxdb.res,NONE,1.1

[Steven M. <sr...@us...>]

Update of /cvsroot/instantobjects/Source/Brokers/NexusDbSQL/D2005
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32465/D2005

Added Files:
	DclIONxdb.bdsproj DclIONxdb.cfg DclIONxdb.dof DclIONxdb.dpk 
	DclIONxdb.res IONxdb.bdsgroup IONxdb.bdsproj IONxdb.cfg 
	IONxdb.dof IONxdb.dpk IONxdb.res 
Log Message:
Replaced previous NexusDb SQL brokers with updated versions of those
first provided by Bert Moorthaemer. These versions should work also with
the upcoming release of NexusDb V2. See the readme.txt file included.

--- NEW FILE: DclIONxdb.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=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=1
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=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=InstantObjects NexusDb Designtime Support (Delphi 7)
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=vcl;rtl;vclx;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;adortl;ibxpress;vclactnband;vclshlctrls;K102_R70;S402_r70;S402br70;Rz30Ctls70;Rz30DBCtls70;CS20Comps70;CSP20I70;ip4000v7;Rave50CLX;Rave50VCL;madBasic_;madDisAsm_;NexusDB107si70;NexusDB1071x70;NexusDB107sr70;NexusDB107pv70;NexusDB107sq70;NexusDB107re70;NexusDB107ts70;NexusDB107tc70;NexusDB107tn70;NexusDB107tw70;NexusDB107db70;NexusDB107ch70;DataAbstract_Core_D7;NexusDB107ll70;NexusDB107sd70;NexusDB107st70;NexusDB107pt70;IOCore;ionx70;CLXIB;VCLIB
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=2
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=3081
CodePage=1252
[Version Info Keys]
CompanyName=InstantObjects.org
FileDescription=InstantObjects NexusDbSQL Designtime Support (Delphi 7)
FileVersion=2.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=InstantObjects
ProductVersion=2.0
Comments=
[Excluded Packages]
C:\Program Files\Borland\Delphi7\Projects\Bpl\IONxdb_D7.bpl=InstantObjects NexusDB Runtime Support (Delphi 7)
c:\program files\borland\delphi7\Bin\dcltee70.bpl=TeeChart Components
c:\program files\borland\delphi7\Bin\dcldss70.bpl=Borland Decision Cube Components
D:\L\RO_SDK\Dcu\D7\RemObjects_WebBroker_D7.bpl=RemObjects SDK - WebBroker Library
D:\L\RO_SDK\Dcu\D7\RemObjects_Indy_D7.bpl=RemObjects SDK - Indy Library
D:\L\RO_SDK\Dcu\D7\RemObjects_RODX_D7.bpl=RemObjects SDK - RODXSock Library
D:\L\RO_SDK\Dcu\D7\RemObjects_BPDX_D7.bpl=RemObjects SDK - BPDX Library
D:\L\RO_SDK\Dcu\D7\RemObjects_DataSnap_D7.bpl=RemObjects SDK - DataSnap Integration Pack
D:\L\RO_PScript\Dcu\D7\PascalScript_RO_D7.bpl=RemObjects Pascal Script - RemObjects SDK 3.0 Integration
c:\program files\borland\delphi7\Bin\dclofficexp70.bpl=Microsoft Office XP Sample Automation Server Wrapper Components
D:\L\Woll2Woll\ip4000vcl7\package\ip4000clientvcl7.bpl=Woll2Woll InfoPower 4000 for Midas
c:\program files\borland\delphi7\Bin\dclclxdb70.bpl=Borland CLX Database Components
C:\Program Files\Borland\Delphi7\Bin\dclclxstd70.bpl=Borland CLX Standard Components
C:\Program Files\Borland\Delphi7\Projects\Bpl\NexusDB200dv70.bpl=NexusDB 2.00 - designtime - VCL70
[HistoryLists\hlConditionals]
Count=1
Item0=MM7
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=3
Item0=..\..\..\core
Item1=C:\Program Files\ModelMakerTools\ModelMaker\8.00\Experts
Item2=..\
[HistoryLists\hlOutputDirectorry]
Count=1
Item0=C:\Program Files\ModelMakerTools\ModelMaker\8.00\Experts

--- NEW FILE: IONxdb.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"D:\D\Delphi2005 Projects\Bpl"
-LN"D:\D\Delphi2005 Projects\Bpl"
-U"..\..\..\core"
-O"..\..\..\core"
-I"..\..\..\core"
-R"..\..\..\core"
-Z
-w-SYMBOL_PLATFORM
-w-UNIT_PLATFORM
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

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

--- NEW FILE: IONxdb.dpk ---
package IONxdb;

{$R *.res}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS ON}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'InstantObjects NexusDB Runtime Support (Delphi 2005)'}
{$LIBSUFFIX '_D9'}
{$RUNONLY}
{$IMPLICITBUILD OFF}
{$DEFINE Nx1}

requires
  vcl,
  vclx,
  dbrtl,
  rtl,
  IOCore,
  vcldb;

contains
  InstantNexusDbConnectionDefEdit in '..\InstantNexusDbConnectionDefEdit.pas' {InstantNexusDBConnectionDefEditForm},
  InstantNexusDb in '..\InstantNexusDb.pas',
  InstantNexusDbConsts in '..\InstantNexusDbConsts.pas',
  InstantNexusDbEmbeddedConnectionDefEdit in '..\InstantNexusDbEmbeddedConnectionDefEdit.pas' {InstantNexusDBEmbeddedConnectionDefEditForm},
  InstantNexusDbEmbedded in '..\InstantNexusDbEmbedded.pas';

end.

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

--- NEW FILE: DclIONxdb.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"D:\D\Delphi2005 Projects\Bpl"
-LN"D:\D\Delphi2005 Projects\Bpl"
-Z
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

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

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

--- NEW FILE: DclIONxdb.dpk ---
package DclIONxdb;

{$R *.res}
{$R '..\InstantNexusDb.dcr'}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS ON}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'InstantObjects NexusDb Designtime Support (Delphi 2005)'}
{$LIBSUFFIX '_D9'}
{$DESIGNONLY}
{$IMPLICITBUILD OFF}

requires
  vcl,
  vcldb,
  IOCore,
  IONxdb;

contains
  InstantNexusDbReg in '..\InstantNexusDbReg.pas';
  
end.

--- NEW FILE: IONxdb.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=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=1
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=0
UnitLibrary=1
UnitPlatform=0
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=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=InstantObjects NexusDB Runtime Support (Delphi 7)
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=..\..\..\core
Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k;DJCL70;JVCL200_R70;qrpt;CS20Comps70;CSP20I70;iobde70;ioado70;iodbx70;Nexus100si70;Nexus1001x70;Nexus100sr70;Nexus100pv70;Nexus100sq70;Nexus100re70;Nexus100ts70;Nexus100tc70;Nexus100tn70;Nexus100tw70;Nexus100db70;Nexus100ch70;rbTDBC77;rbDIDE77;rbDAD77;rbUSER77;rbRCL77;rbDBDE77;rbBDE77;rbDB77;rbADO77;rbDBE77;rbIBE77;rbIDE77;rbCIDE77;rbRIDE77;rbRAP77;Rz252D70;Rz252N70;Nexus100ll70;Nexus100sd70;Nexus100st70;Nexus100pt70;ionx70
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=C:\D7\Borland\Delphi7\Bin\
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=2
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1043
CodePage=1252
[Version Info Keys]
CompanyName=InstantObjects.org
FileDescription=InstantObjects NexusDB Runtime Support (Delphi 7)
FileVersion=2.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=InstantObjects
ProductVersion=2.0
[Excluded Packages]
C:\Program Files\Borland\Delphi7\Projects\Bpl\IONxdb_D7.bpl=InstantObjects NexusDB Runtime Support (Delphi 7)
c:\program files\borland\delphi7\Bin\dcltee70.bpl=TeeChart Components
c:\program files\borland\delphi7\Bin\dcldss70.bpl=Borland Decision Cube Components
D:\L\RO_SDK\Dcu\D7\RemObjects_WebBroker_D7.bpl=RemObjects SDK - WebBroker Library
D:\L\RO_SDK\Dcu\D7\RemObjects_Indy_D7.bpl=RemObjects SDK - Indy Library
D:\L\RO_SDK\Dcu\D7\RemObjects_RODX_D7.bpl=RemObjects SDK - RODXSock Library
D:\L\RO_SDK\Dcu\D7\RemObjects_BPDX_D7.bpl=RemObjects SDK - BPDX Library
D:\L\RO_SDK\Dcu\D7\RemObjects_DataSnap_D7.bpl=RemObjects SDK - DataSnap Integration Pack
D:\L\RO_PScript\Dcu\D7\PascalScript_RO_D7.bpl=RemObjects Pascal Script - RemObjects SDK 3.0 Integration
c:\program files\borland\delphi7\Bin\dclofficexp70.bpl=Microsoft Office XP Sample Automation Server Wrapper Components
D:\L\Woll2Woll\ip4000vcl7\package\ip4000clientvcl7.bpl=Woll2Woll InfoPower 4000 for Midas
c:\program files\borland\delphi7\Bin\dclclxdb70.bpl=Borland CLX Database Components
C:\Program Files\Borland\Delphi7\Bin\dclclxstd70.bpl=Borland CLX Standard Components
C:\Program Files\Borland\Delphi7\Projects\Bpl\NexusDB200dv70.bpl=NexusDB 2.00 - designtime - VCL70
[HistoryLists\hlConditionals]
Count=1
Item0=MM7
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=3
Item0=..\..\..\core
Item1=C:\Program Files\ModelMakerTools\ModelMaker\8.00\Experts
Item2=..\
[HistoryLists\hlOutputDirectorry]
Count=1
Item0=C:\Program Files\ModelMakerTools\ModelMaker\8.00\Experts

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

[Instantobjects-cvscommit] Source/Brokers/NexusDbSQL/D6 DclIONxdb.cfg,NONE,1.1 DclIONxdb.dof,NONE,1.1 DclIONxdb.dpk,NONE,1.1 IONxdb.cfg,NONE,1.1 IONxdb.dof,NONE,1.1 IONxdb.dpk,NONE,1.1

[Steven M. <sr...@us...>]

Update of /cvsroot/instantobjects/Source/Brokers/NexusDbSQL/D6
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32465/D6

Added Files:
	DclIONxdb.cfg DclIONxdb.dof DclIONxdb.dpk IONxdb.cfg 
	IONxdb.dof IONxdb.dpk 
Log Message:
Replaced previous NexusDb SQL brokers with updated versions of those
first provided by Bert Moorthaemer. These versions should work also with
the upcoming release of NexusDb V2. See the readme.txt file included.

--- NEW FILE: DclIONxdb.dof ---
[FileVersion]
Version=6.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=1
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;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=InstantObjects NexusDbSQL Design-Time Support (Delphi 6)
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=C:\Program Files\Borland\Delphi6\Bin\
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=2
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=3081
CodePage=1252
[Version Info Keys]
CompanyName=InstantObjects.org
FileDescription=InstantObjects NexusDbSQL Design-Time Support (Delphi 6)
FileVersion=2.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=InstantObjects
ProductVersion=2.0

--- NEW FILE: IONxdb.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:\program files\borland\delphi7\Projects\Bpl"
-LN"c:\program files\borland\delphi7\Projects\Bpl"
-DNX1
-Z

--- NEW FILE: DclIONxdb.dpk ---
package DclIONxdb;

{$R *.res}
{$R '..\InstantNexusDb.dcr'}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS ON}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'InstantObjects NexusDb Designtime Support (Delphi 6)'}
{$LIBSUFFIX '_D6'}
{$DESIGNONLY}
{$IMPLICITBUILD OFF}

requires
  vcl,
  vcldb,
  IOCore,
  IONxdb;

contains
  InstantNexusDbReg in '..\InstantNexusDbReg.pas';

end.

--- NEW FILE: IONxdb.dpk ---
package IONxdb;

{$R *.res}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS ON}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'InstantObjects NexusDb Runtime Support (Delphi 6)'}
{$LIBSUFFIX '_D6'}
{$RUNONLY}
{$IMPLICITBUILD OFF}
{$DEFINE Nx1}

requires
  rtl,
  vcl,
  vcldb,
  IOCore;

contains
  InstantNexusDbConnectionDefEdit in '..\InstantNexusDbConnectionDefEdit.pas' {InstantNexusDBConnectionDefEditForm},
  InstantNexusDb in '..\InstantNexusDb.pas',
  InstantNexusDbConsts in '..\InstantNexusDbConsts.pas',
  InstantNexusDbEmbeddedConnectionDefEdit in '..\InstantNexusDbEmbeddedConnectionDefEdit.pas' {InstantNexusDBEmbeddedConnectionDefEditForm},
  InstantNexusDbEmbedded in '..\InstantNexusDbEmbedded.pas';

end.

--- NEW FILE: IONxdb.dof ---
[FileVersion]
Version=6.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=1
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;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=InstantObjects NexusDbSQL Runtime Support (Delphi 6)
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=
Conditionals=NX1
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=2
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1040
CodePage=1252
[Version Info Keys]
CompanyName=InstantObjects.org
FileDescription=InstantObjects NexusDbSQL Run-Time Support (Delphi 6)
FileVersion=2.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=InstantObjects
ProductVersion=2.0

--- NEW FILE: DclIONxdb.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:\program files\borland\delphi7\Projects\Bpl"
-LN"c:\program files\borland\delphi7\Projects\Bpl"
-Z

[Instantobjects-cvscommit] Source/Brokers/NexusDbSQL/D5 DclIONxdb_D5.cfg,NONE,1.1 DclIONxdb_D5.dof,NONE,1.1 DclIONxdb_D5.dpk,NONE,1.1 DclIONxdb_D5.res,NONE,1.1 IONxdb_D5.cfg,NONE,1.1 IONxdb_D5.dof,NONE,1.1 IONxdb_D5.dpk,NONE,1.1 IONxdb_D5.res,NONE,1.1

[Steven M. <sr...@us...>]

Update of /cvsroot/instantobjects/Source/Brokers/NexusDbSQL/D5
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32465/D5

Added Files:
	DclIONxdb_D5.cfg DclIONxdb_D5.dof DclIONxdb_D5.dpk 
	DclIONxdb_D5.res IONxdb_D5.cfg IONxdb_D5.dof IONxdb_D5.dpk 
	IONxdb_D5.res 
Log Message:
Replaced previous NexusDb SQL brokers with updated versions of those
first provided by Bert Moorthaemer. These versions should work also with
the upcoming release of NexusDb V2. See the readme.txt file included.

--- NEW FILE: DclIONxdb_D5.dof ---
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=1
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;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=InstantObjects NexusDbSQL Designtime Support (Delphi 5)
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=Vcl50;Vclx50;VclSmp50;Qrpt50;Vcldb50;Vclbde50;ibevnt50;vcldbx50;VCLIB50;vclie50;Inetdb50;Inet50;NMFast50;dclocx50;dclaxserver50;CS30Logging50;Rz30Ctls50;Rz30DBCtls50;ip4000v5;RPRV40D5;RPRT40D5;madBasic_;madDisAsm_;NexusDB108si50;NexusDB1081x50;NexusDB108sr50;NexusDB108pv50;NexusDB108sq50;NexusDB108re50;NexusDB108ts50;NexusDB108tc50;NexusDB108tn50;NexusDB108tw50;NexusDB108db50;NexusDB108ch50
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Language]
ActiveLang=
ProjectLang=$00000C09
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=2
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=3081
CodePage=1252
[Version Info Keys]
CompanyName=InstantObjects.org
FileDescription=InstantObjects NexusDb Designtime Support (Delphi 5)
FileVersion=2.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=InstantObjects
ProductVersion=2.0
Comments=
[HistoryLists\hlConditionals]
Count=2
Item0=MM7+
Item1=MM7
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=3
Item0=C:\Program Files\ModelMakerTools\ModelMaker\8.00\Experts
Item1=..\..\..\core
Item2=..\
[HistoryLists\hlOutputDirectorry]
Count=1
Item0=C:\Program Files\ModelMakerTools\ModelMaker\8.00\Experts

--- NEW FILE: IONxdb_D5.cfg ---
-$A+
-$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:\program files\borland\delphi5\Projects\Bpl"
-LN"c:\program files\borland\delphi5\Projects\Bpl"
-DNX1
-Z

--- NEW FILE: IONxdb_D5.dpk ---
package IONxdb_D5;

{$R *.RES}
{$ALIGN ON}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS ON}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'InstantObjects NexusDb Runtime Support (Delphi 5)'}
{$RUNONLY}
{$IMPLICITBUILD OFF}
{$DEFINE NX1}

requires
  vcl50,
  vclx50,
  IOCore;

contains
  InstantNexusDbConnectionDefEdit in '..\InstantNexusDbConnectionDefEdit.pas' {InstantNexusDBConnectionDefEditForm},
  InstantNexusDb in '..\InstantNexusDb.pas',
  InstantNexusDbConsts in '..\InstantNexusDbConsts.pas',
  InstantNexusDbEmbeddedConnectionDefEdit in '..\InstantNexusDbEmbeddedConnectionDefEdit.pas' {InstantNexusDBEmbeddedConnectionDefEditForm},
  InstantNexusDbEmbedded in '..\InstantNexusDbEmbedded.pas';

end.


--- NEW FILE: IONxdb_D5.dof ---
[Compiler]
A=1
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=1
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;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=InstantObjects NexusDb Runtime Support (Delphi 5)
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=Vcl50;Vclx50;VclSmp50;Qrpt50;Vcldb50;Vclbde50;ibevnt50;vcldbx50;VCLIB50;vclie50;Inetdb50;Inet50;NMFast50;dclocx50;dclaxserver50;CS30Logging50;Rz30Ctls50;Rz30DBCtls50;ip4000v5;RPRV40D5;RPRT40D5;madBasic_;madDisAsm_;NexusDB108si50;NexusDB1081x50;NexusDB108sr50;NexusDB108pv50;NexusDB108sq50;NexusDB108re50;NexusDB108ts50;NexusDB108tc50;NexusDB108tn50;NexusDB108tw50;NexusDB108db50;NexusDB108ch50
Conditionals=NX1
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Language]
ActiveLang=
ProjectLang=$00000C09
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=2
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=3081
CodePage=1252
[Version Info Keys]
CompanyName=InstantObjects.org
FileDescription=InstantObjects NexusDbSQL Runtime Support (Delphi 5)
FileVersion=2.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=InstantObjects
ProductVersion=2.0
Comments=
[HistoryLists\hlConditionals]
Count=2
Item0=MM7+
Item1=MM7
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=3
Item0=C:\Program Files\ModelMakerTools\ModelMaker\8.00\Experts
Item1=..\..\..\core
Item2=..\
[HistoryLists\hlOutputDirectorry]
Count=1
Item0=C:\Program Files\ModelMakerTools\ModelMaker\8.00\Experts

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

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

--- NEW FILE: DclIONxdb_D5.dpk ---
package DclIONxdb_D5;

{$R *.RES}
{$R '..\InstantNexusDb.dcr'}
{$ALIGN ON}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS ON}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'InstantObjects NexusDbSQL Designtime Support (Delphi 5)'}
{$DESIGNONLY}
{$IMPLICITBUILD OFF}

requires
  vcl50,
  IOCore,
  IONxdb_D5;

contains
  InstantNexusDbReg in '..\InstantNexusDbReg.pas';

end.

--- NEW FILE: DclIONxdb_D5.cfg ---
-$A+
-$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:\program files\borland\delphi5\Projects\Bpl"
-LN"c:\program files\borland\delphi5\Projects\Bpl"
-Z

[Instantobjects-cvscommit] Source/Brokers/NexusDbSQL/D7 DclIONxdb.cfg,NONE,1.1 DclIONxdb.dof,NONE,1.1 DclIONxdb.dpk,NONE,1.1 DclIONxdb.res,NONE,1.1 IONxdb.cfg,NONE,1.1 IONxdb.dof,NONE,1.1 IONxdb.dpk,NONE,1.1 IONxdb.res,NONE,1.1

[Steven M. <sr...@us...>]

Update of /cvsroot/instantobjects/Source/Brokers/NexusDbSQL/D7
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32465/D7

Added Files:
	DclIONxdb.cfg DclIONxdb.dof DclIONxdb.dpk DclIONxdb.res 
	IONxdb.cfg IONxdb.dof IONxdb.dpk IONxdb.res 
Log Message:
Replaced previous NexusDb SQL brokers with updated versions of those
first provided by Bert Moorthaemer. These versions should work also with
the upcoming release of NexusDb V2. See the readme.txt file included.

--- NEW FILE: DclIONxdb.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=1
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=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=InstantObjects NexusDb Designtime Support (Delphi 7)
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=vcl;rtl;vclx;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;adortl;ibxpress;vclactnband;vclshlctrls;K102_R70;S402_r70;S402br70;Rz30Ctls70;Rz30DBCtls70;CS20Comps70;CSP20I70;ip4000v7;Rave50CLX;Rave50VCL;madBasic_;madDisAsm_;NexusDB107si70;NexusDB1071x70;NexusDB107sr70;NexusDB107pv70;NexusDB107sq70;NexusDB107re70;NexusDB107ts70;NexusDB107tc70;NexusDB107tn70;NexusDB107tw70;NexusDB107db70;NexusDB107ch70;DataAbstract_Core_D7;NexusDB107ll70;NexusDB107sd70;NexusDB107st70;NexusDB107pt70;IOCore;ionx70;CLXIB;VCLIB
Conditionals=Nx1
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=2
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=3081
CodePage=1252
[Version Info Keys]
CompanyName=InstantObjects.org
FileDescription=InstantObjects NexusDb Designtime Support (Delphi 7)
FileVersion=2.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=InstantObjects
ProductVersion=2.0
Comments=
[HistoryLists\hlConditionals]
Count=3
Item0=MM7+
Item1=NX1
Item2=MM7
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=4
Item0=C:\Program Files\ModelMakerTools\ModelMaker\8.05\Experts
Item1=C:\Program Files\ModelMakerTools\ModelMaker\8.00\Experts
Item2=..\..\..\core
Item3=..\
[HistoryLists\hlOutputDirectorry]
Count=2
Item0=C:\Program Files\ModelMakerTools\ModelMaker\8.05\Experts
Item1=C:\Program Files\ModelMakerTools\ModelMaker\8.00\Experts

--- NEW FILE: IONxdb.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:\program files\borland\delphi7\Projects\Bpl"
-LN"c:\program files\borland\delphi7\Projects\Bpl"
-U"..\..\..\core"
-O"..\..\..\core"
-I"..\..\..\core"
-R"..\..\..\core"
-DNX1
-Z
-w-SYMBOL_PLATFORM
-w-UNIT_PLATFORM
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

--- NEW FILE: DclIONxdb.dpk ---
package DclIONxdb;

{$R *.res}
{$R '..\InstantNexusDb.dcr'}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS ON}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'InstantObjects NexusDb Designtime Support (Delphi 7)'}
{$LIBSUFFIX '_D7'}
{$DESIGNONLY}
{$IMPLICITBUILD OFF}

requires
  vcl,
  vcldb,
  IOCore,
  IONxdb;

contains
  InstantNexusDbReg in '..\InstantNexusDbReg.pas';

end.

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

--- NEW FILE: IONxdb.dpk ---
package IONxdb;

{$R *.res}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS ON}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'InstantObjects NexusDB Runtime Support (Delphi 7)'}
{$LIBSUFFIX '_D7'}
{$RUNONLY}
{$IMPLICITBUILD OFF}
{$DEFINE NX1}

requires
  vcl,
  vclx,
  dbrtl,
  rtl,
  IOCore,
  vcldb;

contains
  InstantNexusDbConnectionDefEdit in '..\InstantNexusDbConnectionDefEdit.pas' {InstantNexusDBConnectionDefEditForm},
  InstantNexusDb in '..\InstantNexusDb.pas',
  InstantNexusDbConsts in '..\InstantNexusDbConsts.pas',
  InstantNexusDbEmbeddedConnectionDefEdit in '..\InstantNexusDbEmbeddedConnectionDefEdit.pas' {InstantNexusDBEmbeddedConnectionDefEditForm},
  InstantNexusDbEmbedded in '..\InstantNexusDbEmbedded.pas';

end.

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

--- NEW FILE: IONxdb.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=1
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=0
UnitLibrary=1
UnitPlatform=0
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=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=InstantObjects NexusDB Runtime Support (Delphi 7)
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=..\..\..\core
Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k;DJCL70;JVCL200_R70;qrpt;CS20Comps70;CSP20I70;iobde70;ioado70;iodbx70;Nexus100si70;Nexus1001x70;Nexus100sr70;Nexus100pv70;Nexus100sq70;Nexus100re70;Nexus100ts70;Nexus100tc70;Nexus100tn70;Nexus100tw70;Nexus100db70;Nexus100ch70;rbTDBC77;rbDIDE77;rbDAD77;rbUSER77;rbRCL77;rbDBDE77;rbBDE77;rbDB77;rbADO77;rbDBE77;rbIBE77;rbIDE77;rbCIDE77;rbRIDE77;rbRAP77;Rz252D70;Rz252N70;Nexus100ll70;Nexus100sd70;Nexus100st70;Nexus100pt70;ionx70
Conditionals=NX1
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=C:\D7\Borland\Delphi7\Bin\
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=2
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=InstantObjects.org
FileDescription=InstantObjects NexusDB Runtime Support (Delphi 7)
FileVersion=2.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=InstantObjects
ProductVersion=2.0
[Excluded Packages]
c:\program files\borland\delphi7\Bin\dclclxdb70.bpl=Borland CLX Database Components
C:\Program Files\Borland\Delphi7\Bin\dclclxstd70.bpl=Borland CLX Standard Components
D:\L\RO_SDK\Dcu\D7\RemObjects_DataSnap_D7.bpl=RemObjects SDK - DataSnap Integration Pack
D:\L\RO_SDK\Dcu\D7\RemObjects_Core_D7.bpl=RemObjects SDK - Core Library
D:\L\RO_DA\Dcu\D7\DataAbstract_Core_D7.bpl=RemObjects Data Abstract - Core Library
D:\L\RO_DA\Dcu\D7\DataAbstract_IDE_D7.bpl=RemObjects Data Abstract - IDE Package
D:\L\RO_SDK\Dcu\D7\RemObjects_IDE_D7.bpl=RemObjects SDK - IDE Integration
C:\Program Files\Common Files\RemObjects Software\Everwood\Bin\RemObjects_Everwood_D7.bpl=RemObjects Everwood for Delphi
D:\L\RO_DA\Dcu\D7\DataAbstract_ADODriver_D7.bpl=RemObjects Data Abstract - ADOExpress/dbGo Driver
D:\L\RO_DA\Dcu\D7\DataAbstract_IBXDriver_D7.bpl=RemObjects Data Abstract - InterBase Express Driver
D:\L\RO_DA\Dcu\D7\DataAbstract_DBXDriver_D7.bpl=RemObjects Data Abstract - dbExpress Driver
D:\L\RO_DA\Dcu\D7\DataAbstract_Scripting_D7.bpl=RemObjects Data Abstract - Scripting Integration Library
D:\L\RO_PScript\Dcu\D7\PascalScript_Core_D7.bpl=RemObjects Pascal Script - Core Package
D:\L\RO_DA\Dcu\D7\DataAbstract_NexusDBDriver_D7.bpl=Data Abstract - NexusDB Driver
D:\L\RO_DA\Dcu\D7\RemObjects_NexusDB_D7.bpl=RemObjects SDK - NexusDB Library
c:\program files\borland\delphi7\Bin\dcltee70.bpl=TeeChart Components
c:\program files\borland\delphi7\Bin\dcldss70.bpl=Borland Decision Cube Components
D:\L\RO_SDK\Dcu\D7\RemObjects_WebBroker_D7.bpl=RemObjects SDK - WebBroker Library
D:\L\RO_SDK\Dcu\D7\RemObjects_Indy_D7.bpl=RemObjects SDK - Indy Library
D:\L\RO_SDK\Dcu\D7\RemObjects_RODX_D7.bpl=RemObjects SDK - RODXSock Library
D:\L\RO_SDK\Dcu\D7\RemObjects_BPDX_D7.bpl=RemObjects SDK - BPDX Library
D:\L\RO_PScript\Dcu\D7\PascalScript_RO_D7.bpl=RemObjects Pascal Script - RemObjects SDK 3.0 Integration
D:\L\Woll2Woll\ip4000vcl7\package\ip4000clientvcl7.bpl=Woll2Woll InfoPower 4000 for Midas
C:\Program Files\Borland\Delphi7\Projects\Bpl\NexusDB200dv70.bpl=NexusDB 2.00 - designtime - VCL70
[HistoryLists\hlConditionals]
Count=3
Item0=MM7+
Item1=NX1
Item2=MM7
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=4
Item0=C:\Program Files\ModelMakerTools\ModelMaker\8.05\Experts
Item1=C:\Program Files\ModelMakerTools\ModelMaker\8.00\Experts
Item2=..\..\..\core
Item3=..\
[HistoryLists\hlOutputDirectorry]
Count=2
Item0=C:\Program Files\ModelMakerTools\ModelMaker\8.05\Experts
Item1=C:\Program Files\ModelMakerTools\ModelMaker\8.00\Experts

--- NEW FILE: DclIONxdb.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:\program files\borland\delphi7\Projects\Bpl"
-LN"c:\program files\borland\delphi7\Projects\Bpl"
-DNx1
-Z
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

[Instantobjects-cvscommit] Source/Brokers/NexusDbSQL/D2005 - New directory

[Steven M. <sr...@us...>]

Update of /cvsroot/instantobjects/Source/Brokers/NexusDbSQL/D2005
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28380/D2005

Log Message:
Directory /cvsroot/instantobjects/Source/Brokers/NexusDbSQL/D2005 added to the repository

[Instantobjects-cvscommit] Source/Brokers/NexusDbSQL/D7 Dclionxsql.cfg,1.2,NONE Dclionxsql.dof,1.2,NONE Dclionxsql.dpk,1.2,NONE Dclionxsql.res,1.1,NONE ionxsql.cfg,1.1,NONE ionxsql.dof,1.1,NONE ionxsql.dpk,1.1,NONE ionxsql.res,1.1,NONE

[Steven M. <sr...@us...>]

Update of /cvsroot/instantobjects/Source/Brokers/NexusDbSQL/D7
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24271

Removed Files:
	Dclionxsql.cfg Dclionxsql.dof Dclionxsql.dpk Dclionxsql.res 
	ionxsql.cfg ionxsql.dof ionxsql.dpk ionxsql.res 
Log Message:
no message

--- ionxsql.dpk DELETED ---

--- Dclionxsql.dpk DELETED ---

--- Dclionxsql.cfg DELETED ---

--- Dclionxsql.res DELETED ---

--- ionxsql.cfg DELETED ---

--- ionxsql.res DELETED ---

--- ionxsql.dof DELETED ---

--- Dclionxsql.dof DELETED ---

[Instantobjects-cvscommit] Source/Brokers/NexusDbSQL/D6 Dclionxsql.cfg,1.1,NONE Dclionxsql.dof,1.1,NONE Dclionxsql.dpk,1.1,NONE ionxsql.cfg,1.1,NONE ionxsql.dof,1.1,NONE ionxsql.dpk,1.1,NONE

[Steven M. <sr...@us...>]

Update of /cvsroot/instantobjects/Source/Brokers/NexusDbSQL/D6
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24001

Removed Files:
	Dclionxsql.cfg Dclionxsql.dof Dclionxsql.dpk ionxsql.cfg 
	ionxsql.dof ionxsql.dpk 
Log Message:
no message

--- Dclionxsql.dpk DELETED ---

--- Dclionxsql.cfg DELETED ---

--- ionxsql.cfg DELETED ---

--- ionxsql.dpk DELETED ---

--- ionxsql.dof DELETED ---

--- Dclionxsql.dof DELETED ---

[Instantobjects-cvscommit] Source/Brokers/NexusDbSQL/D5 Dclionxsql_D5.cfg,1.2,NONE Dclionxsql_D5.dof,1.2,NONE Dclionxsql_D5.dpk,1.2,NONE Dclionxsql_D5.res,1.1,NONE ionxsql_D5.cfg,1.2,NONE ionxsql_D5.dof,1.2,NONE ionxsql_D5.dpk,1.2,NONE ionxsql_D5.res,1.1,NONE

[Steven M. <sr...@us...>]

Update of /cvsroot/instantobjects/Source/Brokers/NexusDbSQL/D5
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23483

Removed Files:
	Dclionxsql_D5.cfg Dclionxsql_D5.dof Dclionxsql_D5.dpk 
	Dclionxsql_D5.res ionxsql_D5.cfg ionxsql_D5.dof ionxsql_D5.dpk 
	ionxsql_D5.res 
Log Message:
no message

--- Dclionxsql_D5.dpk DELETED ---

--- ionxsql_D5.res DELETED ---

--- ionxsql_D5.dpk DELETED ---

--- Dclionxsql_D5.dof DELETED ---

--- ionxsql_D5.cfg DELETED ---

--- Dclionxsql_D5.cfg DELETED ---

--- Dclionxsql_D5.res DELETED ---

--- ionxsql_D5.dof DELETED ---

[Instantobjects-cvscommit] Source/Brokers/NexusDbSQL InstantNexusDbSQL.dcr,1.1,NONE InstantNexusDbSQL.pas,1.4,NONE InstantNexusDbSQLConnectionDefEdit.dfm,1.2,NONE InstantNexusDbSQLConnectionDefEdit.pas,1.2,NONE InstantNexusDbSQLReg.pas,1.1,NONE

[Steven M. <sr...@us...>]

Update of /cvsroot/instantobjects/Source/Brokers/NexusDbSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23208

Removed Files:
	InstantNexusDbSQL.dcr InstantNexusDbSQL.pas 
	InstantNexusDbSQLConnectionDefEdit.dfm 
	InstantNexusDbSQLConnectionDefEdit.pas 
	InstantNexusDbSQLReg.pas 
Log Message:
no message

--- InstantNexusDbSQL.pas DELETED ---

--- InstantNexusDbSQLConnectionDefEdit.dfm DELETED ---

--- InstantNexusDbSQL.dcr DELETED ---

--- InstantNexusDbSQLReg.pas DELETED ---

--- InstantNexusDbSQLConnectionDefEdit.pas DELETED ---

[Instantobjects-cvscommit] Demos/IntroIW/Database IWDemoData.mdb,NONE,1.1

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

Update of /cvsroot/instantobjects/Demos/IntroIW/Database
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9807/Demos/IntroIW/Database

Added Files:
	IWDemoData.mdb 
Log Message:
Intro demo for IntraWeb by Bernard Simmons

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

[Instantobjects-cvscommit] Demos/IntroIW/Database - New directory

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

Update of /cvsroot/instantobjects/Demos/IntroIW/Database
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7692/Database

Log Message:
Directory /cvsroot/instantobjects/Demos/IntroIW/Database added to the repository

[Instantobjects-cvscommit] Demos/IntroIW - New directory

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

Update of /cvsroot/instantobjects/Demos/IntroIW
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7480/IntroIW

Log Message:
Directory /cvsroot/instantobjects/Demos/IntroIW added to the repository

[Instantobjects-cvscommit] Source/Core InstantPresentation.pas,1.14,1.15

[Nando D. <na...@us...>]

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

Modified Files:
	InstantPresentation.pas 
Log Message:
Fixed bug #1179102 (buffer trashing with calculated fields) - retouch

Index: InstantPresentation.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Core/InstantPresentation.pas,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** InstantPresentation.pas	8 Apr 2005 09:58:09 -0000	1.14
--- InstantPresentation.pas	11 Apr 2005 08:29:55 -0000	1.15
***************
*** 306,309 ****
--- 306,310 ----
      function GetCanModify: Boolean; override;
      function GetCurrentObject: TObject; virtual;
+     function GetFieldOffset(const Field: TField): Integer;
      function GetRecNo: Integer; override;
      function GetRecord(Buffer: PChar; GetMode: TGetMode;
***************
*** 378,382 ****
      property ObjectClassName: string read GetObjectClassName write SetObjectClassName stored HasObjectClassName;
      property Subject: TObject read GetSubject;
-     function GetFieldOffset(const Field: TField): Integer;
    public
      constructor Create(AOwner: TComponent); override;
--- 379,382 ----
***************
*** 2880,2891 ****
  
  procedure TInstantCustomExposer.LoadField(Obj: TObject; Field: TField);
- var
-   I, Offset: Integer;
  begin
-   Offset := 0;
-   for I := 0 to Pred(Field.Index) do
-     Inc(Offset, Fields[I].DataSize);
    LoadFieldParams(Obj, Field);
!   LoadFieldValue(Field, @CurrentBuffer[Offset], Obj);
    DataEvent(deFieldChange, Longint(Field));
  end;
--- 2880,2886 ----
  
  procedure TInstantCustomExposer.LoadField(Obj: TObject; Field: TField);
  begin
    LoadFieldParams(Obj, Field);
!   LoadFieldValue(Field, @CurrentBuffer[GetFieldOffset(Field)], Obj);
    DataEvent(deFieldChange, Longint(Field));
  end;

[Instantobjects-cvscommit] Source/Core InstantPersistence.pas,1.35,1.36

[Nando D. <na...@us...>]

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

Modified Files:
	InstantPersistence.pas 
Log Message:
rolled back changes in rev.1.32 that break the UIB broker and probably others even in PrimerExternal - waiting for a proper fix to the external derived objects problem

Index: InstantPersistence.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Core/InstantPersistence.pas,v
retrieving revision 1.35
retrieving revision 1.36
diff -C2 -d -r1.35 -r1.36
*** InstantPersistence.pas	7 Apr 2005 08:11:35 -0000	1.35
--- InstantPersistence.pas	8 Apr 2005 10:16:08 -0000	1.36
***************
*** 12713,12717 ****
    WhereStr: string;
  begin
!   WhereStr := BuildWhereStr([InstantParentIdFieldName]);
    Result := Format('DELETE FROM %s WHERE %s',
      [EmbraceTable('%s'), WhereStr]);
--- 12713,12718 ----
    WhereStr: string;
  begin
!   WhereStr := BuildWhereStr([InstantParentClassFieldName,
!     InstantParentIdFieldName]);
    Result := Format('DELETE FROM %s WHERE %s',
      [EmbraceTable('%s'), WhereStr]);
***************
*** 12723,12727 ****
    WhereStr: string;
  begin
!   WhereStr := BuildWhereStr([InstantIdFieldName]);
    Result := Format('DELETE FROM %s WHERE %s',
      [EmbraceTable(Map.Name), WhereStr]);
--- 12724,12728 ----
    WhereStr: string;
  begin
!   WhereStr := BuildWhereStr([InstantClassFieldName, InstantIdFieldName]);
    Result := Format('DELETE FROM %s WHERE %s',
      [EmbraceTable(Map.Name), WhereStr]);
***************
*** 12781,12786 ****
  begin
    FieldStr := Format('%s, %s', [EmbraceField('%s'), EmbraceField('%s')]);
!   WhereStr := Format('%s = :%s',
!     [EmbraceField(InstantIdFieldName), InstantIdFieldName]);
    Result := Format('SELECT %s FROM %s WHERE %s',
      [FieldStr, EmbraceTable('%s'), WhereStr]);
--- 12782,12788 ----
  begin
    FieldStr := Format('%s, %s', [EmbraceField('%s'), EmbraceField('%s')]);
!   WhereStr := Format('%s = :%s AND %s = :%s',
!     [EmbraceField(InstantClassFieldName), InstantClassFieldName,
!      EmbraceField(InstantIdFieldName), InstantIdFieldName]);
    Result := Format('SELECT %s FROM %s WHERE %s',
      [FieldStr, EmbraceTable('%s'), WhereStr]);
***************
*** 12794,12800 ****
    FieldStr := Format('%s, %s, %s', [EmbraceField(InstantChildClassFieldName),
      EmbraceField(InstantChildIdFieldName), EmbraceField(InstantSequenceNoFieldName)]);
!   WhereStr := Format('%s = :%s AND %s = :%s',
      [EmbraceField(InstantParentClassFieldName), InstantParentClassFieldName,
!      EmbraceField(InstantParentIdFieldName), InstantParentIdFieldName]); 
    Result := Format('SELECT %s FROM %s WHERE %s ORDER BY %s',
      [FieldStr, EmbraceTable('%s'), WhereStr, EmbraceField(InstantSequenceNoFieldName)]);
--- 12796,12803 ----
    FieldStr := Format('%s, %s, %s', [EmbraceField(InstantChildClassFieldName),
      EmbraceField(InstantChildIdFieldName), EmbraceField(InstantSequenceNoFieldName)]);
!   WhereStr := Format('%s = :%s AND %s = :%s AND %s = :%s',
      [EmbraceField(InstantParentClassFieldName), InstantParentClassFieldName,
!     EmbraceField(InstantParentIdFieldName), InstantParentIdFieldName,
!     EmbraceField(InstantChildClassFieldName), InstantChildClassFieldName]);
    Result := Format('SELECT %s FROM %s WHERE %s ORDER BY %s',
      [FieldStr, EmbraceTable('%s'), WhereStr, EmbraceField(InstantSequenceNoFieldName)]);
***************
*** 12807,12811 ****
  begin
    FieldStr := BuildFieldList(Map, [InstantUpdateCountFieldName]);
!   WhereStr := BuildWhereStr([InstantIdFieldName]);
    Result := Format('SELECT %s FROM %s WHERE %s',
      [FieldStr, EmbraceTable(Map.Name), WhereStr]);
--- 12810,12814 ----
  begin
    FieldStr := BuildFieldList(Map, [InstantUpdateCountFieldName]);
!   WhereStr := BuildWhereStr([InstantClassFieldName, InstantIdFieldName]);
    Result := Format('SELECT %s FROM %s WHERE %s',
      [FieldStr, EmbraceTable(Map.Name), WhereStr]);
***************
*** 12825,12829 ****
    AssignmentStr := BuildAssignmentList(Map,
      [InstantIdFieldName, InstantUpdateCountFieldName]);
!   WhereStr := ' (1=1) ' + BuildPersistentIdCriteria;
    Result := Format('UPDATE %s SET %s WHERE %s',
      [EmbraceTable(Map.Name), AssignmentStr, WhereStr]);
--- 12828,12833 ----
    AssignmentStr := BuildAssignmentList(Map,
      [InstantIdFieldName, InstantUpdateCountFieldName]);
!   WhereStr := BuildWhereStr([InstantClassFieldName]) +
!     BuildPersistentIdCriteria;
    Result := Format('UPDATE %s SET %s WHERE %s',
      [EmbraceTable(Map.Name), AssignmentStr, WhereStr]);

[Instantobjects-cvscommit] Source/Core InstantPresentation.pas,1.13,1.14

[Nando D. <na...@us...>]

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

Modified Files:
	InstantPresentation.pas 
Log Message:
Fixed bug #1179102 (buffer trashing with calculated fields)

Index: InstantPresentation.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Core/InstantPresentation.pas,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** InstantPresentation.pas	7 Apr 2005 11:33:15 -0000	1.13
--- InstantPresentation.pas	8 Apr 2005 09:58:09 -0000	1.14
***************
*** 378,381 ****
--- 378,382 ----
      property ObjectClassName: string read GetObjectClassName write SetObjectClassName stored HasObjectClassName;
      property Subject: TObject read GetSubject;
+     function GetFieldOffset(const Field: TField): Integer;
    public
      constructor Create(AOwner: TComponent); override;
***************
*** 1858,1863 ****
    for I := 0 to Pred(FieldCount) do
    begin
!     SaveFieldValue(Fields[I], @Buffer[Offset], AObject);
!     Inc(Offset, Fields[I].DataSize);
    end;
  end;
--- 1859,1867 ----
    for I := 0 to Pred(FieldCount) do
    begin
!     if not IsCalcField(Fields[I]) then
!     begin
!       SaveFieldValue(Fields[I], @Buffer[Offset], AObject);
!       Inc(Offset, Fields[I].DataSize);
!     end;
    end;
  end;
***************
*** 1878,1884 ****
    for I := 0 to Pred(FieldCount) do
    begin
!     LoadFieldParams(AObject, Fields[I]);
!     LoadFieldValue(Fields[I], @Buffer[Offset], AObject);
!     Inc(Offset, Fields[I].DataSize);
    end;
    GetBookmarkData(Buffer, @BM);
--- 1882,1891 ----
    for I := 0 to Pred(FieldCount) do
    begin
!     if not IsCalcField(Fields[I]) then
!     begin
!       LoadFieldParams(AObject, Fields[I]);
!       LoadFieldValue(Fields[I], @Buffer[Offset], AObject);
!       Inc(Offset, Fields[I].DataSize);
!     end;
    end;
    GetBookmarkData(Buffer, @BM);
***************
*** 1966,1970 ****
    Result := 0;
    for I := 0 to Pred(FieldCount) do
!     if not Fields[I].Calculated then
        Inc(Result, Fields[I].DataSize);
  end;
--- 1973,1977 ----
    Result := 0;
    for I := 0 to Pred(FieldCount) do
!     if not IsCalcField(Fields[I]) then
        Inc(Result, Fields[I].DataSize);
  end;
***************
*** 2175,2189 ****
    Buffer: Pointer): Boolean;
  var
-   I, Ofs: Integer;
    D: TDateTimeRec;
  begin
-   Ofs := 0;
-   for I := 0 to Pred(Field.Index) do
-     Inc(Ofs, Fields[I].DataSize);
    if Assigned(Buffer) then
!     Move(CurrentBuffer[Ofs], Buffer^, Field.DataSize);
    if (Field is TDateTimeField) and Assigned(Buffer) then
    begin
-     { Show null dates as blanks }
      D := TDateTimeRec(Buffer^);
      Result := (D.Date <> 0) and (D.Time <> 0);
--- 2182,2192 ----
    Buffer: Pointer): Boolean;
  var
    D: TDateTimeRec;
  begin
    if Assigned(Buffer) then
!     Move(CurrentBuffer[GetFieldOffset(Field)], Buffer^, Field.DataSize);
!   // Show null dates as blanks
    if (Field is TDateTimeField) and Assigned(Buffer) then
    begin
      D := TDateTimeRec(Buffer^);
      Result := (D.Date <> 0) and (D.Time <> 0);
***************
*** 2192,2195 ****
--- 2195,2213 ----
  end;
  
+ function TInstantCustomExposer.GetFieldOffset(const Field: TField): Integer;
+ var
+   I: Integer;
+ begin
+   if Field.FieldNo < 0 then
+     Result := RecordSize + Field.Offset
+   else
+   begin
+     Result := 0;
+     for I := 0 to Pred(Field.Index) do
+       if not IsCalcField(Fields[I]) then
+         Inc(Result, Fields[I].DataSize);
+   end;
+ end;
+ 
  function TInstantCustomExposer.GetFieldStrings(Field: TField;
    Strings: TStrings): Integer;
***************
*** 2487,2491 ****
    else if Field.DataType = ftBCD then
    begin
!     (Field as TBCDField).currency := True;
    end;
    if Assigned(FOnInitField) then
--- 2505,2509 ----
    else if Field.DataType = ftBCD then
    begin
!     (Field as TBCDField).Currency := True;
    end;
    if Assigned(FOnInitField) then
***************
*** 3239,3249 ****
  
  procedure TInstantCustomExposer.SaveField(Field: TField);
- var
-   I, Offset: Integer;
  begin
!   Offset := 0;
!   for I := 0 to Pred(Field.Index) do
!     Inc(Offset, Fields[I].DataSize);
!   SaveFieldValue(Field, @CurrentBuffer[Offset], CurrentObject);
  end;
  
--- 3257,3262 ----
  
  procedure TInstantCustomExposer.SaveField(Field: TField);
  begin
!   SaveFieldValue(Field, @CurrentBuffer[GetFieldOffset(Field)], CurrentObject);
  end;
  
***************
*** 3361,3376 ****
  end;
  
! procedure TInstantCustomExposer.SetFieldData(Field: TField;
!   Buffer: Pointer);
! var
!   I, Ofs: Integer;
  begin
-   Ofs := 0;
-   for I := 0 to Pred(Field.Index) do
-     Inc(Ofs, Fields[I].DataSize);
    if Assigned(Buffer) then
!     Move(Buffer^, CurrentBuffer[Ofs], Field.DataSize)
    else
!     FillChar(CurrentBuffer[Ofs], Field.DataSize, 0);
    if not (State in [dsCalcFields, dsInternalCalc, dsFilter, dsNewValue]) then
    begin
--- 3374,3383 ----
  end;
  
! procedure TInstantCustomExposer.SetFieldData(Field: TField; Buffer: Pointer);
  begin
    if Assigned(Buffer) then
!     Move(Buffer^, CurrentBuffer[GetFieldOffset(Field)], Field.DataSize)
    else
!     FillChar(CurrentBuffer[GetFieldOffset(Field)], Field.DataSize, 0);
    if not (State in [dsCalcFields, dsInternalCalc, dsFilter, dsNewValue]) then
    begin

[Instantobjects-cvscommit] Source/Core InstantPresentation.pas,1.12,1.13

[Nando D. <na...@us...>]

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

Modified Files:
	InstantPresentation.pas 
Log Message:
Added method to refresh the exposer's view on the objects without refreshing the objects themselves)

Index: InstantPresentation.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Core/InstantPresentation.pas,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** InstantPresentation.pas	4 Apr 2005 07:01:13 -0000	1.12
--- InstantPresentation.pas	7 Apr 2005 11:33:15 -0000	1.13
***************
*** 406,409 ****
--- 406,410 ----
      procedure RefreshCurrentObject;
      procedure RefreshData;
+     procedure RefreshDataView;
      procedure Remember;
      procedure ReleaseObject(AObject: TObject);
***************
*** 3160,3163 ****
--- 3161,3169 ----
  end;
  
+ procedure TInstantCustomExposer.RefreshDataView;
+ begin
+   Accessor.RefreshView;
+ end;
+ 
  function TInstantCustomExposer.RefreshObjectBuffer(AObject: TObject): Boolean;
  var