tdbf-cvs — Mailing list CVS commit messages

[tdbf-cvs] SF.net SVN: tdbf:[808] trunk/src/dbf_pgfile.pas

[<pau...@us...>]

Revision: 808
          http://sourceforge.net/p/tdbf/code/808
Author:   paulenandrew
Date:     2022-05-24 12:28:07 +0000 (Tue, 24 May 2022)
Log Message:
-----------
Fix lock offset

Casting the hex constant to Cardinal, which is an unsigned 32-bit
integer, truncates the value. Instead, use the decimal equivalent.

This fixes a side effect of revision 777.

Revision Links:
--------------
    http://sourceforge.net/p/tdbf/code/777

Modified Paths:
--------------
    trunk/src/dbf_pgfile.pas

Modified: trunk/src/dbf_pgfile.pas
===================================================================
--- trunk/src/dbf_pgfile.pas	2022-04-28 18:16:19 UTC (rev 807)
+++ trunk/src/dbf_pgfile.pas	2022-05-24 12:28:07 UTC (rev 808)
@@ -410,7 +410,7 @@
   // Use a lock offset that does not conflict with the physical file
   {$ifdef SUPPORT_INT64}
   if not FCompatibleLockOffset then
-    Result := Cardinal($FFFFFFFFFFFFFFFD);
+    Result := -3; // $FFFFFFFFFFFFFFFD
   {$endif}
 
   // Calculate lock offset for page

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[807] trunk

[<pau...@us...>]

Revision: 807
          http://sourceforge.net/p/tdbf/code/807
Author:   paulenandrew
Date:     2022-04-28 18:16:19 +0000 (Thu, 28 Apr 2022)
Log Message:
-----------
Fix setting sequential record number to BOF/EOF

The sequential record number of an index cursor has special values for
BOF and EOF. When setting the sequential record number, account for
those values.

Modified Paths:
--------------
    trunk/doc/history.txt
    trunk/src/dbf_idxfile.pas

Modified: trunk/doc/history.txt
===================================================================
--- trunk/doc/history.txt	2022-04-28 18:15:40 UTC (rev 806)
+++ trunk/doc/history.txt	2022-04-28 18:16:19 UTC (rev 807)
@@ -79,6 +79,7 @@
 - add support for Delphi 11.
 - fix empty memo fields when using AppendRecord() or InsertRecord().
 - fix index locking when inserting a record if there is more than one index.
+- fix setting sequential record number of index cursor to BOF or EOF.
 
 ------------------------
 V7.0.1

Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas	2022-04-28 18:15:40 UTC (rev 806)
+++ trunk/src/dbf_idxfile.pas	2022-04-28 18:16:19 UTC (rev 807)
@@ -4186,37 +4186,44 @@
   TempPage: TIndexPage;
   gotoEntry: Integer;
 begin
-  // use our weighting system to quickly go to a seq recno
-  // recno starts at 1, entries at zero
-  Dec(RecNo);
-  TempPage := FRoot;
-  repeat
-    // don't div by zero
-    assert(TempPage.Weight > 0);
-    gotoEntry := RecNo div TempPage.Weight;
-    RecNo := RecNo mod TempPage.Weight;
-    // do we have this much entries?
-    if (TempPage.HighIndex < gotoEntry) then
-    begin
-      // goto next entry in upper page if not
-      // if recurnext fails, we have come at the end of the index
-      if (TempPage.UpperPage <> nil) and TempPage.UpperPage.RecurNext then
+  if RecNo = RecBOF then
+    WalkFirst
+  else if RecNo = RecEOF then
+    WalkLast
+  else
+  begin
+    // use our weighting system to quickly go to a seq recno
+    // recno starts at 1, entries at zero
+    Dec(RecNo);
+    TempPage := FRoot;
+    repeat
+      // don't div by zero
+      assert(TempPage.Weight > 0);
+      gotoEntry := RecNo div TempPage.Weight;
+      RecNo := RecNo mod TempPage.Weight;
+      // do we have this much entries?
+      if (TempPage.HighIndex < gotoEntry) then
       begin
-        // lower recno to get because we skipped an entry
-        TempPage.EntryNo := TempPage.LowIndex;
-        RecNo := 0;
+        // goto next entry in upper page if not
+        // if recurnext fails, we have come at the end of the index
+        if (TempPage.UpperPage <> nil) and TempPage.UpperPage.RecurNext then
+        begin
+          // lower recno to get because we skipped an entry
+          TempPage.EntryNo := TempPage.LowIndex;
+          RecNo := 0;
+        end else begin
+          // this can only happen if too big RecNo was entered, go to last
+          TempPage.RecurLast;
+          // terminate immediately
+          TempPage := Leaf;
+        end;
       end else begin
-        // this can only happen if too big RecNo was entered, go to last
-        TempPage.RecurLast;
-        // terminate immediately
-        TempPage := Leaf;
+        TempPage.EntryNo := gotoEntry;
       end;
-    end else begin
-      TempPage.EntryNo := gotoEntry;
-    end;
-    // get lower node
-    TempPage := TempPage.LowerPage;
-  until TempPage = nil;
+      // get lower node
+      TempPage := TempPage.LowerPage;
+    until TempPage = nil;
+  end;
 end;
 
 procedure TIndexFile.SetBracketLow;

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[806] trunk

[<pau...@us...>]

Revision: 806
          http://sourceforge.net/p/tdbf/code/806
Author:   paulenandrew
Date:     2022-04-28 18:15:40 +0000 (Thu, 28 Apr 2022)
Log Message:
-----------
Fix index locking updating all indexes

When updating all indexes, lock/unlock each index individually so that
each version field is updated to inform other users of a change.

Modified Paths:
--------------
    trunk/doc/history.txt
    trunk/src/dbf_idxfile.pas

Modified: trunk/doc/history.txt
===================================================================
--- trunk/doc/history.txt	2022-04-28 18:14:46 UTC (rev 805)
+++ trunk/doc/history.txt	2022-04-28 18:15:40 UTC (rev 806)
@@ -78,6 +78,7 @@
 - support Delete when already editing/inserting.
 - add support for Delphi 11.
 - fix empty memo fields when using AppendRecord() or InsertRecord().
+- fix index locking when inserting a record if there is more than one index.
 
 ------------------------
 V7.0.1

Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas	2022-04-28 18:14:46 UTC (rev 805)
+++ trunk/src/dbf_idxfile.pas	2022-04-28 18:15:40 UTC (rev 806)
@@ -3263,20 +3263,20 @@
 var
   I, curSel, count: Integer;
 begin
-  LockIndex;
-  try
-    // check if updating all or only current
-    FUserRecNo := RecNo;
-    if (FUpdateMode = umAll) or (FSelectedIndex = -1) then
+  // check if updating all or only current
+  FUserRecNo := RecNo;
+  if (FUpdateMode = umAll) or (FSelectedIndex = -1) then
+  begin
+    // remember currently selected index
+    curSel := FSelectedIndex;
+    Result := true;
+    I := 0;
+    count := SwapWordLE(PMdxHdr(Header)^.TagsUsed);
+    while I < count do
     begin
-      // remember currently selected index
-      curSel := FSelectedIndex;
-      Result := true;
-      I := 0;
-      count := SwapWordLE(PMdxHdr(Header)^.TagsUsed);
-      while I < count do
-      begin
-        SelectIndexVars(I);
+      SelectIndexVars(I);
+      LockIndex;
+      try
         Result := InsertKey(Buffer, RecNo);
         if not Result then
         begin
@@ -3288,18 +3288,24 @@
           end;
           break;
         end;
-        Inc(I);
+        // check range, disabled by insert
+        ResyncRange(true);
+      finally
+        UnlockIndex;
       end;
-      // restore previous selected index
-      SelectIndexVars(curSel);
-    end else begin
+      Inc(I);
+    end;
+    // restore previous selected index
+    SelectIndexVars(curSel);
+  end else begin
+    LockIndex;
+    try
       Result := InsertKey(Buffer, RecNo);
+      // check range, disabled by insert
+      ResyncRange(true);
+    finally
+      UnlockIndex;
     end;
-
-    // check range, disabled by insert
-    ResyncRange(true);
-  finally
-    UnlockIndex;
   end;
 end;
 
@@ -3590,28 +3596,35 @@
 var
   I, curSel: Integer;
 begin
-  LockIndex;
-  try
-    // check if updating all or only current
-    FUserRecNo := RecNo;
-    if (FUpdateMode = umAll) or (FSelectedIndex = -1) then
+  // check if updating all or only current
+  FUserRecNo := RecNo;
+  if (FUpdateMode = umAll) or (FSelectedIndex = -1) then
+  begin
+    // remember currently selected index
+    curSel := FSelectedIndex;
+    for I := 0 to SwapWordLE(PMdxHdr(Header)^.TagsUsed) - 1 do
     begin
-      // remember currently selected index
-      curSel := FSelectedIndex;
-      for I := 0 to SwapWordLE(PMdxHdr(Header)^.TagsUsed) - 1 do
-      begin
-        SelectIndexVars(I);
+      SelectIndexVars(I);
+      LockIndex;
+      try
         DeleteKey(Buffer, RecNo);
+        // range may be changed
+        ResyncRange(true);
+      finally
+        UnlockIndex;
       end;
-      // restore previous selected index
-      SelectIndexVars(curSel);
-    end else begin
+    end;
+    // restore previous selected index
+    SelectIndexVars(curSel);
+  end else begin
+    LockIndex;
+    try
       DeleteKey(Buffer, RecNo);
+      // range may be changed
+      ResyncRange(true);
+    finally
+      UnlockIndex;
     end;
-    // range may be changed
-    ResyncRange(true);
-  finally
-    UnlockIndex;
   end;
 end;
 

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[805] trunk/demo/TDbfViewer/DataFileContent.pas

[<pau...@us...>]

Revision: 805
          http://sourceforge.net/p/tdbf/code/805
Author:   paulenandrew
Date:     2022-04-28 18:14:46 +0000 (Thu, 28 Apr 2022)
Log Message:
-----------
Fix parsing of FoxPro Field Offset in TDbf Viewer

Modified Paths:
--------------
    trunk/demo/TDbfViewer/DataFileContent.pas

Modified: trunk/demo/TDbfViewer/DataFileContent.pas
===================================================================
--- trunk/demo/TDbfViewer/DataFileContent.pas	2022-04-28 18:14:00 UTC (rev 804)
+++ trunk/demo/TDbfViewer/DataFileContent.pas	2022-04-28 18:14:46 UTC (rev 805)
@@ -150,8 +150,10 @@
         ItemInfo.VType := varLongWord;
       end
       else
