* Fix bug #0036361, use buffer when reading csv

git-svn-id: trunk@43641 -
This commit is contained in:
michael 2019-12-05 10:43:02 +00:00
parent 6747654f7d
commit db895fcebe
6 changed files with 175 additions and 8 deletions

1
.gitattributes vendored
View File

@ -3150,6 +3150,7 @@ packages/fcl-base/src/wtex.pp svneol=native#text/plain
packages/fcl-base/tests/fclbase-unittests.lpi svneol=native#text/plain
packages/fcl-base/tests/fclbase-unittests.pp svneol=native#text/plain
packages/fcl-base/tests/tcbufferedfilestream.pp svneol=native#text/plain
packages/fcl-base/tests/tccsvdocument.pp svneol=native#text/plain
packages/fcl-base/tests/tccsvreadwrite.pp svneol=native#text/plain
packages/fcl-base/tests/tchashlist.pp svneol=native#text/plain
packages/fcl-base/tests/tcinifile.pp svneol=native#text/plain

View File

@ -44,7 +44,7 @@ unit csvdocument;
interface
uses
Classes, SysUtils, Contnrs, csvreadwrite;
Classes, SysUtils, Contnrs, csvreadwrite, bufstream;
type
TCSVChar = csvreadwrite.TCSVChar;
@ -73,13 +73,15 @@ type
function GetColCount(ARow: Integer): Integer;
function GetMaxColCount: Integer;
public
constructor Create;
constructor Create; override;
destructor Destroy; override;
// Input/output
// Load document from file AFileName
procedure LoadFromFile(const AFilename: String);
// Load document from file AFileName. Use default buffer size of 16kb
procedure LoadFromFile(const AFilename: String); overload;
// Load document from file AFileName. Buffer size is in Kb.
procedure LoadFromFile(const AFilename: String; ABufferSize : Integer); overload;
// Load document from stream AStream
procedure LoadFromStream(AStream: TStream);
// Save document to file AFilename
@ -392,14 +394,27 @@ begin
end;
procedure TCSVDocument.LoadFromFile(const AFilename: String);
begin
LoadFromFile(aFileName,DefaultBufferCapacity);
end;
procedure TCSVDocument.LoadFromFile(const AFilename: String; ABufferSize : Integer);
var
FileStream: TFileStream;
B : TBufStream;
begin
B:=Nil;
FileStream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone);
try
LoadFromStream(FileStream);
B:=TReadBufStream.Create(FileStream,aBufferSize);
B.SourceOwner:=True;
FileStream:=Nil;
LoadFromStream(B);
finally
FileStream.Free;
B.Free;
end;
end;

View File

@ -36,7 +36,7 @@
</Mode0>
</Modes>
</RunParams>
<Units Count="7">
<Units Count="8">
<Unit0>
<Filename Value="fclbase-unittests.pp"/>
<IsPartOfProject Value="True"/>
@ -65,6 +65,10 @@
<Filename Value="tcbufferedfilestream.pp"/>
<IsPartOfProject Value="True"/>
</Unit6>
<Unit7>
<Filename Value="tccsvdocument.pp"/>
<IsPartOfProject Value="True"/>
</Unit7>
</Units>
</ProjectOptions>
<CompilerOptions>

View File

@ -4,7 +4,7 @@ program fclbase_unittests;
uses
Classes, consoletestrunner, tests_fptemplate, tchashlist,
testexprpars, tcmaskutils, tcinifile, tccsvreadwrite,tcbufferedfilestream;
testexprpars, tcmaskutils, tcinifile, tccsvreadwrite,tcbufferedfilestream, tccsvdocument;
var
Application: TTestRunner;

View File

@ -0,0 +1,148 @@
unit tccsvdocument;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry, csvdocument;
Type
{ TTestCSVDocument }
TTestCSVDocument = Class(TTestCase)
private
FDoc: TCSVDocument;
procedure RemoveTestFile;
function StripQuotes(S: String): string;
procedure TestTestFile;
Public
Procedure SetUp; override;
Procedure TearDown; override;
Procedure CreateTestFile;
Property Doc : TCSVDocument Read FDoc;
Published
Procedure TestEmpty;
Procedure TestRead;
end;
implementation
Const
TestFileName = 'test.csv';
{ TTestCSVDocument }
procedure TTestCSVDocument.SetUp;
begin
FDoc:=TCSVDocument.Create;
Inherited;
end;
procedure TTestCSVDocument.TearDown;
begin
RemoveTestFile;
FreeAndNil(FDoc);
Inherited;
end;
procedure TTestCSVDocument.RemoveTestFile;
begin
If FileExists(TestFileName) then
AssertTrue('Deleting test file',DeleteFile(TestFileName));
end;
Const
ColCount = 3;
RowCount = 4;
Type
TRow = Array[0..ColCount-1] of string;
TCells = Array[0..RowCount-1] of TRow;
Const
Cells : TCells = (
('a','b','c'),
('1','"one"','1.1'),
('2','"two"','2.2'),
('3','"three"','3.3')
);
procedure TTestCSVDocument.CreateTestFile;
Var
L : TStringList;
R,C : Integer;
S : String;
begin
L:=TStringList.Create;
try
for R:=0 to RowCount-1 do
begin
S:='';
for C:=0 to ColCount-1 do
begin
if S<>'' then
S:=S+',';
S:=S+Cells[R,C];
end;
L.Add(S);
end;
L.SaveToFile(TestFileName);
finally
L.Free;
end;
end;
procedure TTestCSVDocument.TestEmpty;
begin
AssertNotNull('Have document',Doc);
end;
Function TTestCSVDocument.StripQuotes(S : String) : string;
Var
L : integer;
begin
Result:=S;
L:=Length(Result);
if (L>1) then
if (Result[1]='"') and (Result[L]='"') then
Result:=Copy(Result,2,L-2);
end;
procedure TTestCSVDocument.TestTestFile;
Var
R,C : Integer;
begin
AssertEquals('Row count',RowCount,Doc.RowCount);
For R:=0 to RowCount-1 do
For C:=0 to ColCount-1 do
begin
AssertEquals('Col['+IntToStr(R)+'] count',ColCount,Doc.ColCount[R]);
AssertEquals(Format('Cell[%d,%d]',[C,R]),StripQuotes(Cells[R,C]),Doc.Cells[C,R]);
end;
end;
procedure TTestCSVDocument.TestRead;
begin
CreateTestFile;
Doc.LoadFromFile(TestFileName);
TestTestFile;
end;
initialization
RegisterTest(TTestCSVDocument);
end.

View File

@ -112,7 +112,6 @@ begin
end;
initialization
RegisterTest(TTestCSVReadWrite);
end.