paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-23 08:29:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fcl-db/dbase: add memo, large string test cases

Browse Source 
git-svn-id: trunk@24160 -
This commit is contained in:
reiniero 2013-04-05 14:49:50 +00:00
parent 5c6b0d39e9
commit 83b88323d0
2 changed files with 60 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
packages/fcl-db/src/dbase/dbf_fields.pas
View File

@ -80,9 +80,9 @@ type
// Native dbf field type
property NativeFieldType: TDbfFieldType read FNativeFieldType write SetNativeFieldType;
property NullPosition: integer read FNullPosition write FNullPosition;
// Size in memory (not VCL/LCL)
// Size in memory
property Size: Integer read FSize write SetSize;
// Precision in dbase file (not VCL/LCL)
// Precision in dbase file
property Precision: Integer read FPrecision write SetPrecision;
property Required: Boolean read FRequired write FRequired;
end;
@ -259,7 +259,7 @@ begin
FIsLockField := false;
// convert VCL fieldtypes to native DBF fieldtypes
VCLToNative;
// for integer / float fields try fill in size/precision
// for integer / float fields try to fill in size/precision
if FSize = 0 then
SetDefaultSize
else
@ -311,7 +311,7 @@ end;
procedure TDbfFieldDef.SetNativeFieldType(lFieldType: tDbfFieldType);
begin
// get uppercase field type
// convert lowercase to uppercase
if (lFieldType >= 'a') and (lFieldType <= 'z') then
lFieldType := Chr(Ord(lFieldType)-32);
FNativeFieldType := lFieldType;

56
packages/fcl-db/tests/testspecifictdbf.pas
View File

@ -51,6 +51,10 @@ type
procedure TestFindNext;
// Tests findprior
procedure TestFindPrior;
// Tests writing and reading a memo field
procedure TestMemo;
// Tests string field with 254 characters (max for DBase IV)
procedure TestLargeString;
end;
@ -350,6 +354,58 @@ begin
CheckEquals(NumRecs-1,DS.fieldbyname('ID').asinteger);
end;
procedure TTestSpecificTDBF.TestMemo;
var
ds : TDBF;
begin
ds := TDBFAutoClean.Create(nil);
DS.FieldDefs.Add('ID',ftInteger);
DS.FieldDefs.Add('NAME',ftMemo);
DS.CreateTable;
DS.Open;
WriteReadbackTest(ds);
DS.Close;
ds.free;
end;
procedure TTestSpecificTDBF.TestLargeString;
var
ds : TDBF;
MaxStringSize: integer;
TestValue: string;
begin
ds := TDBFAutoClean.Create(nil);
if (ds.TableLevel>=25) then
// (Visual) FoxPro supports 32K
MaxStringSize:=32767
else
// Dbase III..V,7
MaxStringSize:=254;
TestValue:=StringOfChar('a',MaxStringSize);
DS.FieldDefs.Add('ID',ftInteger);
DS.FieldDefs.Add('NAME',ftString,254);
DS.CreateTable;
DS.Open;
// Write & readback test
DS.Append;
DS.FieldByName('ID').AsInteger := 1;
DS.FieldByName('NAME').AsString := TestValue;
DS.Post;
DS.first;
CheckEquals(1,DS.fieldbyname('ID').asinteger,'ID field must match record number');
// If test fails, let's count the number of "a"s instead so we can report that instead of printing out the entire string
CheckEquals(length(TestValue),length(DS.fieldbyname('NAME').AsString),'NAME field length must match test value length');
CheckEquals(TestValue,DS.fieldbyname('NAME').AsString,'NAME field must match test value');
DS.next;
CheckTrue(DS.EOF,'Dataset EOF must be true');
DS.Close;
ds.free;
end;
initialization