+      begin
         ItemInfo.Name := 'Data Address';
-      ItemInfo.Size := 4;
+        ItemInfo.Size := 4;
+      end;
     end;
     16:
     begin

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[804] trunk

[<pau...@us...>]

Revision: 804
          http://sourceforge.net/p/tdbf/code/804
Author:   paulenandrew
Date:     2022-04-28 18:14:00 +0000 (Thu, 28 Apr 2022)
Log Message:
-----------
Commit to memo file when adding record

AppendRecord() and InsertRecord() call InternalAddRecord() instead of
InternalPost().

Modified Paths:
--------------
    trunk/doc/history.txt
    trunk/src/dbf.pas

Modified: trunk/doc/history.txt
===================================================================
--- trunk/doc/history.txt	2022-02-12 11:25:13 UTC (rev 803)
+++ trunk/doc/history.txt	2022-04-28 18:14:00 UTC (rev 804)
@@ -77,6 +77,7 @@
 - fix key in key violation message.
 - support Delete when already editing/inserting.
 - add support for Delphi 11.
+- fix empty memo fields when using AppendRecord() or InsertRecord().
 
 ------------------------
 V7.0.1

Modified: trunk/src/dbf.pas
===================================================================
--- trunk/src/dbf.pas	2022-02-12 11:25:13 UTC (rev 803)
+++ trunk/src/dbf.pas	2022-04-28 18:14:00 UTC (rev 804)
@@ -246,6 +246,7 @@
     procedure SetRangeBuffer(LowRange: PAnsiChar; HighRange: PAnsiChar);
     procedure UpdateLock;
     function  ResyncSharedReadCurrentRecord: Boolean;
+    procedure CommitBlobStreams;
 
   protected
     { abstract methods }
@@ -1000,6 +1001,9 @@
 begin
   pRecord := pDbfRecord(Buffer);
 
+  // commit blobs
+  CommitBlobStreams;
+
   // we can not insert records in DBF files, only append
   // ignore Append parameter
   newRecord := FDbfFile.Insert(@pRecord^.DeletedFlag);
@@ -1468,7 +1472,7 @@
 procedure TDbf.InternalPost; {override virtual from TDataset}
 var
   pRecord: pDbfRecord;
-  I, newRecord: Integer;
+  newRecord: Integer;
 begin
   // inherited method checks required fields
 {$ifdef FPC}
@@ -1480,10 +1484,10 @@
 {$endif}
   // if internalpost is called, we know we are active
   pRecord := pDbfRecord(ActiveBuffer);
+
   // commit blobs
-  for I := 0 to Pred(FieldDefs.Count) do
-    if Assigned(FBlobStreams^[I]) then
-      FBlobStreams^[I].Commit;
+  CommitBlobStreams;
+
   if State = dsEdit then
   begin
     // write changes
@@ -3198,6 +3202,15 @@
     DataEvent(deRecordChange, 0);
 end;
 
+procedure TDbf.CommitBlobStreams;
+var
+  I: Integer;
+begin
+  for I := 0 to Pred(FieldDefs.Count) do
+    if Assigned(FBlobStreams^[I]) then
+      FBlobStreams^[I].Commit;
+end;
+
 {$ifdef SUPPORT_VARIANTS}
 
 procedure TDbf.SetRange(LowRange: Variant; HighRange: Variant; KeyIsANSI: boolean);

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[803] trunk/packages

[<tw...@us...>]

Revision: 803
          http://sourceforge.net/p/tdbf/code/803
Author:   twm
Date:     2022-02-12 11:25:13 +0000 (Sat, 12 Feb 2022)
Log Message:
-----------
more svn:ignores

Property Changed:
----------------
    trunk/packages/DelphiXE5/
    trunk/packages/DelphiXE6/dcu/
    trunk/packages/DelphiXE7/
    trunk/packages/DelphiXE7/dcu/

Index: trunk/packages/DelphiXE5
===================================================================
--- trunk/packages/DelphiXE5	2022-02-12 11:22:00 UTC (rev 802)
+++ trunk/packages/DelphiXE5	2022-02-12 11:25:13 UTC (rev 803)

Property changes on: trunk/packages/DelphiXE5
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+tdbfXE5_prjgroup.tvsconfig
Index: trunk/packages/DelphiXE6/dcu
===================================================================
--- trunk/packages/DelphiXE6/dcu	2022-02-12 11:22:00 UTC (rev 802)
+++ trunk/packages/DelphiXE6/dcu	2022-02-12 11:25:13 UTC (rev 803)

Property changes on: trunk/packages/DelphiXE6/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/DelphiXE7
===================================================================
--- trunk/packages/DelphiXE7	2022-02-12 11:22:00 UTC (rev 802)
+++ trunk/packages/DelphiXE7	2022-02-12 11:25:13 UTC (rev 803)

Property changes on: trunk/packages/DelphiXE7
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+tdbfXE7_prjgroup.tvsconfig
Index: trunk/packages/DelphiXE7/dcu
===================================================================
--- trunk/packages/DelphiXE7/dcu	2022-02-12 11:22:00 UTC (rev 802)
+++ trunk/packages/DelphiXE7/dcu	2022-02-12 11:25:13 UTC (rev 803)

Property changes on: trunk/packages/DelphiXE7/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[802] trunk/packages

[<tw...@us...>]

Revision: 802
          http://sourceforge.net/p/tdbf/code/802
Author:   twm
Date:     2022-02-12 11:22:00 +0000 (Sat, 12 Feb 2022)
Log Message:
-----------
more svn:ignores

Added Paths:
-----------
    trunk/packages/Delphi10/dcu/
    trunk/packages/Delphi11/dcu/

Property Changed:
----------------
    trunk/packages/Delphi10/
    trunk/packages/Delphi101/
    trunk/packages/Delphi104/
    trunk/packages/Delphi104/dcu/
    trunk/packages/Delphi11/

Index: trunk/packages/Delphi10
===================================================================
--- trunk/packages/Delphi10	2022-02-12 11:04:10 UTC (rev 801)
+++ trunk/packages/Delphi10	2022-02-12 11:22:00 UTC (rev 802)

Property changes on: trunk/packages/Delphi10
___________________________________________________________________
Added: svn:ignore
## -0,0 +1,3 ##
+dcltdbf.dproj.user
+tdbf.dproj.user
+tdbf.stat
Index: trunk/packages/Delphi10/dcu
===================================================================
--- trunk/packages/Delphi10/dcu	2022-02-12 11:04:10 UTC (rev 801)
+++ trunk/packages/Delphi10/dcu	2022-02-12 11:22:00 UTC (rev 802)

Property changes on: trunk/packages/Delphi10/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/Delphi101
===================================================================
--- trunk/packages/Delphi101	2022-02-12 11:04:10 UTC (rev 801)
+++ trunk/packages/Delphi101	2022-02-12 11:22:00 UTC (rev 802)

Property changes on: trunk/packages/Delphi101
___________________________________________________________________
Modified: svn:ignore
## -1,2 +1,3 ##
 tdbf.stat
 dcu
+tdbf101_prjgroup.tvsconfig
Index: trunk/packages/Delphi104
===================================================================
--- trunk/packages/Delphi104	2022-02-12 11:04:10 UTC (rev 801)
+++ trunk/packages/Delphi104	2022-02-12 11:22:00 UTC (rev 802)

Property changes on: trunk/packages/Delphi104
___________________________________________________________________
Modified: svn:ignore
## -1,2 +1,4 ##
 tdbf.stat
 *.tvsconfig
+dcltdbf.dproj.user
+tdbf.dproj.user
Index: trunk/packages/Delphi104/dcu
===================================================================
--- trunk/packages/Delphi104/dcu	2022-02-12 11:04:10 UTC (rev 801)
+++ trunk/packages/Delphi104/dcu	2022-02-12 11:22:00 UTC (rev 802)

Property changes on: trunk/packages/Delphi104/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/Delphi11
===================================================================
--- trunk/packages/Delphi11	2022-02-12 11:04:10 UTC (rev 801)
+++ trunk/packages/Delphi11	2022-02-12 11:22:00 UTC (rev 802)

Property changes on: trunk/packages/Delphi11
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.tvsconfig
Index: trunk/packages/Delphi11/dcu
===================================================================
--- trunk/packages/Delphi11/dcu	2022-02-12 11:04:10 UTC (rev 801)
+++ trunk/packages/Delphi11/dcu	2022-02-12 11:22:00 UTC (rev 802)

Property changes on: trunk/packages/Delphi11/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1,2 ##
+dbf.dcu
+*.dcu
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[801] trunk/packages

[<tw...@us...>]

Revision: 801
          http://sourceforge.net/p/tdbf/code/801
Author:   twm
Date:     2022-02-12 11:04:10 +0000 (Sat, 12 Feb 2022)
Log Message:
-----------
some more svn:ignores

Property Changed:
----------------
    trunk/packages/Delphi102/
    trunk/packages/DelphiXE3/

Index: trunk/packages/Delphi102
===================================================================
--- trunk/packages/Delphi102	2022-02-12 11:02:51 UTC (rev 800)
+++ trunk/packages/Delphi102	2022-02-12 11:04:10 UTC (rev 801)

Property changes on: trunk/packages/Delphi102
___________________________________________________________________
Modified: svn:ignore
## -1,2 +1,4 ##
 tdbf.stat
 *.tvsconfig
+dcltdbf.dproj.user
+tdbf.dproj.user
Index: trunk/packages/DelphiXE3
===================================================================
--- trunk/packages/DelphiXE3	2022-02-12 11:02:51 UTC (rev 800)
+++ trunk/packages/DelphiXE3	2022-02-12 11:04:10 UTC (rev 801)

Property changes on: trunk/packages/DelphiXE3
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+dcltdbf.dproj.user
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[800] trunk/packages/DelphiXE

[<tw...@us...>]

Revision: 800
          http://sourceforge.net/p/tdbf/code/800
Author:   twm
Date:     2022-02-12 11:02:51 +0000 (Sat, 12 Feb 2022)
Log Message:
-----------
fixed compile error in Delphi XE: dbf_AnsiStrings was missing from tdbf package

Modified Paths:
--------------
    trunk/packages/DelphiXE/tdbf.dpk
    trunk/packages/DelphiXE/tdbf.dproj

Modified: trunk/packages/DelphiXE/tdbf.dpk
===================================================================
--- trunk/packages/DelphiXE/tdbf.dpk	2022-02-12 10:59:22 UTC (rev 799)
+++ trunk/packages/DelphiXE/tdbf.dpk	2022-02-12 11:02:51 UTC (rev 800)
@@ -51,6 +51,7 @@
   dbf_avl in '..\..\src\dbf_avl.pas',
   dbf_pgcfile in '..\..\src\dbf_pgcfile.pas',
   dbf_wtil in '..\..\src\dbf_wtil.pas',
