paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-01 04:19:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix stripping of final delimiters (bug 0019361)

Browse Source 
git-svn-id: trunk@30421 -
This commit is contained in:
michael 2015-04-04 13:48:48 +00:00
parent 7f4c2c0cc2
commit 1b540a6e8c
2 changed files with 229 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
packages/fcl-db/src/sdf/sdfdata.pp
View File

@ -258,11 +258,14 @@ type
private
FDelimiter : Char;
FFirstLineAsSchema : Boolean;
FFMultiLine :Boolean;
FFMultiLine : Boolean;
FStripTrailingDelimiters : Boolean;
procedure DoStripTrailingDelimiters(var S: String; All : Boolean);
procedure SetMultiLine(const Value: Boolean);
procedure SetFirstLineAsSchema(Value : Boolean);
procedure SetDelimiter(Value : Char);
protected
function GetRecordCount: Integer; override;
procedure InternalInitFieldDefs; override;
function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean)
: TGetResult; override;
@ -274,6 +277,8 @@ type
property AllowMultiLine: Boolean read FFMultiLine write SetMultiLine default True; //Whether or not to allow fields containing CR and/or LF
property Delimiter: Char read FDelimiter write SetDelimiter;
property FirstLineAsSchema: Boolean read FFirstLineAsSchema write SetFirstLineAsSchema;
// Set this to True if you want to strip all last delimiters
Property StripTrailingDelimiters : Boolean Read FStripTrailingDelimiters Write FStripTrailingDelimiters;
end;
procedure Register;
@ -859,6 +864,8 @@ end;
procedure TSdfDataSet.InternalInitFieldDefs;
var
pStart, pEnd, len : Integer;
SL,Fn : String;
begin
if not IsCursorOpen then
exit;
@ -875,43 +882,45 @@ begin
else if (Schema.Count = 0) or (FirstLineAsSchema) then
begin
Schema.Clear;
len := Length(FData[0]);
SL:=FData[0];
if StripTrailingDelimiters then
DoStripTrailingDelimiters(SL,True);
len := Length(SL);
pEnd := 1;
repeat
while (pEnd <= len) and (FData[0][pEnd] in [#1..' ']) do
while (pEnd<=len) and (SL[pEnd] in [#1..' ']) do
Inc(pEnd);
if (pEnd > len) then
break;
pStart := pEnd;
if (FData[0][pStart] = '"') then
begin
if (SL[pStart] = '"') then
begin
repeat
Inc(pEnd);
until (pEnd > len) or (FData[0][pEnd] = '"');
if (FData[0][pEnd] = '"') then
until (pEnd > len) or (SL[pEnd] = '"');
if (SL[pEnd] = '"') then
Inc(pStart);
end
end
else
while (pEnd <= len) and (FData[0][pEnd] <> Delimiter) do
Inc(pEnd);
while (pEnd<=len) and (SL[pEnd]<>Delimiter) do
Inc(pEnd);
if (FirstLineAsSchema) then
Schema.Add(Copy(FData[0], pStart, pEnd - pStart))
FN:=Copy(SL,pStart,pEnd - pStart)
else
Schema.Add(Format('Field%d', [Schema.Count + 1]));
if (FData[0][pEnd] = '"') then
while (pEnd <= len) and (FData[0][pEnd] <> Delimiter) do
FN:='';
if (FN='') then // Pend-PStart=0 is possible: a,b,,c
FN:=Format('Field%d', [Schema.Count + 1]);
Schema.Add(FN);
if (Pend<=Len) and (SL[pEnd] = '"') then
while (pEnd <= len) and (SL[pEnd] <> Delimiter) do
Inc(pEnd);
if (FData[0][pEnd] = Delimiter) then
Inc(pEnd);
// if (SL[pEnd]=Delimiter) then
Inc(pEnd);
until (pEnd > len);
// Special case: f1,f2, is 3 fields, last unnamed.
if (Len>0) and (SL[Len]=Delimiter) then
Schema.Add(Format('Field%d', [Schema.Count + 1]));
end;
inherited;
end;
@ -1092,12 +1101,22 @@ begin
end;
Result := Result + Str + FDelimiter;
end;
p := Length(Result);
while (p > 0) and (Result[p] = FDelimiter) do
begin
System.Delete(Result, p, 1);
DoStripTrailingDelimiters(Result,StripTrailingDelimiters)
end;
procedure TSdfDataSet.DoStripTrailingDelimiters(var S: String; All: Boolean);
var
L,P : integer;
begin
// Write('S "',S,'" -> "');
L:=Length(S);
P:=L;
while (p>0) and (S[p]=FDelimiter) and (All or (P=L)) do
Dec(p);
end;
if P<L then
S:=Copy(S,1,P);
// Writeln(s,'"');
end;
procedure TSdfDataSet.SetDelimiter(Value : Char);
@ -1106,6 +1125,13 @@ begin
FDelimiter := Value;
end;
function TSdfDataSet.GetRecordCount: Integer;
begin
Result:=Inherited GetRecordCount;
If Result>0 then
Result:=Result-Ord(FirstLineAsSchema);
end;
procedure TSdfDataSet.SetFirstLineAsSchema(Value : Boolean);
begin
CheckInactive;

203
packages/fcl-db/tests/tcsdfdata.pp
View File

@ -14,6 +14,8 @@ type
{ Ttestsdfspecific }
Ttestsdfspecific = class(Ttestcase)
private
procedure TestEmptyFieldContents;
protected
TestDataset: TSDFDataset;
procedure Setup; override;
@ -31,6 +33,10 @@ type
procedure TestInputOurFormat;
}
procedure TestDelimitedTextOutput;
procedure TestEmptyHeader;
Procedure TestEmptyHeader2;
Procedure TestEmptyHeaderStripTrailingDelimiters;
Procedure TestStripTrailingDelimiters;
end;
implementation
@ -260,45 +266,184 @@ const
Value5='multi'+#13+#10+'line';
Value6='Delimiter,and;done';
Value7='Some "random" quotes';
var
Var
F : Text;
FileStrings: TStringList;
OneRecord: TStringList;
begin
TestDataset.Close;
TestDataset.AllowMultiLine:=true;
TestDataset.FirstLineAsSchema:=true;
if FileExists(OutputFileName) then DeleteFile(OutputFileName);
FileStrings:=TStringList.Create;
OneRecord:=TStringList.Create;
try
FileStrings.Add('Field1,Field2,Field3,Field4,Field5,Field6,Field7');
OneRecord.Add(Value1);
OneRecord.Add(Value2);
OneRecord.Add(Value3);
OneRecord.Add(Value4);
OneRecord.Add(Value5);
OneRecord.Add(Value6);
OneRecord.Add(Value7);
OneRecord.Delimiter:=',';
OneRecord.QuoteChar:='"';
OneRecord.StrictDelimiter:=true;
FileStrings.Add(OneRecord.DelimitedText);
FileStrings.SaveToFile(OutputFileName);
finally
FileStrings.Free;
OneRecord.Free;
end;
Assign(F,OutputFileName);
Rewrite(F);
Writeln(F,'Field1,Field2,Field3,Field4,Field5,Field6,Field7');
Writeln(F,'"Delimiter,""and"";quote","J""T""",Just a long line,"Just a quoted long line","multi');
Writeln(F,'line","Delimiter,and;done","Some ""random"" quotes"');
Close(F);
// Load our dataset
TestDataset.FileName:=OutputFileName;
TestDataset.Open;
// AssertEquals('Field count',7,TEstDataset.Fielddefs.Count);
// AssertEquals('Record count',1,TEstDataset.RecordCount);
TestDataset.First;
AssertEquals(Value1, TestDataSet.Fields[0].AsString);
AssertEquals(Value2, TestDataSet.Fields[1].AsString);
AssertEquals(Value3, TestDataSet.Fields[2].AsString);
AssertEquals(Value4, TestDataSet.Fields[3].AsString);
AssertEquals(Value5, TestDataSet.Fields[4].AsString);
AssertEquals(Value6, TestDataSet.Fields[5].AsString);
AssertEquals(Value7, TestDataSet.Fields[6].AsString);
AssertEquals('Field1',Value1, TestDataSet.Fields[0].AsString);
AssertEquals('Field2',Value2, TestDataSet.Fields[1].AsString);
AssertEquals('Field3',Value3, TestDataSet.Fields[2].AsString);
AssertEquals('Field4',Value4, TestDataSet.Fields[3].AsString);
AssertEquals('Field5',Value5, TestDataSet.Fields[4].AsString);
AssertEquals('Field6',Value6, TestDataSet.Fields[5].AsString);
AssertEquals('Field7',Value7, TestDataSet.Fields[6].AsString);
end;
procedure Ttestsdfspecific.TestEmptyHeader;
const
OutputFileName='delim.csv';
Var
F : Text;
begin
TestDataset.Close;
TestDataset.AllowMultiLine:=False;
if FileExists(OutputFileName) then DeleteFile(OutputFileName);
Assign(F,OutputFileName);
Rewrite(F);
Writeln(F,'1;2;3;;5');
Close(F);
TestDataset.FirstLineAsSchema:=True;
TestDataset.Delimiter := ';';
TestDataset.FileName:=OutputFileName;
TestDataset.Open;
AssertEquals('Correct field count',5,TestDataset.FieldDefs.Count);
end;
procedure Ttestsdfspecific.TestEmptyHeader2;
const
OutputFileName='delim.csv';
Var
F : Text;
S : String;
begin
TestDataset.Close;
TestDataset.AllowMultiLine:=False;
if FileExists(OutputFileName) then DeleteFile(OutputFileName);
Assign(F,OutputFileName);
Rewrite(F);
Writeln(F,'value1;value2;;;');
Close(F);
TestDataset.FirstLineAsSchema:=False;
TestDataset.Delimiter := ';';
TestDataset.FileName:=OutputFileName;
TestDataset.Schema.Clear;
TestDataset.Open;
AssertEquals('Correct field count',5,TestDataset.FieldDefs.Count);
TestDataset.Edit;
TestDataset.Fields[0].AsString:='Value1';
TestDataset.Post;
TestDataset.Close;
Assign(F,OutputFileName);
Reset(F);
ReadLn(F,S);
Close(F);
AssertEquals('No data lost','Value1;value2;;;',S);
end;
procedure Ttestsdfspecific.TestEmptyHeaderStripTrailingDelimiters;
const
OutputFileName='delim.csv';
Var
F : Text;
S : String;
begin
TestDataset.Close;
TestDataset.AllowMultiLine:=False;
if FileExists(OutputFileName) then DeleteFile(OutputFileName);
Assign(F,OutputFileName);
Rewrite(F);
Writeln(F,'value1;value2;;;');
Close(F);
TestDataset.StripTrailingDelimiters:=True;
TestDataset.FirstLineAsSchema:=False;
TestDataset.Delimiter := ';';
TestDataset.FileName:=OutputFileName;
TestDataset.Schema.Clear;
TestDataset.Open;
AssertEquals('Correct field count',2,TestDataset.FieldDefs.Count);
TestDataset.Edit;
TestDataset.Fields[0].AsString:='Value1';
TestDataset.Post;
TestDataset.Close;
Assign(F,OutputFileName);
Reset(F);
ReadLn(F,S);
Close(F);
AssertEquals('No data lost','Value1;value2',S);
end;
procedure Ttestsdfspecific.TestStripTrailingDelimiters;
const
OutputFileName='delim.csv';
Var
F : Text;
S,S2 : String;
begin
TestDataset.Close;
TestDataset.AllowMultiLine:=False;
if FileExists(OutputFileName) then DeleteFile(OutputFileName);
Assign(F,OutputFileName);
Rewrite(F);
Writeln(F,'value1;value2;;;');
Writeln(F,'value1;value2;;;');
Close(F);
TestDataset.StripTrailingDelimiters:=True;
TestDataset.FirstLineAsSchema:=False;
TestDataset.Delimiter := ';';
TestDataset.FileName:=OutputFileName;
TestDataset.Schema.Clear;
TestDataset.Open;
AssertEquals('Correct field count',2,TestDataset.FieldDefs.Count);
TestDataset.Edit;
TestDataset.Fields[0].AsString:='Value1';
TestDataset.Post;
TestDataset.Close;
Assign(F,OutputFileName);
Reset(F);
ReadLn(F,S);
ReadLn(F,S2);
Close(F);
AssertEquals('Headers lost','Value1;value2',S);
AssertEquals('Data lost','Value1;value2',S);
end;
procedure Ttestsdfspecific.TestEmptyFieldContents;
const
OutputFileName='delim.csv';
Var
F : Text;
begin
TestDataset.Close;
TestDataset.AllowMultiLine:=False;
if FileExists(OutputFileName) then DeleteFile(OutputFileName);
Assign(F,OutputFileName);
Rewrite(F);
Writeln(F,'1;2;3;;5');
Writeln(F,'11;12;13;;15');
Close(F);
TestDataset.FirstLineAsSchema:=True;
TestDataset.Delimiter := ';';
TestDataset.FileName:=OutputFileName;
TestDataset.Open;
AssertEquals('Correct field count',5,TestDataset.FieldDefs.Count);
end;