Browse Source

* fcl-db: clarified Dataset.txt
* fcl-db/dbase tests: fix for failing memo, string test
improvement in naming saved dbf files (if enabled)

git-svn-id: trunk@24525 -

reiniero 12 years ago
parent
commit
773ee3d21c

+ 5 - 5
packages/fcl-db/src/Dataset.txt

@@ -4,7 +4,7 @@ Contents
 + Fields system
 + Fields system
 + The buffers
 + The buffers
 + Dataset implementation
 + Dataset implementation
-+ Scalable Datasets
++ Switchable datasets
 
 
 ===============
 ===============
 General remarks
 General remarks
@@ -231,10 +231,10 @@ procedure SetFieldData(Field: TField; Buffer: Pointer); virtual; abstract;
 --------------------------------------------------------------------------
 --------------------------------------------------------------------------
 Move the data in associated with Field from Buffer to the active buffer.
 Move the data in associated with Field from Buffer to the active buffer.
 
 
-=================
-Scalable datasets
-=================
-In order to have Scalable database access, the concept of TDatabase and
+===================
+Switchable datasets
+===================
+In order to have flexible database access, the concept of TDatabase and
 TDBDataset is introduced. The idea is that, in a visual IDE, the change
 TDBDataset is introduced. The idea is that, in a visual IDE, the change
 from one database to another is achieved by simply removing one TDatabase
 from one database to another is achieved by simply removing one TDatabase
 descendent (Say, TMySqlDatabase) with another (Say, TPostGreSQLDatabase)
 descendent (Say, TMySqlDatabase) with another (Say, TPostGreSQLDatabase)

+ 60 - 11
packages/fcl-db/tests/dbftoolsunit.pas

@@ -2,14 +2,13 @@ unit DBFToolsUnit;
 
 
 { Sets up dbf datasets for testing
 { Sets up dbf datasets for testing
 Tests expect Get*Dataset to return a dataset with structure and test data, but closed.
 Tests expect Get*Dataset to return a dataset with structure and test data, but closed.
-Because of this, we use file-backed dbfs instead of memory backed dbfs
 }
 }
 
 
 {$IFDEF FPC}
 {$IFDEF FPC}
   {$mode objfpc}{$H+}
   {$mode objfpc}{$H+}
 {$ENDIF}
 {$ENDIF}
 
 
-// If defined, do not delete the dbf files when done but print out location to stdout:
+// If defined, save the dbf files when done and print out location to stdout:
 {.$DEFINE KEEPDBFFILES}
 {.$DEFINE KEEPDBFFILES}
 
 
 interface
 interface
@@ -42,6 +41,8 @@ type
   TDBFAutoClean = class(TDBF)
   TDBFAutoClean = class(TDBF)
   private
   private
     FBackingStream: TMemoryStream;
     FBackingStream: TMemoryStream;
+    FIndexBackingStream: TMemoryStream;
+    FMemoBackingStream: TMemoryStream;
     FCreatedBy: string;
     FCreatedBy: string;
   public
   public
     // Keeps track of which function created the dataset, useful for troubleshooting
     // Keeps track of which function created the dataset, useful for troubleshooting
@@ -68,6 +69,41 @@ implementation
 uses
 uses
   FmtBCD;
   FmtBCD;
 
 