-  dbf in '..\..\src\dbf.pas';
+  dbf in '..\..\src\dbf.pas',
+  dbf_AnsiStrings in '..\..\src\dbf_AnsiStrings.pas';
 
 end.

Modified: trunk/packages/DelphiXE/tdbf.dproj
===================================================================
--- trunk/packages/DelphiXE/tdbf.dproj	2022-02-12 10:59:22 UTC (rev 799)
+++ trunk/packages/DelphiXE/tdbf.dproj	2022-02-12 11:02:51 UTC (rev 800)
@@ -154,6 +154,7 @@
 			<DCCReference Include="..\..\src\dbf_pgcfile.pas"/>
 			<DCCReference Include="..\..\src\dbf_wtil.pas"/>
 			<DCCReference Include="..\..\src\dbf.pas"/>
+			<DCCReference Include="..\..\src\dbf_ansistrings.pas"/>
 			<BuildConfiguration Include="Debug">
 				<Key>Cfg_2</Key>
 				<CfgParent>Base</CfgParent>

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[799] trunk/src/dbf_common.inc

[<tw...@us...>]

Revision: 799
          http://sourceforge.net/p/tdbf/code/799
Author:   twm
Date:     2022-02-12 10:59:22 +0000 (Sat, 12 Feb 2022)
Log Message:
-----------
corrected definition of InternalAddRecord_Wants_TRecordBuffer (was changed with Delphi XE3 rather than XE)

Modified Paths:
--------------
    trunk/src/dbf_common.inc

Modified: trunk/src/dbf_common.inc
===================================================================
--- trunk/src/dbf_common.inc	2022-02-12 10:58:27 UTC (rev 798)
+++ trunk/src/dbf_common.inc	2022-02-12 10:59:22 UTC (rev 799)
@@ -559,12 +559,12 @@
 {$endif}
 
 {$ifdef Delphi_XE}
-  {$define InternalAddRecord_Wants_TRecordBuffer}
   {$define SUPPORT_FORMATSETTINGS}
   {$define SUPPORT_FORMATSETTINGS_CREATE}
 {$endif}
 
 {$ifdef DELPHI_XE3}
+  {$define InternalAddRecord_Wants_TRecordBuffer}
   {$define FLOATREC_DIGITS_IS_BYTE}
   {$define SUPPORT_TVALUEBUFFER}
   {$define SUPPORT_GENERICS_FIELDLIST}

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[798] trunk/packages

[<tw...@us...>]

Revision: 798
          http://sourceforge.net/p/tdbf/code/798
Author:   twm
Date:     2022-02-12 10:58:27 +0000 (Sat, 12 Feb 2022)
Log Message:
-----------
svn:ignore *.dcu in dcu output directories

Property Changed:
----------------
    trunk/packages/Delphi102/dcu/
    trunk/packages/Delphi103/dcu/
    trunk/packages/Delphi2005/dcu/
    trunk/packages/Delphi2006/dcu/
    trunk/packages/Delphi2007/dcu/
    trunk/packages/Delphi2009/dcu/
    trunk/packages/Delphi2010/dcu/
    trunk/packages/Delphi6/dcu/
    trunk/packages/Delphi7/dcu/
    trunk/packages/DelphiXE/dcu/
    trunk/packages/DelphiXE2/dcu/
    trunk/packages/DelphiXE4/dcu/
    trunk/packages/DelphiXE5/dcu/
    trunk/packages/DelphiXE8/dcu/

Index: trunk/packages/Delphi102/dcu
===================================================================
--- trunk/packages/Delphi102/dcu	2022-02-10 14:09:00 UTC (rev 797)
+++ trunk/packages/Delphi102/dcu	2022-02-12 10:58:27 UTC (rev 798)

Property changes on: trunk/packages/Delphi102/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/Delphi103/dcu
===================================================================
--- trunk/packages/Delphi103/dcu	2022-02-10 14:09:00 UTC (rev 797)
+++ trunk/packages/Delphi103/dcu	2022-02-12 10:58:27 UTC (rev 798)

Property changes on: trunk/packages/Delphi103/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/Delphi2005/dcu
===================================================================
--- trunk/packages/Delphi2005/dcu	2022-02-10 14:09:00 UTC (rev 797)
+++ trunk/packages/Delphi2005/dcu	2022-02-12 10:58:27 UTC (rev 798)

Property changes on: trunk/packages/Delphi2005/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/Delphi2006/dcu
===================================================================
--- trunk/packages/Delphi2006/dcu	2022-02-10 14:09:00 UTC (rev 797)
+++ trunk/packages/Delphi2006/dcu	2022-02-12 10:58:27 UTC (rev 798)

Property changes on: trunk/packages/Delphi2006/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/Delphi2007/dcu
===================================================================
--- trunk/packages/Delphi2007/dcu	2022-02-10 14:09:00 UTC (rev 797)
+++ trunk/packages/Delphi2007/dcu	2022-02-12 10:58:27 UTC (rev 798)

Property changes on: trunk/packages/Delphi2007/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/Delphi2009/dcu
===================================================================
--- trunk/packages/Delphi2009/dcu	2022-02-10 14:09:00 UTC (rev 797)
+++ trunk/packages/Delphi2009/dcu	2022-02-12 10:58:27 UTC (rev 798)

Property changes on: trunk/packages/Delphi2009/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/Delphi2010/dcu
===================================================================
--- trunk/packages/Delphi2010/dcu	2022-02-10 14:09:00 UTC (rev 797)
+++ trunk/packages/Delphi2010/dcu	2022-02-12 10:58:27 UTC (rev 798)

Property changes on: trunk/packages/Delphi2010/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/Delphi6/dcu
===================================================================
--- trunk/packages/Delphi6/dcu	2022-02-10 14:09:00 UTC (rev 797)
+++ trunk/packages/Delphi6/dcu	2022-02-12 10:58:27 UTC (rev 798)

Property changes on: trunk/packages/Delphi6/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/Delphi7/dcu
===================================================================
--- trunk/packages/Delphi7/dcu	2022-02-10 14:09:00 UTC (rev 797)
+++ trunk/packages/Delphi7/dcu	2022-02-12 10:58:27 UTC (rev 798)

Property changes on: trunk/packages/Delphi7/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/DelphiXE/dcu
===================================================================
--- trunk/packages/DelphiXE/dcu	2022-02-10 14:09:00 UTC (rev 797)
+++ trunk/packages/DelphiXE/dcu	2022-02-12 10:58:27 UTC (rev 798)

Property changes on: trunk/packages/DelphiXE/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/DelphiXE2/dcu
===================================================================
--- trunk/packages/DelphiXE2/dcu	2022-02-10 14:09:00 UTC (rev 797)
+++ trunk/packages/DelphiXE2/dcu	2022-02-12 10:58:27 UTC (rev 798)

Property changes on: trunk/packages/DelphiXE2/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/DelphiXE4/dcu
===================================================================
--- trunk/packages/DelphiXE4/dcu	2022-02-10 14:09:00 UTC (rev 797)
+++ trunk/packages/DelphiXE4/dcu	2022-02-12 10:58:27 UTC (rev 798)

Property changes on: trunk/packages/DelphiXE4/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/DelphiXE5/dcu
===================================================================
--- trunk/packages/DelphiXE5/dcu	2022-02-10 14:09:00 UTC (rev 797)
+++ trunk/packages/DelphiXE5/dcu	2022-02-12 10:58:27 UTC (rev 798)

Property changes on: trunk/packages/DelphiXE5/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
Index: trunk/packages/DelphiXE8/dcu
===================================================================
--- trunk/packages/DelphiXE8/dcu	2022-02-10 14:09:00 UTC (rev 797)
+++ trunk/packages/DelphiXE8/dcu	2022-02-12 10:58:27 UTC (rev 798)

Property changes on: trunk/packages/DelphiXE8/dcu
___________________________________________________________________
Added: svn:ignore
## -0,0 +1 ##
+*.dcu
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[797] trunk/demo/TDbfViewer/IndexFileContent.pas

[<pau...@us...>]

Revision: 797
          http://sourceforge.net/p/tdbf/code/797
Author:   paulenandrew
Date:     2022-02-10 14:09:00 +0000 (Thu, 10 Feb 2022)
Log Message:
-----------
Fix code style

Modified Paths:
--------------
    trunk/demo/TDbfViewer/IndexFileContent.pas

Modified: trunk/demo/TDbfViewer/IndexFileContent.pas
===================================================================
--- trunk/demo/TDbfViewer/IndexFileContent.pas	2022-02-10 14:08:25 UTC (rev 796)
+++ trunk/demo/TDbfViewer/IndexFileContent.pas	2022-02-10 14:09:00 UTC (rev 797)
@@ -234,8 +234,8 @@
       SeekBlock(BlockNumber);
       Name := 'Page #' + IntToStr(BlockNumber div FBlocksPerPage) +
         ' (Block #' + IntToStr(BlockNumber) + ')';
-      Result := ParseSection(Sections, PageHeaderSize, Name, 0, @ParsePageHeader,
-        PageHeaderSection);
+      Result := ParseSection(Sections, PageHeaderSize, Name, 0,
+        @ParsePageHeader, PageHeaderSection);
 
       // Parse trailer
       if Result then

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[796] trunk

[<pau...@us...>]

Revision: 796
          http://sourceforge.net/p/tdbf/code/796
Author:   paulenandrew
Date:     2022-02-10 14:08:25 +0000 (Thu, 10 Feb 2022)
Log Message:
-----------
Fix variant typecast error parsing NULL index key

Fix "Could not convert variant of type (Null) into type (String)"
parsing NULL index key as a string.

Modified Paths:
--------------
    trunk/src/dbf_idxfile.pas
    trunk/test/TestParseIndexKey.pas

Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas	2022-02-10 14:07:50 UTC (rev 795)
+++ trunk/src/dbf_idxfile.pas	2022-02-10 14:08:25 UTC (rev 796)
@@ -740,7 +740,7 @@
   Result := dbfParseIndexKey(Buffer, KeyType, KeyLength, SecondaryKeyType,
     FoxPro, VariantValue);
   if Result then
-    Value := AnsiString(VariantValue);
+    Value := AnsiString(VarToStr(VariantValue));
   {$else}
   Result := dbfParseIndexKey(Buffer, KeyType, KeyLength, SecondaryKeyType,
     FoxPro, Value);

