[Instantobjects-cvscommit] SF.net SVN: instantobjects:[983] trunk/Tests

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

Revision: 983
          http://sourceforge.net/p/instantobjects/code/983
Author:   carlobar
Date:     2018-08-31 06:59:50 +0000 (Fri, 31 Aug 2018)
Log Message:
-----------
Added failure test for date 1974-09-30

Modified Paths:
--------------
    trunk/Tests/TestInstantExposer.pas
    trunk/Tests/ubmock/src/fpcunit.pas

Modified: trunk/Tests/TestInstantExposer.pas
===================================================================
--- trunk/Tests/TestInstantExposer.pas	2017-04-04 15:28:27 UTC (rev 982)
+++ trunk/Tests/TestInstantExposer.pas	2018-08-31 06:59:50 UTC (rev 983)
@@ -33,11 +33,12 @@
 interface
 
 uses
-  fpcunit, testregistry, InstantXML, InstantPresentation;
+  fpcunit, testregistry, InstantXML, InstantPresentation, DB;
 
 type
   TTestExposer = class(TTestCase)
   private
+    procedure AssignNameField(const Exp: TDataSet);
   protected
     FConn: TInstantXMLConnector;
     FAcc: TXMLFilesAccessor;
@@ -46,6 +47,7 @@
     procedure TearDown; override;
   published
     procedure TestStoreAndRetrieveContact;
+    procedure TestStoreAndRetrievePerson;
     procedure TestStoreAndRetrievePicture;
     procedure TestStoreAndRetrieveContactPhones;
 //    procedure TestOrderBy;
@@ -55,8 +57,19 @@
 implementation
 
 uses
-  SysUtils, Classes, ShellAPI, InstantPersistence, TestModel, DB, Graphics;
+  SysUtils, Classes, ShellAPI, InstantPersistence, TestModel, Graphics;
 
+const
+  DEF_NAME = 'AName';
+  DEF_NAME_UNICODE = '网站导航';
+  DEF_CITY = 'Milan (€)';
+  ADDRESS_STREET = 'Street';
+  ADDRESS_STREET_UNICODE = '链接';
+  DEF_HOME = 'Home';
+  DEF_OFFICE = 'Office';
+  DEF_NUM_HOME  = '012 12345678';
+  DEF_NUM_OFFICE = '012-234-56781';
+
 { TTestXMLBroker }
 
 procedure TTestExposer.SetUp;
@@ -107,17 +120,9 @@
 end;
 
 procedure TTestExposer.TestStoreAndRetrieveContact;
-const
-  DEF_NAME = 'AName';
-  DEF_NAME_UNICODE = '网站导航';
-  DEF_CITY = 'Milan (€)';
-  ADDRESS_STREET = 'Street';
-  ADDRESS_STREET_UNICODE = '链接';
 var
   c: TContact;
   old_id: string;
-  t: TPhone;
-  DataSetField: TDataSetField;
   Field: TField;
 begin
   FExp.ObjectClass := TContact;
@@ -125,20 +130,13 @@
   try
     FExp.Subject := c;
     FExp.Edit;
-    Field := FExp.FieldByName('Name');
-    if not FConn.UseUnicode then
-    begin
-      Field.Value := DEF_NAME;
-      AssertEquals(DEF_NAME, c.Name);
-    end
-    else
-    begin
-      Field.Value := DEF_NAME_UNICODE;
-      AssertEquals(DEF_NAME_UNICODE, c.Name);
-    end;
+    //Test Name (Unicode)
+    AssignNameField(FExp);
+    //Test Address.City (Unicode)
     Field := FExp.FieldByName('Address.City');
     Field.Value := DEF_CITY;
     AssertEquals(DEF_CITY, c.Address.City);
+    //Test Address.Street (Unicode)
     Field := FExp.FieldByName('Address.Street');
     if not FConn.UseUnicode then
     begin
@@ -150,6 +148,7 @@
       Field.Value := ADDRESS_STREET_UNICODE;
       AssertEquals(ADDRESS_STREET_UNICODE, c.Address.Street);
     end;
+
     FExp.Post;
     if not FConn.UseUnicode then
     begin
@@ -190,12 +189,25 @@
   end;
 end;
 
+procedure TTestExposer.AssignNameField(const Exp: TDataSet);
+var
+  Field: TField;
+begin
+  Field := FExp.FieldByName('Name');
+  if not FConn.UseUnicode then
+  begin
+    Field.Value := DEF_NAME;
+    AssertEquals(DEF_NAME, Field.Value);
+  end
+  else
+  begin
+    Field.Value := DEF_NAME_UNICODE;
+    AssertEquals(DEF_NAME_UNICODE, Field.Value);
+  end;
+end;
+
 procedure TTestExposer.FieldSetValue;
-const
-  DEF_NAME = 'AName';
-  DEF_NAME_UNICODE = '链接';
 var
-  Field: TField;
   c: TContact;
 begin
   FExp.ObjectClass := TContact;
@@ -203,17 +215,8 @@
   try
     FExp.Subject := c;
     FExp.Edit;