+function GetNewTempDBFName: string;
+// Scans temp directory for dbf names and adds
+var
+  Res: TSearchRec;
+  Path, Name: string;
+  FileAttr: LongInt;
+  Attr,NextFileNo: Integer;
+begin
+  NextFileNo:=0;
+  Attr := faAnyFile;
+  if FindFirst(IncludeTrailingPathDelimiter(GetTempDir)+'*.dbf', Attr, Res) = 0 then
+  begin
+    Path := GetTempDir;
+    repeat
+       Name := ConcatPaths([Path, Res.Name]);
+       FileAttr := FileGetAttr(Name);
+       if FileAttr and faDirectory = 0 then
+       begin
+         // Capture alphabetically latest name
+         try
+           //... only if it is numeric
+           if strtoint(ChangeFileExt(Res.Name,''))>NextFileNo then
+             NextFileNo:=strtoint(ChangeFileExt(Res.Name,''));
+         except
+           // apparently not numeric
+         end;
+       end
+    until FindNext(Res) <> 0;
+  end;
+  FindClose(Res);
+  // now we now the latest file, add 1, and paste the temp directory in front of it
+  NextFileNo:=NextFileNo+1;
+  Result:=IncludeTrailingPathDelimiter(GetTempDir)+IntToStr(NextFileNo)+'.DBF';
+end;
+
 { TDBFAutoClean }
 { TDBFAutoClean }
 
 
 function TDBFAutoClean.UserRequestedTableLevel: integer;
 function TDBFAutoClean.UserRequestedTableLevel: integer;
@@ -90,13 +126,18 @@ end;
 
 
 constructor TDBFAutoClean.Create;
 constructor TDBFAutoClean.Create;
 begin
 begin
+  // Create storage for data:
   FBackingStream:=TMemoryStream.Create;
   FBackingStream:=TMemoryStream.Create;
-  // Create a unique name:
-  TableName := FormatDateTime('hhnnssz',Now())+'/'+inttostr(random(32767));
+  FIndexBackingStream:=TMemoryStream.Create;
+  FMemoBackingStream:=TMemoryStream.Create;
+  // Create a unique name (within the 10 character DBIII limit):
+  TableName := FormatDateTime('hhnnssz',Now())+'_'+inttostr(random(99));
   TableLevel := UserRequestedTableLevel;
   TableLevel := UserRequestedTableLevel;
   Storage:=stoMemory;
   Storage:=stoMemory;
   UserStream:=FBackingStream;
   UserStream:=FBackingStream;
-  CreateTable; //write out header to disk
+  UserIndexStream:=FIndexBackingStream;
+  UserMemoStream:=FMemoBackingStream;
+  CreateTable; //this will also write out the dbf header to disk/stream
 end;
 end;
 
 
 constructor TDBFAutoClean.Create(AOwner: TComponent);
 constructor TDBFAutoClean.Create(AOwner: TComponent);
@@ -113,12 +154,18 @@ var
 begin
 begin
   {$IFDEF KEEPDBFFILES}
   {$IFDEF KEEPDBFFILES}
   Close;
   Close;
-  FileName := GetTempFileName;
+  FileName := GetNewTempDBFName;
   FBackingStream.SaveToFile(FileName);
   FBackingStream.SaveToFile(FileName);
+  FIndexBackingStream.SaveToFile(ChangeFileExt(FileName, '.mdx'));
+  if Self.TableLevel in [TDBF_TABLELEVEL_FOXPRO, TDBF_TABLELEVEL_VISUALFOXPRO] then
+    FMemoBackingStream.SaveToFile(ChangeFileExt(FileName, '.fpt'))
+  else
+    FMemoBackingStream.SaveToFile(ChangeFileExt(FileName, '.dbt'));
   writeln('TDBFAutoClean: file created by ',CreatedBy,' left file: ',FileName);
   writeln('TDBFAutoClean: file created by ',CreatedBy,' left file: ',FileName);
   {$ENDIF}
   {$ENDIF}
   inherited Destroy;
   inherited Destroy;
   FBackingStream.Free;
   FBackingStream.Free;
+  FIndexBackingStream.Free;
 end;
 end;
 
 
 
 
@@ -162,10 +209,10 @@ begin
     FieldDefs.Add('FWORD', ftWord);
     FieldDefs.Add('FWORD', ftWord);
     FieldDefs.Add('FBOOLEAN', ftBoolean);
     FieldDefs.Add('FBOOLEAN', ftBoolean);
     FieldDefs.Add('FFLOAT', ftFloat);
     FieldDefs.Add('FFLOAT', ftFloat);