Modified: trunk/test/TestParseIndexKey.pas
===================================================================
--- trunk/test/TestParseIndexKey.pas	2022-02-10 14:07:50 UTC (rev 795)
+++ trunk/test/TestParseIndexKey.pas	2022-02-10 14:08:25 UTC (rev 796)
@@ -48,6 +48,7 @@
     procedure TestAutoIncFoxPro_Value;
     procedure TestAutoIncFoxPro_ValueNegative;
     procedure TestChar_Null;
+    procedure TestChar_NullAsString;
     procedure TestChar_NullPadded;
     procedure TestChar_SecondaryKeyTypeInvalid;
     procedure TestChar_Value;
@@ -226,6 +227,18 @@
   Check(VarIsNull(Value));
 end;
 
+procedure TTestParseIndexKey.TestChar_NullAsString;
+var
+  Key: AnsiString;
+  Value: string;
+begin
+  Key := '';
+  CheckTrue(dbfParseIndexKeyAsString(PAnsiChar(Key), 'C', Length(Key), $00,
+    False, Value));
+  Check(VarIsStr(Value));
+  CheckEquals('', Value);
+end;
+
 procedure TTestParseIndexKey.TestChar_NullPadded;
 var
   Key: AnsiString;

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[795] trunk/demo/TDbfViewer/IndexFileContent.pas

[<pau...@us...>]

Revision: 795
          http://sourceforge.net/p/tdbf/code/795
Author:   paulenandrew
Date:     2022-02-10 14:07:50 +0000 (Thu, 10 Feb 2022)
Log Message:
-----------
Remove rogue parsing of index key in TDbf Viewer

Call dbfParseIndexKey() to parse the index key for all values. If it
fails, do not promote the undefined value to the section.

Modified Paths:
--------------
    trunk/demo/TDbfViewer/IndexFileContent.pas

Modified: trunk/demo/TDbfViewer/IndexFileContent.pas
===================================================================
--- trunk/demo/TDbfViewer/IndexFileContent.pas	2022-02-10 14:07:23 UTC (rev 794)
+++ trunk/demo/TDbfViewer/IndexFileContent.pas	2022-02-10 14:07:50 UTC (rev 795)
@@ -153,7 +153,6 @@
 var
   BlockNumber: LongWord;
   RecordNumber: LongWord;
-  BufferPtr: PChar;
 begin
   Result := True;
   case Offset of
@@ -205,21 +204,10 @@
     begin
       ItemInfo.Name := 'Key';
       ItemInfo.Size := FIndex.KeyLength;
-      BufferPtr := Buffer;
-      while (BufferPtr < Buffer + ItemInfo.Size) and Result do
-      begin
-        Result := BufferPtr^ = #0;
-        Inc(BufferPtr);
-      end;
-      if Result then
-        ItemInfo.Section.Value := Unassigned
-      else
-      begin
-        Result := dbfParseIndexKey(Buffer, FIndex.KeyType,
-          FIndex.KeyLength, FIndex.SecondaryKeyType, FFoxPro, ItemInfo.Value);
-        if not FPage.IsInnerPage then
-          ItemInfo.Section.Value := ValueToStr(ItemInfo.Value);
-      end;
+      Result := dbfParseIndexKey(Buffer, FIndex.KeyType,
+        FIndex.KeyLength, FIndex.SecondaryKeyType, FFoxPro, ItemInfo.Value);
+      if Result and (not FPage.IsInnerPage) then
+        ItemInfo.Section.Value := ValueToStr(ItemInfo.Value);
     end;
   else
     ItemInfo.VType := varEmpty;

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[794] trunk/src/dbf_idxfile.pas

[<pau...@us...>]

Revision: 794
          http://sourceforge.net/p/tdbf/code/794
Author:   paulenandrew
Date:     2022-02-10 14:07:23 +0000 (Thu, 10 Feb 2022)
Log Message:
-----------
Fix code style

Modified Paths:
--------------
    trunk/src/dbf_idxfile.pas

Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas	2022-02-10 14:06:43 UTC (rev 793)
+++ trunk/src/dbf_idxfile.pas	2022-02-10 14:07:23 UTC (rev 794)
@@ -504,7 +504,7 @@
   Digit: ShortInt;
   DoubleValue: Double;
 begin
-  Result:= True;
+  Result := True;
   case KeyType of
     '@':
     begin

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[793] trunk/src/dbf_idxfile.pas

[<pau...@us...>]

Revision: 793
          http://sourceforge.net/p/tdbf/code/793
Author:   paulenandrew
Date:     2022-02-10 14:06:43 +0000 (Thu, 10 Feb 2022)
Log Message:
-----------
Fix parsing of Numeric (N) BCD index key

Account for compiler differences in the maximum number of digits
supported and size of Char.

Modified Paths:
--------------
    trunk/src/dbf_idxfile.pas

Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas	2022-02-10 14:06:17 UTC (rev 792)
+++ trunk/src/dbf_idxfile.pas	2022-02-10 14:06:43 UTC (rev 793)
@@ -620,7 +620,7 @@
             ByteValue := PByte(Buffer)^;
             FillChar(FloatRec, SizeOf(FloatRec), 0);
             FloatRec.Exponent := ByteValue - $34;
-            DigitCount := PShortInt(PChar(Buffer) + 1)^;
+            DigitCount := PShortInt(PAnsiChar(Buffer) + 1)^;
             if (DigitCount and $80) <> 0 then
             begin
               DigitCount := DigitCount and ShortInt(not $80);
@@ -631,9 +631,10 @@
               DigitCount := (DigitCount - 1) div 4;
               if DigitCount <= 20 then
               begin
-                BCD := PByte(PChar(Buffer) + 2);
+                BCD := PByte(PAnsiChar(Buffer) + 2);
                 Digit := 0;
-                while (Digit < DigitCount) and Result do
+                while (Digit < DigitCount) and
+                  (Digit < High(FloatRec.Digits)) and Result do
                 begin
                   if (Digit mod 2) = 0 then
                     ByteValue := BCD^ shr 4

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[792] trunk/src/dbf_idxfile.pas

[<pau...@us...>]

Revision: 792
          http://sourceforge.net/p/tdbf/code/792
Author:   paulenandrew
Date:     2022-02-10 14:06:17 +0000 (Thu, 10 Feb 2022)
Log Message:
-----------
Fix RCE parsing FoxPro integer (I, +) index key

Fix Range Check Error if the value is negative.

Modified Paths:
--------------
    trunk/src/dbf_idxfile.pas

Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas	2022-02-10 14:05:38 UTC (rev 791)
+++ trunk/src/dbf_idxfile.pas	2022-02-10 14:06:17 UTC (rev 792)
@@ -583,9 +583,9 @@
       begin
         if FoxPro then
 {$ifdef SUPPORT_VARIANTS}
-          Value := SwapIntLE(PInteger(Buffer)^)
+          Value := Integer(SwapIntLE(PDWORD(Buffer)^))
 {$else}
-          Value := IntToStr(SwapIntLE(PInteger(Buffer)^))
+          Value := IntToStr(Integer(SwapIntLE(PDWORD(Buffer)^)))
 {$endif}
         else
         begin

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[791] trunk/src/dbf_idxfile.pas

[<pau...@us...>]

Revision: 791
          http://sourceforge.net/p/tdbf/code/791
Author:   paulenandrew
Date:     2022-02-10 14:05:38 +0000 (Thu, 10 Feb 2022)
Log Message:
-----------
Fix parsing of NULL date (D) index key

Modified Paths:
--------------
    trunk/src/dbf_idxfile.pas

Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas	2022-02-10 14:05:01 UTC (rev 790)
+++ trunk/src/dbf_idxfile.pas	2022-02-10 14:05:38 UTC (rev 791)
@@ -479,12 +479,13 @@
   // Value of Julian epoch (Jan 1, 4713 BCE) used in date index key
   DateJulianEpoch      = -2415019;
 
-  // Value of NULL in date index key
-  DateNullValue        = 1E100;
-
   // Value to display for NULL index key
   NullDisplayValue     = 'NULL';
 
+var
+  // Value of NULL in date index key
+  DateNullValue: Double = 1E100;
+
 function dbfParseIndexKey(Buffer: Pointer; KeyType: AnsiChar;
   KeyLength, SecondaryKeyType: Word; FoxPro: Boolean;
   var Value: {$ifdef SUPPORT_VARIANTS}Variant{$else}AnsiString{$endif}): Boolean;

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[790] trunk/src/dbf_idxfile.pas

[<pau...@us...>]

Revision: 790
          http://sourceforge.net/p/tdbf/code/790
Author:   paulenandrew
Date:     2022-02-10 14:05:01 +0000 (Thu, 10 Feb 2022)
Log Message:
-----------
Fix parsing of NULL character (C) index key

Modified Paths:
--------------
    trunk/src/dbf_idxfile.pas

Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas	2022-02-10 14:04:19 UTC (rev 789)
+++ trunk/src/dbf_idxfile.pas	2022-02-10 14:05:01 UTC (rev 790)
@@ -541,6 +541,14 @@
         SetLength(StringValue, KeyLength);
         Move(Buffer^, PAnsiChar(StringValue)^, KeyLength);
         Value := dbfTrimRight(StringValue);
+        if Value = '' then
+        begin
+{$ifdef SUPPORT_VARIANTS}
+          Value := Null;
+{$else}
+          Value := NullDisplayValue;
+{$endif}
+        end;
       end
       else
         Result:= False;

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[789] trunk/src/dbf_idxfile.pas

[<pau...@us...>]

Revision: 789
          http://sourceforge.net/p/tdbf/code/789
Author:   paulenandrew
Date:     2022-02-10 14:04:19 +0000 (Thu, 10 Feb 2022)
Log Message:
-----------
Fix validation of double (O) index key

Modified Paths:
--------------
    trunk/src/dbf_idxfile.pas

Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas	2022-02-10 14:03:40 UTC (rev 788)
+++ trunk/src/dbf_idxfile.pas	2022-02-10 14:04:19 UTC (rev 789)
@@ -687,7 +687,8 @@
     end;
     'O':
     begin
-      if (KeyLength = 8) and (SecondaryKeyType = $00) then
+{$ifdef SUPPORT_INT64}
+      if (SecondaryKeyType = $00) and (KeyLength = 8) then
       begin
         if PInt64(Buffer)^ <> 0 then
         begin
@@ -712,6 +713,9 @@
       end
       else
         Result := False;
+{$else}
+      Result := False;
+{$endif}
     end;
   end;
 end;

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[788] trunk/src/dbf_idxfile.pas

[<pau...@us...>]

