Browse Source

fcl-db/dbase:
* fix TestRecNo test
* dbtestframework: ignore currency test as tdbf uses bcd fields
* fix writing $1A EOF marker at end of dbf file
* fix: FoxPro does not allow null fields

git-svn-id: trunk@24187 -

reiniero 12 years ago
parent
commit
33f4bfd5b2

+ 2 - 1
packages/fcl-db/src/dbase/dbf.pas

@@ -17,9 +17,11 @@ uses
   dbf_fields,
   dbf_fields,
   dbf_pgfile,
   dbf_pgfile,
   dbf_idxfile;
   dbf_idxfile;
+{$ifndef fpc}
 // If you got a compilation error here or asking for dsgnintf.pas, then just add
 // If you got a compilation error here or asking for dsgnintf.pas, then just add
 // this file in your project:
 // this file in your project:
 // dsgnintf.pas in 'C: \Program Files\Borland\Delphi5\Source\Toolsapi\dsgnintf.pas'
 // dsgnintf.pas in 'C: \Program Files\Borland\Delphi5\Source\Toolsapi\dsgnintf.pas'
+{$endif}
 
 
 type
 type
 
 
@@ -1072,7 +1074,6 @@ begin
       ftString, ftBytes: FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, TempFieldDef.Size, false);
       ftString, ftBytes: FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, TempFieldDef.Size, false);
       ftBCD:
       ftBCD:
         begin
         begin
-          // todo: we should calculate number of digits after decimal place in some way, but how?
           FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, 0, false);;;
           FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, 0, false);;;
         end;
         end;
     else
     else

+ 6 - 4
packages/fcl-db/src/dbase/dbf_dbffile.pas

@@ -98,6 +98,7 @@ type
     procedure RepageIndex(AIndexFile: string);
     procedure RepageIndex(AIndexFile: string);
     procedure CompactIndex(AIndexFile: string);
     procedure CompactIndex(AIndexFile: string);
     function  Insert(Buffer: TRecordBuffer): integer;
     function  Insert(Buffer: TRecordBuffer): integer;
+    // Write relevant dbf head as well as EOF marker at end of file if necessary
     procedure WriteHeader; override;
     procedure WriteHeader; override;
     procedure ApplyAutoIncToBuffer(DestBuf: TRecordBuffer);     // dBase7 support. Writeback last next-autoinc value
     procedure ApplyAutoIncToBuffer(DestBuf: TRecordBuffer);     // dBase7 support. Writeback last next-autoinc value
     procedure FastPackTable;
     procedure FastPackTable;
@@ -821,7 +822,8 @@ begin
 
 
   // Write terminator at the end of the file, after the records:
   // Write terminator at the end of the file, after the records:
   EofTerminator := $1A;
   EofTerminator := $1A;
-  WriteBlock(@EofTerminator, 1, CalcPageOffset(RecordCount+1));
+  // We're using lDataHdr to make sure we have the latest/correct version
+  WriteBlock(@EofTerminator, 1, CalcPageOffset(lDataHdr.RecordCount+1));
 end;
 end;
 
 
 procedure TDbfFile.ConstructFieldDefs;
 procedure TDbfFile.ConstructFieldDefs;
@@ -884,8 +886,8 @@ begin
         lSize := lFieldDescIII.FieldSize;
         lSize := lFieldDescIII.FieldSize;
         lPrec := lFieldDescIII.FieldPrecision;
         lPrec := lFieldDescIII.FieldPrecision;
         lNativeFieldType := lFieldDescIII.FieldType;
         lNativeFieldType := lFieldDescIII.FieldType;
-        // todo: verify but AFAIU only Visual FoxPro supports null fields. Leave in FoxPro for now
-        lCanHoldNull := (FDbfVersion in [xFoxPro,xVisualFoxPro]) and
+        // todo: verify but AFAIU only Visual FoxPro supports null fields.
+        lCanHoldNull := (FDbfVersion in [xVisualFoxPro]) and
           ((lFieldDescIII.FoxProFlags and $2) <> 0) and
           ((lFieldDescIII.FoxProFlags and $2) <> 0) and
           (lFieldName <> '_NULLFLAGS');
           (lFieldName <> '_NULLFLAGS');
       end;
       end;
@@ -1770,7 +1772,7 @@ begin
   // copy field data to record buffer
   // copy field data to record buffer
   Dst := PChar(Dst) + TempFieldDef.Offset;
   Dst := PChar(Dst) + TempFieldDef.Offset;
   asciiContents := false;
   asciiContents := false;
-  // todo: check/add xvisualfoxpro autoincrement capability, null values, DateTime, Currency, and Double data types
+  // todo: check/add visualfoxpro autoincrement capability, null values, DateTime, Currency, and Double data types
   case TempFieldDef.NativeFieldType of
   case TempFieldDef.NativeFieldType of
     '+', 'I' {autoincrement, integer}:
     '+', 'I' {autoincrement, integer}:
       begin
       begin

+ 5 - 0
packages/fcl-db/src/dbase/dbf_pgfile.pas

@@ -80,10 +80,12 @@ type
     procedure UpdateBufferSize;
     procedure UpdateBufferSize;
     procedure RecalcPagesPerRecord;
     procedure RecalcPagesPerRecord;
     procedure ReadHeader;
     procedure ReadHeader;
+    // Write header to stream
     procedure FlushHeader;
     procedure FlushHeader;
     procedure FlushBuffer;
     procedure FlushBuffer;
     function  ReadChar: Byte;
     function  ReadChar: Byte;
     procedure WriteChar(c: Byte);
     procedure WriteChar(c: Byte);
+    // Check if position in cache. If not, enlarge cache.
     procedure CheckCachedSize(const APosition: Integer);
     procedure CheckCachedSize(const APosition: Integer);
     procedure SynchronizeBuffer(IntRecNum: Integer);
     procedure SynchronizeBuffer(IntRecNum: Integer);
     function  Read(Buffer: Pointer; ASize: Integer): Integer;
     function  Read(Buffer: Pointer; ASize: Integer): Integer;
@@ -316,6 +318,9 @@ end;
 
 
 function TPagedFile.CalcPageOffset(const PageNo: Integer): Integer;
 function TPagedFile.CalcPageOffset(const PageNo: Integer): Integer;
 begin
 begin
+  //todo: verify: this looks suspicious: check if we should uniformly use
+  // either FPageSize*PageNo as in the case without header offset
+  // or (FPageSize*(PageNo-1))
   if not FPageOffsetByHeader then
   if not FPageOffsetByHeader then
     Result := FPageSize * PageNo
     Result := FPageSize * PageNo
   else if PageNo = 0 then
   else if PageNo = 0 then

+ 2 - 0
packages/fcl-db/tests/testdbbasics.pas

@@ -2434,6 +2434,8 @@ var i          : byte;
     Fld        : TField;
     Fld        : TField;
 
 
 begin
 begin
+  if (uppercase(dbconnectorname)='DBF') then
+    Ignore('This test does not apply to TDDBF as they store currency in BCD fields.');
   TestfieldDefinition(ftCurrency,8,ds,Fld);
   TestfieldDefinition(ftCurrency,8,ds,Fld);
 
 
   for i := 0 to testValuesCount-1 do
   for i := 0 to testValuesCount-1 do