-    // Field types only available in newer versions
-    if (Result as TDBF).TableLevel >= 25 then
+    // Field types only available in (Visual) FoxPro
+    if (Result as TDBF).TableLevel >= TDBF_TABLELEVEL_FOXPRO then
       FieldDefs.Add('FCURRENCY', ftCurrency);
       FieldDefs.Add('FCURRENCY', ftCurrency);
-    if (Result as TDBF).TableLevel >= 25 then
+    if (Result as TDBF).TableLevel >= TDBF_TABLELEVEL_FOXPRO then
       FieldDefs.Add('FBCD', ftBCD);
       FieldDefs.Add('FBCD', ftBCD);
     FieldDefs.Add('FDATE', ftDate);
     FieldDefs.Add('FDATE', ftDate);
     FieldDefs.Add('FDATETIME', ftDateTime);
     FieldDefs.Add('FDATETIME', ftDateTime);
@@ -182,13 +229,15 @@ begin
       FieldByName('FINTEGER').AsInteger := testIntValues[i];
       FieldByName('FINTEGER').AsInteger := testIntValues[i];
       FieldByName('FBOOLEAN').AsBoolean := testBooleanValues[i];
       FieldByName('FBOOLEAN').AsBoolean := testBooleanValues[i];
       FieldByName('FFLOAT').AsFloat := testFloatValues[i];
       FieldByName('FFLOAT').AsFloat := testFloatValues[i];
-      if (Result as TDBF).TableLevel >= 25 then
+      if (Result as TDBF).TableLevel >= TDBF_TABLELEVEL_FOXPRO then
         FieldByName('FCURRENCY').AsCurrency := testCurrencyValues[i];
         FieldByName('FCURRENCY').AsCurrency := testCurrencyValues[i];
       // work around missing TBCDField.AsBCD:
       // work around missing TBCDField.AsBCD:
-      if (Result as TDBF).TableLevel >= 25 then
+      if (Result as TDBF).TableLevel >= TDBF_TABLELEVEL_FOXPRO then
         FieldByName('FBCD').AsBCD := StrToBCD(testFmtBCDValues[i],Self.FormatSettings);
         FieldByName('FBCD').AsBCD := StrToBCD(testFmtBCDValues[i],Self.FormatSettings);
       FieldByName('FDATE').AsDateTime := StrToDate(testDateValues[i], 'yyyy/mm/dd', '-');
       FieldByName('FDATE').AsDateTime := StrToDate(testDateValues[i], 'yyyy/mm/dd', '-');
+      FieldByName('FDATETIME').AsDateTime := StrToDateTime(testValues[ftDateTime,i], Self.FormatSettings);
       FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
       FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
+      FieldByName('FMEMO').AsString := testStringValues[i];
       Post;
       Post;
     end;
     end;
     Close;
     Close;

+ 6 - 1
packages/fcl-db/tests/testdbbasics.pas

@@ -2316,6 +2316,8 @@ var i          : byte;
     Fld        : TField;
     Fld        : TField;
 
 
 begin
 begin
+  if (uppercase(dbconnectorname)='DBF') then
+    Ignore('TDBF Smallint support only from -999 to 9999');
   TestfieldDefinition(ftSmallint,2,ds,Fld);
   TestfieldDefinition(ftSmallint,2,ds,Fld);
 
 
   for i := 0 to testValuesCount-1 do
   for i := 0 to testValuesCount-1 do
@@ -2338,7 +2340,10 @@ begin
 
 
   for i := 0 to testValuesCount-1 do
   for i := 0 to testValuesCount-1 do
     begin
     begin
-    CheckEquals(testStringValues[i],Fld.AsString);
+    if (uppercase(dbconnectorname)<>'DBF') then
+      CheckEquals(testStringValues[i],Fld.AsString)
+    else {DBF right-trims spaces in string fields }
+      CheckEquals(TrimRight(testStringValues[i]),Fld.AsString);
     ds.Next;
     ds.Next;
     end;
     end;
   ds.close;
   ds.close;