Revision: 788
          http://sourceforge.net/p/tdbf/code/788
Author:   paulenandrew
Date:     2022-02-10 14:03:40 +0000 (Thu, 10 Feb 2022)
Log Message:
-----------
Fix validation of datetime (@) index key

Modified Paths:
--------------
    trunk/src/dbf_idxfile.pas

Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas	2022-02-10 14:03:05 UTC (rev 787)
+++ trunk/src/dbf_idxfile.pas	2022-02-10 14:03:40 UTC (rev 788)
@@ -529,8 +529,9 @@
 {$endif}
       end
       else
+        Result := False;
 {$else}
-        Result := False;
+      Result := False;
 {$endif}
     end;
     'C':

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[787] trunk/test

[<pau...@us...>]

Revision: 787
          http://sourceforge.net/p/tdbf/code/787
Author:   paulenandrew
Date:     2022-02-10 14:03:05 +0000 (Thu, 10 Feb 2022)
Log Message:
-----------
Add unit tests for parsing index key

Modified Paths:
--------------
    trunk/test/TestRegister.pas

Added Paths:
-----------
    trunk/test/TestParseIndexKey.pas

Added: trunk/test/TestParseIndexKey.pas
===================================================================
--- trunk/test/TestParseIndexKey.pas	                        (rev 0)
+++ trunk/test/TestParseIndexKey.pas	2022-02-10 14:03:05 UTC (rev 787)
@@ -0,0 +1,654 @@
+unit TestParseIndexKey;
+
+interface
+
+{$I ..\..\src\dbf_common.inc}
+
+implementation
+
+uses
+  SysUtils,
+  Variants,
+  dbf_common,
+  dbf_idxfile,
+  TestFramework;
+
+type
+  TBCDKey = packed record
+    Exponent: Byte;
+    DigitCount: Byte;
+    Digits: array[0..9] of Byte;
+  end;
+
+{ TTestParseIndexKey }
+
+type
+  TTestParseIndexKey = class(TTestCase)
+  private
+    FCharValue: AnsiString;
+    FDateKey: Double;
+    FDateTimeValue: TDateTime;
+    FDoubleValue: Double;
+    FDoubleKey: Double;
+    FIntegerKey: Cardinal;
+    FIntegerValue: Integer;
+    FNumericBCDKey: TBCDKey;
+    function GetBCDDigitCount(Digits: Byte): Byte;
+    function GetBCDExponent(Exponent: ShortInt): Byte;
+  public
+    procedure SetUp; override;
+  published
+    procedure TestAutoInc_KeyLengthInvalid;
+    procedure TestAutoInc_Null;
+    procedure TestAutoInc_SecondaryKeyTypeInvalid;
+    procedure TestAutoInc_Value;
+    procedure TestAutoInc_ValueNegative;
+    procedure TestAutoIncFoxPro_KeyLengthInvalid;
+    procedure TestAutoIncFoxPro_SecondaryKeyTypeInvalid;
+    procedure TestAutoIncFoxPro_Value;
+    procedure TestAutoIncFoxPro_ValueNegative;
+    procedure TestChar_Null;
+    procedure TestChar_NullPadded;
+    procedure TestChar_SecondaryKeyTypeInvalid;
+    procedure TestChar_Value;
+    procedure TestChar_ValuePadded;
+    procedure TestDate_KeyLengthInvalid;
+    procedure TestDate_Null;
+    procedure TestDate_SecondaryKeyTypeInvalid;
+    procedure TestDate_Value;
+{$ifdef SUPPORT_INT64}
+    procedure TestDateTime_KeyLengthInvalid;
+    procedure TestDateTime_Null;
+    procedure TestDateTime_SecondaryKeyTypeInvalid;
+{$endif}
+    procedure TestDateTime_Value;
+{$ifdef SUPPORT_INT64}
+    procedure TestDouble_KeyLengthInvalid;
+    procedure TestDouble_Null;
+    procedure TestDouble_SecondaryKeyTypeInvalid;
+{$endif}
+    procedure TestDouble_Value;
+{$ifdef SUPPORT_INT64}
+    procedure TestDouble_ValueNegative;
+{$endif}
+    procedure TestInteger_KeyLengthInvalid;
+    procedure TestInteger_Null;
+    procedure TestInteger_SecondaryKeyTypeInvalid;
+    procedure TestInteger_Value;
+    procedure TestInteger_ValueNegative;
+    procedure TestIntegerFoxPro_KeyLengthInvalid;
+    procedure TestIntegerFoxPro_Value;
+    procedure TestIntegerFoxPro_ValueNegative;
+    procedure TestIntegerFoxPro_SecondaryKeyTypeInvalid;
+    procedure TestNumeric_KeyLengthInvalid;
+    procedure TestNumeric_SecondaryKeyTypeInvalid;
+    procedure TestNumeric_Value;
+    procedure TestNumericBCD_DigitCountHigh;
+    procedure TestNumericBCD_DigitCountHighInvalid;
+    procedure TestNumericBCD_DigitCountLow;
+    procedure TestNumericBCD_DigitCountLowInvalid;
+    procedure TestNumericBCD_DigitCountModInvalid;
+    procedure TestNumericBCD_DigitHighInvalid;
+    procedure TestNumericBCD_KeyLengthInvalid;
+    procedure TestNumericBCD_SecondaryKeyTypeInvalid;
+    procedure TestNumericBCD_Value;
+    procedure TestNumericBCD_ValueExponentNegative;
+    procedure TestNumericBCD_ValueExponentZero;
+    procedure TestNumericBCD_ValueNegative;
+  end;
+
+function TTestParseIndexKey.GetBCDDigitCount(Digits: Byte): Byte;
+begin
+  Result := (4 * Digits) + 1;
+end;
+
+function TTestParseIndexKey.GetBCDExponent(Exponent: ShortInt): Byte;
+begin
+  Result := $34 + Exponent;
+end;
+
+procedure TTestParseIndexKey.SetUp;
+begin
+  inherited;
+
+  // Set common values
+  FCharValue := 'Test';
+  FDateTimeValue := EncodeDate(2022, 1, 20) + EncodeTime(18, 0, 0, 0);
+  FDoubleValue := FDateTimeValue;
+  FIntegerValue := 2022;
+
+  // Encode common key values
+  FDateKey := FDateTimeValue + 2415019;
+  FDoubleKey := -FDoubleValue;
+  SwapInt64BE(@FDoubleKey, @FDoubleKey);
+  FIntegerKey := SwapIntBE(Cardinal(FIntegerValue xor Integer($80000000)));
+  FillChar(FNumericBCDKey, SizeOf(FNumericBCDKey), 0);
+  FNumericBCDKey.Exponent := GetBCDExponent(1);
+  FNumericBCDKey.DigitCount := GetBCDDigitCount(3);
+  FNumericBCDKey.Digits[0] := $12;
+  FNumericBCDKey.Digits[1] := $50;
+end;
+
+procedure TTestParseIndexKey.TestAutoInc_KeyLengthInvalid;
+var
+  Value: Variant;
+begin
+  CheckFalse(dbfParseIndexKey(@FIntegerKey, '+', 2, $00, False, Value));
+end;
+
+procedure TTestParseIndexKey.TestAutoInc_Null;
+var
+  Key: Cardinal;
+  Value: Variant;
+begin
+  Key := 0;
+  CheckTrue(dbfParseIndexKey(@Key, '+', SizeOf(Key), $00, False, Value));
+  Check(VarIsNull(Value));
+end;
+
+procedure TTestParseIndexKey.TestAutoInc_SecondaryKeyTypeInvalid;
+var
+  Value: Variant;
+begin
+  CheckFalse(dbfParseIndexKey(@FIntegerKey, '+', SizeOf(FIntegerKey), $01,
+    False, Value));
+end;
+
+procedure TTestParseIndexKey.TestAutoInc_Value;
+var
+  Value: Variant;
+begin
+  CheckTrue(dbfParseIndexKey(@FIntegerKey, '+', SizeOf(FIntegerKey), $00, False,
+    Value));
+  Check(VarIsOrdinal(Value));
+  CheckEquals(FIntegerValue, Value);
+end;
+
+procedure TTestParseIndexKey.TestAutoInc_ValueNegative;
+var
+  Key: Cardinal;
+  Value: Variant;
+begin
+  Key := SwapIntBE(Cardinal(-FIntegerValue xor Integer($80000000)));
+  CheckTrue(dbfParseIndexKey(@Key, '+', SizeOf(Key), $00, False, Value));
+  Check(VarIsOrdinal(Value));
+  CheckEquals(-FIntegerValue, Value);
+end;
+
+procedure TTestParseIndexKey.TestAutoIncFoxPro_KeyLengthInvalid;
+var
+  Key: Cardinal;
+  Value: Variant;
+begin
+  Key := SwapIntLE(FIntegerValue);
+  CheckFalse(dbfParseIndexKey(@Key, '+', 2, $00, True, Value));
+end;
+
+procedure TTestParseIndexKey.TestAutoIncFoxPro_SecondaryKeyTypeInvalid;
+var
+  Key: Cardinal;
+  Value: Variant;
+begin
+  Key := SwapIntLE(FIntegerValue);
+  CheckFalse(dbfParseIndexKey(@Key, '+', SizeOf(Key), $01, True, Value));
+end;
+
+procedure TTestParseIndexKey.TestAutoIncFoxPro_Value;
+var
+  Key: Cardinal;
+  Value: Variant;
+begin
+  Key := SwapIntLE(FIntegerValue);
+  CheckTrue(dbfParseIndexKey(@Key, '+', SizeOf(Key), $00, True, Value));
+  Check(VarIsOrdinal(Value));
+  CheckEquals(FIntegerValue, Value);
+end;
+
+procedure TTestParseIndexKey.TestAutoIncFoxPro_ValueNegative;
+var
+  Key: Cardinal;
+  Value: Variant;
+begin
+  Key := SwapIntLE(Cardinal(-FIntegerValue));
+  CheckTrue(dbfParseIndexKey(@Key, '+', SizeOf(Key), $00, True, Value));
+  Check(VarIsOrdinal(Value));
+  CheckEquals(-FIntegerValue, Value);
+end;
+
+procedure TTestParseIndexKey.TestChar_Null;
+var
+  Key: AnsiString;
+  Value: Variant;
+begin
+  Key := '';
+  CheckTrue(dbfParseIndexKey(PAnsiChar(Key), 'C', Length(Key), $00, False,
+    Value));
+  Check(VarIsNull(Value));
+end;
+
+procedure TTestParseIndexKey.TestChar_NullPadded;
+var
+  Key: AnsiString;
+  Value: Variant;
+begin
+  Key := ' ';
+  CheckTrue(dbfParseIndexKey(PAnsiChar(Key), 'C', Length(Key), $00, False,
+    Value));
+  Check(VarIsNull(Value));
+end;
+
+procedure TTestParseIndexKey.TestChar_SecondaryKeyTypeInvalid;
+var
+  Value: Variant;
+begin
+  CheckFalse(dbfParseIndexKey(PAnsiChar(FCharValue), 'C', Length(FCharValue),
+    $01, False, Value));
+end;
+
+procedure TTestParseIndexKey.TestChar_Value;
+var
+  Value: Variant;
+begin
+  CheckTrue(dbfParseIndexKey(PAnsiChar(FCharValue), 'C', Length(FCharValue),
+    $00, False, Value));
+  Check(VarIsType(Value, varString));
+  CheckEquals(FCharValue, AnsiString(Value));
+end;
+
+procedure TTestParseIndexKey.TestChar_ValuePadded;
+var
+  Key: AnsiString;
+  Value: Variant;
+begin
+  Key := FCharValue + ' ';
+  CheckTrue(dbfParseIndexKey(PAnsiChar(Key), 'C', Length(Key),
+    $00, False, Value));
+  Check(VarIsType(Value, varString));
+  CheckEquals(FCharValue, AnsiString(Value));
+end;
+
+procedure TTestParseIndexKey.TestDate_KeyLengthInvalid;
+var
+  Value: Variant;
+begin
+  CheckFalse(dbfParseIndexKey(@FDateKey, 'D', 4, $01, False, Value));
+end;
+
+procedure TTestParseIndexKey.TestDate_Null;
+var
+  Key: Double;
+  Value: Variant;
+begin
+  Key := 1E100;
+  CheckTrue(dbfParseIndexKey(@Key, 'D', SizeOf(Key), $01, False, Value));
+  Check(VarIsNull(Value));
+end;
+
+procedure TTestParseIndexKey.TestDate_SecondaryKeyTypeInvalid;
+var
+  Value: Variant;
+begin
+  CheckFalse(dbfParseIndexKey(@FDateKey, 'D', SizeOf(FDateKey), $00, False,
+    Value));
+end;
+
+procedure TTestParseIndexKey.TestDate_Value;
+var
+  Value: Variant;
+begin
+  CheckTrue(dbfParseIndexKey(@FDateKey, 'D', SizeOf(FDateKey), $01, False,
+    Value));
+  Check(VarIsType(Value, varDate));
+  CheckEquals(FDateTimeValue, Value);
+end;
+
+{$ifdef SUPPORT_INT64}
+procedure TTestParseIndexKey.TestDateTime_KeyLengthInvalid;
+var
+  Key: Double;
+  Value: Variant;
+begin
+  Key := DateTimeToBDETimeStamp(FDateTimeValue);
+  SwapInt64BE(@Key, @Key);
+  CheckFalse(dbfParseIndexKey(@Key, '@', 4, $00, False, Value));
+end;
+
+procedure TTestParseIndexKey.TestDateTime_Null;
+var
+  Key: Int64;
+  Value: Variant;
+begin
+  Key := 0;
+  CheckTrue(dbfParseIndexKey(@Key, '@', SizeOf(Key), $00, False, Value));
+  Check(VarIsNull(Value));
+end;
+
+procedure TTestParseIndexKey.TestDateTime_SecondaryKeyTypeInvalid;
+var
+  Key: Double;
+  Value: Variant;
+begin
+  Key := DateTimeToBDETimeStamp(FDateTimeValue);
+  SwapInt64BE(@Key, @Key);
+  CheckFalse(dbfParseIndexKey(@Key, '@', SizeOf(Key), $01, False, Value));
+end;
+{$endif}
+
+procedure TTestParseIndexKey.TestDateTime_Value;
+var
+  Key: Double;
+  Value: Variant;
+  ParseResult: Boolean;
+begin
+  Key := DateTimeToBDETimeStamp(FDateTimeValue);
+  SwapInt64BE(@Key, @Key);
+  ParseResult := dbfParseIndexKey(@Key, '@', SizeOf(Key), $00, False, Value);
+{$ifdef SUPPORT_INT64}
+  CheckTrue(ParseResult);
+{$else}
+  CheckFalse(ParseResult);
+{$endif}
+end;
+
+{$ifdef SUPPORT_INT64}
+procedure TTestParseIndexKey.TestDouble_KeyLengthInvalid;
+var
+  Value: Variant;
+begin
+  CheckFalse(dbfParseIndexKey(@FDoubleKey, 'O', 4, $00, False, Value));
+end;
+
+procedure TTestParseIndexKey.TestDouble_Null;
+var
+  Key: Double;
+  Value: Variant;
+begin
+  Key := 0;
+  CheckTrue(dbfParseIndexKey(@Key, 'O', SizeOf(Key), $00, False, Value));
+  Check(VarIsNull(Value));
+end;
+
+procedure TTestParseIndexKey.TestDouble_SecondaryKeyTypeInvalid;
+var
+  Value: Variant;
+begin
+  CheckFalse(dbfParseIndexKey(@FDoubleKey, 'O', SizeOf(FDoubleKey), $01, False,
+    Value));
+end;
+{$endif}
+
+procedure TTestParseIndexKey.TestDouble_Value;
+var
+  Value: Variant;
+  ParseResult: Boolean;
+begin
+  ParseResult := dbfParseIndexKey(@FDoubleKey, 'O', SizeOf(FDoubleKey), $00,
+    False, Value);
+{$ifdef SUPPORT_INT64}
+  CheckTrue(ParseResult);
+  Check(VarIsType(Value, varDouble));
+  CheckEquals(FDoubleValue, Value);
+{$else}
+  CheckFalse(ParseResult);
+{$endif}
+end;
+
+{$ifdef SUPPORT_INT64}
+procedure TTestParseIndexKey.TestDouble_ValueNegative;
+var
+  Key: Double;
+  Value: Variant;
+begin
+  Key := -FDoubleValue;
+  PInt64(@Key)^ := not PInt64(@Key)^;
+  SwapInt64BE(@Key, @Key);
+  CheckTrue(dbfParseIndexKey(@Key, 'O', SizeOf(Key), $00, False, Value));
+  Check(VarIsType(Value, varDouble));
+  CheckEquals(-FDoubleValue, Value);
+end;
+{$endif}
+
+procedure TTestParseIndexKey.TestInteger_KeyLengthInvalid;
+var
+  Value: Variant;
+begin
+  CheckFalse(dbfParseIndexKey(@FIntegerKey, 'I', 2, $00, False, Value));
+end;
+
+procedure TTestParseIndexKey.TestInteger_Null;
+var
+  Key: Cardinal;
+  Value: Variant;
+begin
+  Key := 0;
+  CheckTrue(dbfParseIndexKey(@Key, 'I', SizeOf(Key), $00, False, Value));
+  Check(VarIsNull(Value));
+end;
+
+procedure TTestParseIndexKey.TestInteger_SecondaryKeyTypeInvalid;
+var
+  Value: Variant;
+begin
+  CheckFalse(dbfParseIndexKey(@FIntegerKey, 'I', SizeOf(FIntegerKey), $01,
+    False, Value));
+end;
+
+procedure TTestParseIndexKey.TestInteger_Value;
+var
+  Value: Variant;
+begin
+  CheckTrue(dbfParseIndexKey(@FIntegerKey, 'I', SizeOf(FIntegerKey), $00, False,
+    Value));
+  Check(VarIsOrdinal(Value));
+  CheckEquals(FIntegerValue, Value);
+end;
+
+procedure TTestParseIndexKey.TestInteger_ValueNegative;
+var
+  Key: Cardinal;
+  Value: Variant;
+begin
+  Key := SwapIntBE(Cardinal(-FIntegerValue xor Integer($80000000)));
+  CheckTrue(dbfParseIndexKey(@Key, 'I', SizeOf(Key), $00, False, Value));
+  Check(VarIsOrdinal(Value));
+  CheckEquals(-FIntegerValue, Value);
+end;
+
+procedure TTestParseIndexKey.TestIntegerFoxPro_KeyLengthInvalid;
+var
+  Key: Cardinal;
+  Value: Variant;
+begin
+  Key := SwapIntLE(FIntegerValue);
+  CheckFalse(dbfParseIndexKey(@Key, 'I', 2, $00, True, Value));
+end;
+
+procedure TTestParseIndexKey.TestIntegerFoxPro_Value;
+var
+  Key: Cardinal;
+  Value: Variant;
+begin
+  Key := SwapIntLE(FIntegerValue);
+  CheckTrue(dbfParseIndexKey(@Key, 'I', SizeOf(Key), $00, True, Value));
+  Check(VarIsOrdinal(Value));
+  CheckEquals(FIntegerValue, Value);
+end;
+
+procedure TTestParseIndexKey.TestIntegerFoxPro_ValueNegative;
+var
+  Key: Cardinal;
+  Value: Variant;
+begin
+  Key := SwapIntLE(Cardinal(-FIntegerValue));
+  CheckTrue(dbfParseIndexKey(@Key, 'I', SizeOf(Key), $00, True, Value));
+  Check(VarIsOrdinal(Value));
+  CheckEquals(-FIntegerValue, Value);
+end;
+
+procedure TTestParseIndexKey.TestIntegerFoxPro_SecondaryKeyTypeInvalid;
+var
+  Key: Cardinal;
+  Value: Variant;
+begin
+  Key := SwapIntLE(FIntegerValue);
+  CheckFalse(dbfParseIndexKey(@Key, 'I', SizeOf(Key), $01, True, Value));
+end;
+
+procedure TTestParseIndexKey.TestNumeric_KeyLengthInvalid;
+var
+  Value: Variant;
+begin
+  CheckFalse(dbfParseIndexKey(@FDoubleValue, 'N', 4, $01, False, Value));
+end;
+
+procedure TTestParseIndexKey.TestNumeric_SecondaryKeyTypeInvalid;
+var
+  Value: Variant;
+begin
+  CheckFalse(dbfParseIndexKey(@FDoubleValue, 'N', SizeOf(FDoubleValue), $02,
+    False, Value));
+end;
+
+procedure TTestParseIndexKey.TestNumeric_Value;
+var
+  Value: Variant;
+begin
+  CheckTrue(dbfParseIndexKey(@FDoubleValue, 'N', SizeOf(FDoubleValue), $01,
+    False, Value));
+  Check(VarIsType(Value, varDouble));
+  CheckEquals(FDoubleValue, Value);
+end;
+
+procedure TTestParseIndexKey.TestNumericBCD_DigitCountHigh;
+var
+  Key: TBCDKey;
+  Value: Variant;
+begin
+  Key := FNumericBCDKey;
+  Key.DigitCount := GetBCDDigitCount(20);
+  CheckTrue(dbfParseIndexKey(@Key, 'N', SizeOf(Key), $00, False, Value));
+  Check(VarIsType(Value, varDouble));
+  CheckEquals(1.25, Value);
+end;
+
+procedure TTestParseIndexKey.TestNumericBCD_DigitCountHighInvalid;
+var
+  Key: TBCDKey;
+  Value: Variant;
+begin
+  Key := FNumericBCDKey;
+  Key.DigitCount := GetBCDDigitCount(21);
+  CheckFalse(dbfParseIndexKey(@Key, 'N', SizeOf(Key), $00, False, Value));
+end;
+
+procedure TTestParseIndexKey.TestNumericBCD_DigitCountLow;
+var
+  Key: TBCDKey;
+  Value: Variant;
+begin
+  Key := FNumericBCDKey;
+  Key.DigitCount := GetBCDDigitCount(0);
+  CheckTrue(dbfParseIndexKey(@Key, 'N', SizeOf(Key), $00, False, Value));
+  Check(VarIsType(Value, varDouble));
+  CheckEquals(0, Value);
+end;
+
+procedure TTestParseIndexKey.TestNumericBCD_DigitCountLowInvalid;
+var
+  Key: TBCDKey;
+  Value: Variant;
+begin
+  Key := FNumericBCDKey;
+  Key.DigitCount := GetBCDDigitCount(0) - 1;
+  CheckFalse(dbfParseIndexKey(@Key, 'N', SizeOf(Key), $00, False, Value));
+end;
+
+procedure TTestParseIndexKey.TestNumericBCD_DigitCountModInvalid;
+var
+  Key: TBCDKey;
+  Value: Variant;
+begin
+  Key := FNumericBCDKey;
+  Key.DigitCount := GetBCDDigitCount(0) + 1;
+  CheckFalse(dbfParseIndexKey(@Key, 'N', SizeOf(Key), $00, False, Value));
+end;
+
+procedure TTestParseIndexKey.TestNumericBCD_DigitHighInvalid;
+var
+  Key: TBCDKey;
+  Value: Variant;
+begin
+  Key := FNumericBCDKey;
+  Key.Digits[0] := $A0;
+  CheckFalse(dbfParseIndexKey(@Key, 'N', SizeOf(Key), $00, False, Value));
+end;
+
+procedure TTestParseIndexKey.TestNumericBCD_KeyLengthInvalid;
+var
+  Value: Variant;
+begin
+  CheckFalse(dbfParseIndexKey(@FNumericBCDKey, 'N', 8, $00, False, Value));
+end;
+
+procedure TTestParseIndexKey.TestNumericBCD_SecondaryKeyTypeInvalid;
+var
+  Value: Variant;
+begin
+  CheckFalse(dbfParseIndexKey(@FNumericBCDKey, 'N', SizeOf(FNumericBCDKey), $01,
+    False, Value));
+end;
+
+procedure TTestParseIndexKey.TestNumericBCD_Value;
+var
+  Value: Variant;
+begin
+  CheckTrue(dbfParseIndexKey(@FNumericBCDKey, 'N', SizeOf(FNumericBCDKey), $00,
+    False, Value));
+  Check(VarIsType(Value, varDouble));
+  CheckEquals(1.25, Value);
+end;
+
+procedure TTestParseIndexKey.TestNumericBCD_ValueExponentNegative;
+var
+  Key: TBCDKey;
+  Value: Variant;
+begin
+  Key := FNumericBCDKey;
+  Key.Exponent := GetBCDExponent(-1);
+  Key.DigitCount := GetBCDDigitCount(3);
+  Key.Digits[0] := $62;
+  Key.Digits[1] := $50;
+  CheckTrue(dbfParseIndexKey(@Key, 'N', SizeOf(Key), $00, False, Value));
+  Check(VarIsType(Value, varDouble));
+  CheckEquals(0.0625, Value);
+end;
+
+procedure TTestParseIndexKey.TestNumericBCD_ValueExponentZero;
+var
+  Key: TBCDKey;
+  Value: Variant;
+begin
+  Key := FNumericBCDKey;
+  Key.Exponent := GetBCDExponent(0);
+  CheckTrue(dbfParseIndexKey(@Key, 'N', SizeOf(Key), $00, False, Value));
+  Check(VarIsType(Value, varDouble));
+  CheckEquals(0.125, Value);
+end;
+
+procedure TTestParseIndexKey.TestNumericBCD_ValueNegative;
+var
+  Key: TBCDKey;
+  Value: Variant;
+begin
+  Key := FNumericBCDKey;
+  Key.DigitCount := FNumericBCDKey.DigitCount or $80;
+  CheckTrue(dbfParseIndexKey(@Key, 'N', SizeOf(Key), $00, False, Value));
+  Check(VarIsType(Value, varDouble));
+  CheckEquals(-1.25, Value);
+end;
+
+initialization
+  RegisterTest(TTestParseIndexKey.Suite);
+
+end.
+