-    Field := FExp.FieldByName('Name');
-    if not FConn.UseUnicode then
-    begin
-      Field.Value := DEF_NAME;
-      AssertEquals(DEF_NAME, Field.Value);
-    end
-    else
-    begin
-      Field.Value := DEF_NAME_UNICODE;
-      AssertEquals(DEF_NAME_UNICODE, Field.Value);
-    end;
+    //Test Name (Unicode)
+    AssignNameField(FExp);
   finally
     FreeAndNil(c);
   end;
@@ -220,19 +223,10 @@
 end;
 
 procedure TTestExposer.TestStoreAndRetrieveContactPhones;
-const
-  DEF_NAME = 'AName';
-  DEF_NAME_UNICODE = '链接';
-  DEF_HOME = 'Home';
-  DEF_OFFICE = 'Office';
-  DEF_NUM_HOME  = '012 12345678';
-  DEF_NUM_OFFICE = '012-234-56781';
 var
   c: TContact;
   old_id: string;
-  t: TPhone;
   DataSetField: TDataSetField;
-  Field: TField;
 begin
   FExp.ObjectClass := TContact;
   c := TContact.Create;
@@ -239,18 +233,8 @@
   try
     FExp.Subject := c;
     FExp.Edit;
-    Field := FExp.FieldByName('Name');
-    if not FConn.UseUnicode then
-    begin
-      Field.Value := DEF_NAME;
-      AssertEquals(DEF_NAME, c.Name);
-    end
-    else
-    begin
-      Field.Value := DEF_NAME_UNICODE;
-      AssertEquals(DEF_NAME_UNICODE, c.Name);
-    end;
-    Field := FExp.FieldByName('Address.City');
+    //Test Name (Unicode)
+    AssignNameField(FExp);
     DataSetField := FExp.FieldByName('Phones') as TDataSetField;
     DataSetField.NestedDataSet.Append;
     DataSetField.NestedDataSet.FieldByName('Name').Value := DEF_HOME;
@@ -292,14 +276,52 @@
   end;
 end;
 
+procedure TTestExposer.TestStoreAndRetrievePerson;
+var
+  p: TPerson;
+  old_id: string;
+  Field: TField;
+  LBirthDate: TDateTime;
+begin
+  FExp.ObjectClass := TPerson;
+  p := TPerson.Create;
+  try
+    FExp.Subject := p;
+    FExp.Edit;
+    //Test Name (Unicode)
+    AssignNameField(FExp);
+    LBirthDate := EncodeDate(1974, 09, 30);
+    //Test BirthDate from 01/01/1900 to Today
+    //LBirthDate := EncodeDate(1900, 01, 01);
+    //while True do
+    begin
+      Field := FExp.FieldByName('BirthDate');
+      Field.Value := LBirthDate;
+      AssertEqualsDateTime(LBirthDate, p.BirthDate);
+      LBirthDate := LBirthDate + 1;
+      //if LBirthDate >= Date then
+        //Break;
+    end;
+    FExp.Post;
+    old_id := p.id;
+  finally
+    FreeAndNil(p);
+  end;
+  AssertNull(p);
+  p := TPerson.Retrieve(old_id);
+  try
+    AssertNotNull('Object not retrieved', p);
+    AssertEquals(old_id, p.Id);
+    AssertEquals(LBirthDate, p.BirthDate);
+  finally
+    FreeAndNil(p);
+  end;
+end;
+
 procedure TTestExposer.TestStoreAndRetrievePicture;
-const
-  DEF_NAME = 'AName';
-  DEF_NAME_UNICODE = '链接';
 var
   c: TPerson;
   Field: TField;
-  old_id: string;
   BlobContentBefore, BlobContentAfter: string;
 begin
   FExp.ObjectClass := TPerson;

Modified: trunk/Tests/ubmock/src/fpcunit.pas
===================================================================
--- trunk/Tests/ubmock/src/fpcunit.pas	2017-04-04 15:28:27 UTC (rev 982)
+++ trunk/Tests/ubmock/src/fpcunit.pas	2018-08-31 06:59:50 UTC (rev 983)
@@ -73,6 +73,7 @@
     class procedure AssertEquals(Expected, Actual: int64); overload;
     class procedure AssertEquals(const AMessage: string; Expected, Actual: currency); overload;
     class procedure AssertEquals(Expected, Actual: currency); overload;
+    class procedure AssertEqualsDateTime(Expected, Actual: TDateTime); overload;
     class procedure AssertEquals(const AMessage: string; Expected, Actual, Delta: double); overload;
     class procedure AssertEquals(Expected, Actual, Delta: double); overload;
     class procedure AssertEquals(const AMessage: string; Expected, Actual: boolean); overload;
@@ -425,6 +426,12 @@
    AssertEquals('', Expected, Actual);
 end;
 
+class procedure TAssert.AssertEqualsDateTime(Expected, Actual: TDateTime);
+begin
+  if Expected <> Actual then
+     AssertEquals('', DateToStr(Expected), DateToStr(Actual));
+end;
+
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual, Delta: double);
 begin
   AssertTrue(AMessage + ComparisonMsg(FloatToStr(Expected),FloatToStr(Actual)),