mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-10 23:20:29 +02:00
* Fix bug #0036361, use buffer when reading csv
git-svn-id: trunk@43641 -
This commit is contained in:
parent
6747654f7d
commit
db895fcebe
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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>
|
||||
|
@ -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;
|
||||
|
148
packages/fcl-base/tests/tccsvdocument.pp
Normal file
148
packages/fcl-base/tests/tccsvdocument.pp
Normal 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.
|
||||
|
@ -112,7 +112,6 @@ begin
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
RegisterTest(TTestCSVReadWrite);
|
||||
end.
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user