Property changes on: trunk/test/TestParseIndexKey.pas
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Modified: trunk/test/TestRegister.pas
===================================================================
--- trunk/test/TestRegister.pas	2022-02-10 14:02:07 UTC (rev 786)
+++ trunk/test/TestRegister.pas	2022-02-10 14:03:05 UTC (rev 787)
@@ -5,6 +5,7 @@
 implementation
 
 uses
+  TestParseIndexKey,
   TestUniqueIndex;
 
 end.

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[786] trunk/test/Lazarus

[<pau...@us...>]

Revision: 786
          http://sourceforge.net/p/tdbf/code/786
Author:   paulenandrew
Date:     2022-02-10 14:02:07 +0000 (Thu, 10 Feb 2022)
Log Message:
-----------
Add build modes for Lazarus unit tests

Instead of using the default target, add modes for targets of
x86_64 (i.e. x64) and i386 (i.e. x86).

Modified Paths:
--------------
    trunk/test/Lazarus/TestConsole.lpi
    trunk/test/Lazarus/TestGUI.lpi

Modified: trunk/test/Lazarus/TestConsole.lpi
===================================================================
--- trunk/test/Lazarus/TestConsole.lpi	2022-02-10 14:01:17 UTC (rev 785)
+++ trunk/test/Lazarus/TestConsole.lpi	2022-02-10 14:02:07 UTC (rev 786)
@@ -12,9 +12,9 @@
     <i18n>
       <EnableI18N LFM="False"/>
     </i18n>
