paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-13 14:49:47 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Make sure open/close use same options in CSV close/open writing

Browse Source 
git-svn-id: trunk@43648 -
This commit is contained in:
michael 2019-12-05 16:16:08 +00:00
parent b82eaf4ce2
commit 694888e7c8
3 changed files with 48 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
packages/fcl-db/src/base/bufdataset.pas
View File

@ -567,6 +567,7 @@ type
class function DefaultReadFileFormat : TDataPacketFormat; virtual;
class function DefaultWriteFileFormat : TDataPacketFormat; virtual;
class function DefaultPacketClass : TDataPacketReaderClass ; virtual;
function CreateDefaultPacketReader(aStream : TStream): TDataPacketReader ; virtual;
procedure SetPacketRecords(aValue : integer); virtual;
procedure SetRecNo(Value: Longint); override;
function GetRecNo: Longint; override;
@ -2277,6 +2278,11 @@ begin
Result:=TFpcBinaryDatapacketReader;
end;
function TCustomBufDataset.CreateDefaultPacketReader(aStream : TStream): TDataPacketReader;
begin
Result:=DefaultPacketClass.Create(Self,aStream);
end;
procedure TCustomBufDataset.SetIndexFieldNames(const AValue: String);
@ -3085,7 +3091,7 @@ begin
if (Fmt=dfDefault) then
fmt:=DefaultReadFileFormat;
if fmt=dfDefault then
APacketReader := DefaultPacketClass.Create(Self, AStream)
APacketReader := CreateDefaultPacketReader(AStream)
else if GetRegisterDatapacketReader(AStream, fmt, APacketReaderReg) then
APacketReader := APacketReaderReg.ReaderClass.Create(Self, AStream)
else if TFpcBinaryDatapacketReader.RecognizeStream(AStream) then
@ -3466,7 +3472,7 @@ begin
if Fmt=dfDefault then
fmt:=DefaultWriteFileFormat;
if fmt=dfDefault then
APacketWriter := DefaultPacketClass.Create(Self, AStream)
APacketWriter := CreateDefaultPacketReader(AStream)
else if GetRegisterDatapacketReader(Nil,fmt,APacketReaderReg) then
APacketWriter := APacketReaderReg.ReaderClass.Create(Self, AStream)
else if fmt = dfBinary then

10
packages/fcl-db/src/base/csvdataset.pp
View File

@ -98,6 +98,7 @@ Type
class function DefaultReadFileFormat : TDataPacketFormat; override;
class function DefaultWriteFileFormat : TDataPacketFormat; override;
class function DefaultPacketClass : TDataPacketReaderClass ; override;
function CreateDefaultPacketReader(aStream : TStream): TDataPacketReader ; override;
function GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader; override;
procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); override;
procedure InternalInitFieldDefs; override;
@ -323,11 +324,16 @@ begin
Result:=TCSVDataPacketReader;
end;
function TCustomCSVDataset.CreateDefaultPacketReader(aStream: TStream): TDataPacketReader;
begin
Result:=TCSVDataPacketReader.Create(Self,AStream,FCSVOptions)
end;
function TCustomCSVDataset.GetPacketReader(const Format: TDataPacketFormat;
const AStream: TStream): TDataPacketReader;
begin
If (Format in [dfAny,dfDefault]) then
Result:=TCSVDataPacketReader.Create(Self,AStream,FCSVOptions)
Result:=CreateDefaultPacketReader(AStream)
else
Result:=Inherited GetPacketReader(Format,AStream);
end;
@ -351,6 +357,8 @@ end;
destructor TCustomCSVDataset.Destroy;
begin
// We must close here, before freeing the options.
Active:=False;
FreeAndNil(FCSVOptions);
inherited Destroy;
end;

38
packages/fcl-db/tests/tccsvdataset.pp
View File

@ -15,7 +15,7 @@ type
private
FCSVDataset: TCSVDataset;
// Load CSVDataset from CSV stream containing lines
procedure DoOpenClose;
procedure DoOpenClose(FieldNames: Boolean);
Procedure LoadFromLines(Const Lines: Array of string);
// Save CSVDataset to CSV stream, transform to lines
Procedure SaveToLines(Const Lines: TStrings);
@ -48,7 +48,8 @@ type
Procedure TestLoadPriorFieldDefsNoFieldNamesWrongCount;
Procedure TestLoadPriorFieldDefsFieldNamesWrongCount;
Procedure TestLoadPriorFieldDefsFieldNamesWrongNames;
Procedure TestOpenCloseCycle;
Procedure TestOpenCloseCycle1;
Procedure TestOpenCloseCycle2;
end;
implementation
@ -426,13 +427,13 @@ end;
const
FILENAME = 'test.dat';
procedure TTestCSVDataset.DoOpenClose;
procedure TTestCSVDataset.DoOpenClose(FieldNames : Boolean);
begin
CSVDataset.FileName := FILENAME;
With CSVDataset do
begin
CSVOptions.FirstLineAsFieldNames := True;
CSVOptions.FirstLineAsFieldNames := FieldNames;
CSVOptions.DefaultFieldLength := 255;
CSVOptions.Delimiter := ',';
CSVOptions.QuoteChar := '"';
@ -482,22 +483,24 @@ begin
FieldbyName('Birthdate').AsDateTime := EncodeDate(1982, 12, 17);
Post;
end;
// Would be 4 if first line misinterpreted
AssertEquals('RecordCount',3,CSVDataset.RecordCount);
// This will write the file;
CSVDataset.Close;
end;
procedure TTestCSVDataset.TestOpenCloseCycle;
procedure TTestCSVDataset.TestOpenCloseCycle1;
begin
if FileExists(FileName) then
AssertTrue('Delete before',DeleteFile(FileName));
try
// This will create the file
DoOpenClose;
DoOpenClose(True);
// Recreate to be sure
FreeAndNil(FCSVDataset);
FCSVDataset:=TCSVDataset.Create(Nil);
FCSVDataset.Name:='DS';
DoOpenClose;
DoOpenClose(True);
except
On E : Exception do
Fail('Failed using exception %s : %s',[E.ClassName,E.Message]);
@ -506,6 +509,27 @@ begin
AssertTrue('Delete after',DeleteFile(FileName));
end;
procedure TTestCSVDataset.TestOpenCloseCycle2;
begin
if FileExists(FileName) then
AssertTrue('Delete before',DeleteFile(FileName));
try
// This will create the file
DoOpenClose(False);
// Recreate to be sure
FreeAndNil(FCSVDataset);
FCSVDataset:=TCSVDataset.Create(Nil);
FCSVDataset.Name:='DS';
DoOpenClose(False);
except
On E : Exception do
Fail('Failed using exception %s : %s',[E.ClassName,E.Message]);
end;
if FileExists(FileName) then
AssertTrue('Delete after',DeleteFile(FileName));
end;
procedure TTestCSVDataset.SetUp;
begin
FCSVDataset:=TCSVDataset.Create(Nil);