-    <BuildModes Count="3">
-      <Item1 Name="Release" Default="True"/>
-      <Item2 Name="Debug">
+    <BuildModes Count="6">
+      <Item1 Name="Debug_x86_64" Default="True"/>
+      <Item2 Name="Debug_i386">
         <CompilerOptions>
           <Version Value="11"/>
           <PathDelim Value="\"/>
@@ -39,6 +39,7 @@
               <StackChecks Value="True"/>
             </Checks>
             <VerifyObjMethodCallValidity Value="True"/>
+            <TargetCPU Value="i386"/>
           </CodeGeneration>
           <Linking>
             <Debugging>
@@ -56,7 +57,7 @@
           </Other>
         </CompilerOptions>
       </Item2>
-      <Item3 Name="Debug-Cache">
+      <Item3 Name="Debug-Cache_x86_64">
         <CompilerOptions>
           <Version Value="11"/>
           <PathDelim Value="\"/>
@@ -81,6 +82,7 @@
               <StackChecks Value="True"/>
             </Checks>
             <VerifyObjMethodCallValidity Value="True"/>
+            <TargetCPU Value="x86_64"/>
           </CodeGeneration>
           <Linking>
             <Debugging>
@@ -100,6 +102,105 @@
           </Other>
         </CompilerOptions>
       </Item3>
+      <Item4 Name="Debug-Cache_i386">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="$(BuildMode)\TestConsole"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <OtherUnitFiles Value="..;..\..\src"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <IncludeAssertionCode Value="True"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <Checks>
+              <IOChecks Value="True"/>
+              <RangeChecks Value="True"/>
+              <OverflowChecks Value="True"/>
+              <StackChecks Value="True"/>
+            </Checks>
+            <VerifyObjMethodCallValidity Value="True"/>
+            <TargetCPU Value="i386"/>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <DebugInfoType Value="dsDwarf2Set"/>
+              <UseHeaptrc Value="True"/>
+              <TrashVariables Value="True"/>
+              <UseExternalDbgSyms Value="True"/>
+            </Debugging>
+          </Linking>
+          <Other>
+            <CustomOptions Value="-dTDBF_INDEX_CHECK
+-dUSE_CACHE"/>
+            <OtherDefines Count="2">
+              <Define0 Value="TDBF_INDEX_CHECK"/>
+              <Define1 Value="USE_CACHE"/>
+            </OtherDefines>
+          </Other>
+        </CompilerOptions>
+      </Item4>
+      <Item5 Name="Release_x86_64">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="$(BuildMode)\TestConsole"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <OtherUnitFiles Value="..;..\..\src"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <TargetCPU Value="x86_64"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+          </Linking>
+        </CompilerOptions>
+      </Item5>
+      <Item6 Name="Release_i386">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="$(BuildMode)\TestConsole"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <OtherUnitFiles Value="..;..\..\src"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <TargetCPU Value="i386"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+          </Linking>
+        </CompilerOptions>
+      </Item6>
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
@@ -106,9 +207,7 @@
     </PublishOptions>
     <RunParams>
       <FormatVersion Value="2"/>
-      <Modes Count="1">
-        <Mode0 Name="default"/>
-      </Modes>
+      <Modes Count="0"/>
     </RunParams>
     <RequiredPackages Count="2">
       <Item1>
@@ -140,18 +239,32 @@
       <OtherUnitFiles Value="..;..\..\src"/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <IncludeAssertionCode Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
     <CodeGeneration>
-      <SmartLinkUnit Value="True"/>
-      <Optimizations>
-        <OptimizationLevel Value="3"/>
-      </Optimizations>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
+      <TargetCPU Value="x86_64"/>
     </CodeGeneration>
     <Linking>
       <Debugging>
-        <GenerateDebugInfo Value="False"/>
+        <DebugInfoType Value="dsDwarf2Set"/>
+        <UseHeaptrc Value="True"/>
+        <TrashVariables Value="True"/>
+        <UseExternalDbgSyms Value="True"/>
       </Debugging>
-      <LinkSmart Value="True"/>
     </Linking>
+    <Other>
+      <CustomOptions Value="-dTDBF_INDEX_CHECK"/>
+    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

Modified: trunk/test/Lazarus/TestGUI.lpi
===================================================================
--- trunk/test/Lazarus/TestGUI.lpi	2022-02-10 14:01:17 UTC (rev 785)
+++ trunk/test/Lazarus/TestGUI.lpi	2022-02-10 14:02:07 UTC (rev 786)
@@ -12,9 +12,9 @@
     <i18n>
       <EnableI18N LFM="False"/>
     </i18n>
-    <BuildModes Count="3">
-      <Item1 Name="Release" Default="True"/>
-      <Item2 Name="Debug">
+    <BuildModes Count="6">
+      <Item1 Name="Debug_x86_64" Default="True"/>
+      <Item2 Name="Debug_i386">
         <CompilerOptions>
           <Version Value="11"/>
           <PathDelim Value="\"/>
@@ -39,6 +39,7 @@
               <StackChecks Value="True"/>
             </Checks>
             <VerifyObjMethodCallValidity Value="True"/>
+            <TargetCPU Value="i386"/>
           </CodeGeneration>
           <Linking>
             <Debugging>
@@ -56,7 +57,7 @@
           </Other>
         </CompilerOptions>
       </Item2>
-      <Item3 Name="Debug-Cache">
+      <Item3 Name="Debug-Cache_x86_64">
         <CompilerOptions>
           <Version Value="11"/>
           <PathDelim Value="\"/>
@@ -81,6 +82,7 @@
               <StackChecks Value="True"/>
             </Checks>
             <VerifyObjMethodCallValidity Value="True"/>
+            <TargetCPU Value="x86_64"/>
           </CodeGeneration>
           <Linking>
             <Debugging>
@@ -100,15 +102,113 @@
           </Other>
         </CompilerOptions>
       </Item3>
+      <Item4 Name="Debug-Cache_i386">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="$(BuildMode)\TestGUI"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <OtherUnitFiles Value="..;..\..\src"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <IncludeAssertionCode Value="True"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <Checks>
+              <IOChecks Value="True"/>
+              <RangeChecks Value="True"/>
+              <OverflowChecks Value="True"/>
+              <StackChecks Value="True"/>
+            </Checks>
+            <VerifyObjMethodCallValidity Value="True"/>
+            <TargetCPU Value="i386"/>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <DebugInfoType Value="dsDwarf2Set"/>
+              <UseHeaptrc Value="True"/>
+              <TrashVariables Value="True"/>
+              <UseExternalDbgSyms Value="True"/>
+            </Debugging>
+          </Linking>
+          <Other>
+            <CustomOptions Value="-dTDBF_INDEX_CHECK
+-dUSE_CACHE"/>
+            <OtherDefines Count="2">
+              <Define0 Value="TDBF_INDEX_CHECK"/>
+              <Define1 Value="USE_CACHE"/>
+            </OtherDefines>
+          </Other>
+        </CompilerOptions>
+      </Item4>
+      <Item5 Name="Release_x86_64">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="$(BuildMode)\TestGUI"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <OtherUnitFiles Value="..;..\..\src"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <TargetCPU Value="x86_64"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+          </Linking>
+        </CompilerOptions>
+      </Item5>
+      <Item6 Name="Release_i386">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="$(BuildMode)\TestGUI"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <OtherUnitFiles Value="..;..\..\src"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <TargetCPU Value="i386"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+          </Linking>
+        </CompilerOptions>
+      </Item6>
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
     </PublishOptions>
     <RunParams>
-      <FormatVersion Value="2"/>
-      <Modes Count="1">
-        <Mode0 Name="default"/>
-      </Modes>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
     </RunParams>
     <RequiredPackages Count="3">
       <Item1>
@@ -143,18 +243,35 @@
       <OtherUnitFiles Value="..;..\..\src"/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <IncludeAssertionCode Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
     <CodeGeneration>
-      <SmartLinkUnit Value="True"/>
-      <Optimizations>
-        <OptimizationLevel Value="3"/>
-      </Optimizations>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
+      <TargetCPU Value="x86_64"/>
     </CodeGeneration>
     <Linking>
       <Debugging>
-        <GenerateDebugInfo Value="False"/>
+        <DebugInfoType Value="dsDwarf2Set"/>
+        <UseHeaptrc Value="True"/>
+        <TrashVariables Value="True"/>
+        <UseExternalDbgSyms Value="True"/>
       </Debugging>
-      <LinkSmart Value="True"/>
     </Linking>
+    <Other>
+      <CustomOptions Value="-dTDBF_INDEX_CHECK"/>
+      <OtherDefines Count="1">
+        <Define0 Value="TDBF_INDEX_CHECK"/>
+      </OtherDefines>
+    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[785] trunk/test

[<pau...@us...>]

Revision: 785
          http://sourceforge.net/p/tdbf/code/785
Author:   paulenandrew
Date:     2022-02-10 14:01:17 +0000 (Thu, 10 Feb 2022)
Log Message:
-----------
Use common test registration

Modified Paths:
--------------
    trunk/test/Delphi/TestConsole.dpr
    trunk/test/Delphi/TestGUI.dpr
    trunk/test/Lazarus/TestConsole.lpi
    trunk/test/Lazarus/TestConsole.lpr
    trunk/test/Lazarus/TestGUI.lpi
    trunk/test/Lazarus/TestGUI.lpr

Added Paths:
-----------
    trunk/test/TestRegister.pas

Modified: trunk/test/Delphi/TestConsole.dpr
===================================================================
--- trunk/test/Delphi/TestConsole.dpr	2022-02-10 13:53:47 UTC (rev 784)
+++ trunk/test/Delphi/TestConsole.dpr	2022-02-10 14:01:17 UTC (rev 785)
@@ -5,7 +5,7 @@
 uses
   TestFramework,
   TextTestRunner,
-  TestUniqueIndex in '..\TestUniqueIndex.pas';
+  TestRegister in '..\TestRegister.pas';
 
 var
   TestResult: TTestResult;

Modified: trunk/test/Delphi/TestGUI.dpr
===================================================================
--- trunk/test/Delphi/TestGUI.dpr	2022-02-10 13:53:47 UTC (rev 784)
+++ trunk/test/Delphi/TestGUI.dpr	2022-02-10 14:01:17 UTC (rev 785)
@@ -3,7 +3,7 @@
 uses
   Forms,
   GuiTestRunner,
-  TestUniqueIndex in '..\TestUniqueIndex.pas';
+  TestRegister in '..\TestRegister.pas';
 
 begin
   Application.Initialize;

Modified: trunk/test/Lazarus/TestConsole.lpi
===================================================================
--- trunk/test/Lazarus/TestConsole.lpi	2022-02-10 13:53:47 UTC (rev 784)
+++ trunk/test/Lazarus/TestConsole.lpi	2022-02-10 14:01:17 UTC (rev 785)
@@ -124,7 +124,7 @@
         <IsPartOfProject Value="True"/>
       </Unit0>
       <Unit1>
-        <Filename Value="..\TestUniqueIndex.pas"/>
+        <Filename Value="..\TestRegister.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit1>
     </Units>

Modified: trunk/test/Lazarus/TestConsole.lpr
===================================================================
--- trunk/test/Lazarus/TestConsole.lpr	2022-02-10 13:53:47 UTC (rev 784)
+++ trunk/test/Lazarus/TestConsole.lpr	2022-02-10 14:01:17 UTC (rev 785)
@@ -3,7 +3,7 @@
 uses
   TestFrameworkProxyIfaces,
   TextTestRunner,
-  TestUniqueIndex;
+  TestRegister;
 
 var
   TestResult: ITestResult;

Modified: trunk/test/Lazarus/TestGUI.lpi
===================================================================
--- trunk/test/Lazarus/TestGUI.lpi	2022-02-10 13:53:47 UTC (rev 784)
+++ trunk/test/Lazarus/TestGUI.lpi	2022-02-10 14:01:17 UTC (rev 785)
@@ -127,7 +127,7 @@
         <IsPartOfProject Value="True"/>
       </Unit0>
       <Unit1>
-        <Filename Value="TestUniqueIndex.pas"/>
+        <Filename Value="TestRegister.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit1>
     </Units>

Modified: trunk/test/Lazarus/TestGUI.lpr
===================================================================
--- trunk/test/Lazarus/TestGUI.lpr	2022-02-10 13:53:47 UTC (rev 784)
+++ trunk/test/Lazarus/TestGUI.lpr	2022-02-10 14:01:17 UTC (rev 785)
@@ -4,7 +4,7 @@
   Forms,
   Interfaces,
   GuiTestRunner,
-  TestUniqueIndex;
+  TestRegister;
 
 begin
   Application.Initialize;

Added: trunk/test/TestRegister.pas
===================================================================
--- trunk/test/TestRegister.pas	                        (rev 0)
+++ trunk/test/TestRegister.pas	2022-02-10 14:01:17 UTC (rev 785)
@@ -0,0 +1,11 @@
+unit TestRegister;
+
+interface
+
+implementation
+
+uses
+  TestUniqueIndex;
+
+end.
+


Property changes on: trunk/test/TestRegister.pas
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[tdbf-cvs] SF.net SVN: tdbf:[784] trunk/test/TestUniqueIndex.pas

[<pau...@us...>]

Revision: 784
          http://sourceforge.net/p/tdbf/code/784
Author:   paulenandrew
Date:     2022-02-10 13:53:47 +0000 (Thu, 10 Feb 2022)
Log Message:
-----------
Reduce visibility of test case

The class does not need to be in the interface.

Modified Paths:
--------------
    trunk/test/TestUniqueIndex.pas

Modified: trunk/test/TestUniqueIndex.pas
===================================================================
--- trunk/test/TestUniqueIndex.pas	2022-02-10 13:52:36 UTC (rev 783)
+++ trunk/test/TestUniqueIndex.pas	2022-02-10 13:53:47 UTC (rev 784)
@@ -2,11 +2,19 @@
 
 interface
 
+implementation
+
 uses
   DB,
+  SysUtils,
   dbf,
+  dbf_idxfile,
+  dbf_str,
   TestFramework;
 
+const
+  SDbfName = 'TEST';
+  
 type
   TTestCustomUniqueIndex = class(TTestCase)
   private
@@ -142,16 +150,6 @@
     procedure TestUpdateNoopAndUndelete;
   end;
 
-implementation
-
-uses
-  SysUtils,
-  dbf_idxfile,
-  dbf_str;
-
-const
-  SDbfName = 'TEST';
-  
 { TTestCustomUniqueIndex }
 
 procedure TTestCustomUniqueIndex.AddIndex;

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.