View Issue Details

IDProjectCategoryView StatusLast Update
0019610FPCRTLpublic2017-03-01 19:26
ReporterMarco van de VoortAssigned ToMarco van de Voort 
PrioritynormalSeverityminorReproducibilityhave not tried
Status closedResolutionfixed 
Product Version2.5.1Product Build 
Target VersionFixed in Version2.6.4 
Summary0019610: TStringList.delimitedtext doesn't respect quotechar
DescriptionSeems that delimited text doesn't trim quotechar while it should. (Delphi (XE) does)
Steps To ReproduceRun program

FPC output:
0"Avl_Tree"
1"base"
2"common"
3"base"
4"AVL tree, used by laz*xml"

Delphi output:
0Avl_Tree
1base
2common
3base
4AVL tree, used by laz*xml
Additional InformationIIRC it is even documented so in Delphi help.
TagsNo tags attached.
Fixed in Revision23652
FPCOldBugId0
FPCTarget
Attached Files
  • strl.pp (537 bytes)
    {$ifdef fpc}
      {$mode delphi}
    {$else}
      {$apptype console}
    {$endif}
    
    uses classes;
    
    var j : Integer;
        y : TStringList; 
    begin
     y:=TStringList.create;
     y.strictdelimiter:=true;
     y.delimiter:=';';
     y.quotechar:='"';
     y.delimitedtext:='"Avl_Tree";"base";"common";"base";"AVL tree, used by laz*xml"';
     for j:=0 to y.count-1 do
       writeln(j,y[j]);
    end.
    
    FPC output:
    0"Avl_Tree"
    1"base"
    2"common"
    3"base"
    4"AVL tree, used by laz*xml"
    
    Delphi output:
    0Avl_Tree
    1base
    2common
    3base
    4AVL tree, used by laz*xml
    strl.pp (537 bytes)
  • delimitedtext.pas (2,079 bytes)
    program delimitedtext;
    
    {$ifdef fpc}
      {$mode delphi}
    {$else}
      {$apptype console}
    {$endif}
    
    uses classes;
    
    var j : Integer;
        y : TStringList; 
    begin
     y:=TStringList.create;
     y.strictdelimiter:=true;
     y.delimiter:=';';
     y.quotechar:='"';
     //Note Turbo Delphi 2006 sees the null character as end of file, so we can't test NUL characters.
     //Note that we leave a delimiter at the end of the string on purpose.
     y.delimitedtext:='normal_string;"quoted_string";"quote;delimiter";"quote and space";""starting_quotes;';
     writeln('Assigning delimitedtext:');
     for j:=0 to y.count-1 do
       writeln(j,y[j]);
     writeln('');
     y.clear;
     y.add('normal_string');
     y.add('includes;delimiter');
     y.add('includes space');
     y.add('includes"quote'); 
     y.add('"single starting quote');
     writeln('Retrieving delimitedtext:');
     writeln(y.delimitedtext);
    end.
    
    {
    Turbo Delphi 2006 output:
    Assigning delimitedtext:
    0normal_string
    1quoted_string
    2quote;delimiter
    3quote and space
    4
    5starting_quotes
    6
    
    Retrieving delimitedtext:
    normal_string;"includes;delimiter";includes space;"includes""quote";"""single starting quote"
    
    FPC fixes_2.6 output:
    Assigning delimitedtext:
    0normal_string
    1"quoted_string"
    2"quote
    3delimiter"
    4"quote and space"
    5""starting_quotes
    6
    
    Retrieving delimitedtext:
    normal_string;includes;delimiter;includes space;includes"quote;"single starting quote
    
    
    Paraphrased from
    http://docwiki.embarcadero.com/VCL/en/Classes.TStrings.DelimitedText
    If you get DelimitedText, strings that include spaces, Delimiter or QuoteChar will be enclosed QuoteChars. 
    In addition, any QuoteChar character contained in an individual string will be repeated.
    
    When setting DelimitedText strings must be separated by Delimiter characters or spaces.
    They may be enclosed in QuoteChars.
    
    QuoteChars in the string must be repeated to distinguish them from the QuoteChars enclosing the string.
    
    Spaces and Delimiters that are not contained within QuoteChar marks are delimiters.
    Two Delimiters in a row indicate an empty string
    
    }
    
    delimitedtext.pas (2,079 bytes)
  • DelimitedText.diff (3,842 bytes)
    Index: rtl/objpas/classes/stringl.inc
    ===================================================================
    --- rtl/objpas/classes/stringl.inc	(revision 20119)
    +++ rtl/objpas/classes/stringl.inc	(working copy)
    @@ -140,30 +140,33 @@
     Var
       I : integer;
       p : pchar;
    -  c : set of char;
    +  BreakChars : set of char;
       S : String;
       
     begin
       CheckSpecialChars;
       result:='';
       if StrictDelimiter then
    -    c:=[#0,Delimiter]
    +    BreakChars:=[#0,QuoteChar,Delimiter]
       else  
    -    c:=[#0..' ',QuoteChar,Delimiter];
    +    BreakChars:=[#0..' ',QuoteChar,Delimiter];
    +  // Check for break characters and quote if required.
       For i:=0 to count-1 do
         begin
         S:=Strings[i];
         p:=pchar(S);
    -    while not(p^ in c) do
    +    //strings that include spaces, Delimiter or QuoteChar will be enclosed in QuoteChars.
    +    //Note: unclear what happens to control codes when strictdelimiter is on
    +    while not(p^ in BreakChars) do
          inc(p);
    -// strings in list may contain #0
    -    if (p<>pchar(S)+length(S)) and not StrictDelimiter then
    +    if (p<>pchar(S)+length(S)) then
           Result:=Result+QuoteString(S,QuoteChar)
         else
           Result:=Result+S;
         if I<Count-1 then 
           Result:=Result+Delimiter;
         end;
    +  // Quote empty string:
       If (Length(Result)=0) and (Count=1) then
         Result:=QuoteChar+QuoteChar;
     end;
    @@ -268,26 +271,58 @@
      j:=1;
      aNotFirst:=false;
     
    + {
    + Strings must be separated by Delimiter characters or spaces.
    + They may be enclosed in QuoteChars.
    + QuoteChars in the string must be repeated to distinguish them from the QuoteChars enclosing the string.
    + }
      try
       Clear;
       If StrictDelimiter then
         begin
    -    // Easier, faster loop.
    -    While I<=Length(AValue) do
    -      begin
    -      If (AValue[I] in [FDelimiter,#0]) then
    -        begin
    -        Add(Copy(AValue,J,I-J));
    -        J:=I+1;
    -        end;
    -      Inc(i);
    +    while i<=length(AValue) do begin
    +     // todo: add check for double quotes
    +     // """single starting quote" => "single starting quote
    +
    +     // skip delimiter
    +     if aNotFirst and (i<=length(AValue)) and (AValue[i]=FDelimiter) then inc(i);
    +
    +     // read next string
    +     if i<=length(AValue) then begin
    +      if AValue[i]=FQuoteChar then begin
    +       // next string is quoted
    +       j:=i+1;
    +       while (j<=length(AValue)) and
    +             ( (AValue[j]<>FQuoteChar) or
    +               ( (j+1<=length(AValue)) and (AValue[j+1]=FQuoteChar) ) ) do begin
    +        if (j<=length(AValue)) and (AValue[j]=FQuoteChar) then inc(j,2)
    +                                                          else inc(j);
    +       end;
    +       // j is position of closing quote
    +       Add( StringReplace (Copy(AValue,i+1,j-i-1),
    +                           FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
    +       i:=j+1;
    +      end else begin
    +       // next string is not quoted; read until delimiter
    +       j:=i;
    +       while (j<=length(AValue)) and
    +             (AValue[j]<>FDelimiter) do inc(j);
    +       Add( Copy(AValue,i,j-i));
    +       i:=j;
           end;
    -    If (Length(AValue)>0) then
    -      Add(Copy(AValue,J,I-J));  
    +     end else begin
    +      if aNotFirst then Add('');
    +     end;
    +
    +     aNotFirst:=true;
    +    end;
         end
       else 
         begin
         while i<=length(AValue) do begin
    +     // todo: add check for double quotes
    +     // """single starting quote" => "single starting quote
    +
          // skip delimiter
          if aNotFirst and (i<=length(AValue)) and (AValue[i]=FDelimiter) then inc(i);
     
    @@ -310,7 +345,7 @@
                                FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
            i:=j+1;
           end else begin
    -       // next string is not quoted
    +       // next string is not quoted; read until control character/space/delimiter
            j:=i;
            while (j<=length(AValue)) and
                  (Ord(AValue[j])>Ord(' ')) and
    
    DelimitedText.diff (3,842 bytes)
  • DelimitedText2.diff (3,396 bytes)
    Index: rtl/objpas/classes/stringl.inc
    ===================================================================
    --- rtl/objpas/classes/stringl.inc	(revision 20119)
    +++ rtl/objpas/classes/stringl.inc	(working copy)
    @@ -140,30 +140,33 @@
     Var
       I : integer;
       p : pchar;
    -  c : set of char;
    +  BreakChars : set of char;
       S : String;
       
     begin
       CheckSpecialChars;
       result:='';
       if StrictDelimiter then
    -    c:=[#0,Delimiter]
    +    BreakChars:=[#0,QuoteChar,Delimiter]
       else  
    -    c:=[#0..' ',QuoteChar,Delimiter];
    +    BreakChars:=[#0..' ',QuoteChar,Delimiter];
    +
    +  // Check for break characters and quote if required.
       For i:=0 to count-1 do
         begin
         S:=Strings[i];
         p:=pchar(S);
    -    while not(p^ in c) do
    +    //Quote strings that include BreakChars:
    +    while not(p^ in BreakChars) do
          inc(p);
    -// strings in list may contain #0
    -    if (p<>pchar(S)+length(S)) and not StrictDelimiter then
    +    if (p<>pchar(S)+length(S)) then
           Result:=Result+QuoteString(S,QuoteChar)
         else
           Result:=Result+S;
         if I<Count-1 then 
           Result:=Result+Delimiter;
         end;
    +  // Quote empty string:
       If (Length(Result)=0) and (Count=1) then
         Result:=QuoteChar+QuoteChar;
     end;
    @@ -268,22 +271,48 @@
      j:=1;
      aNotFirst:=false;
     
    + { Paraphrased from Delphi XE2 help:
    + Strings must be separated by Delimiter characters or spaces.
    + They may be enclosed in QuoteChars.
    + QuoteChars in the string must be repeated to distinguish them from the QuoteChars enclosing the string.
    + }
      try
       Clear;
       If StrictDelimiter then
         begin
    -    // Easier, faster loop.
    -    While I<=Length(AValue) do
    -      begin
    -      If (AValue[I] in [FDelimiter,#0]) then
    -        begin
    -        Add(Copy(AValue,J,I-J));
    -        J:=I+1;
    -        end;
    -      Inc(i);
    +    while i<=length(AValue) do begin
    +     // skip delimiter
    +     if aNotFirst and (i<=length(AValue)) and (AValue[i]=FDelimiter) then inc(i);
    +
    +     // read next string
    +     if i<=length(AValue) then begin
    +      if AValue[i]=FQuoteChar then begin
    +       // next string is quoted
    +       j:=i+1;
    +       while (j<=length(AValue)) and
    +             ( (AValue[j]<>FQuoteChar) or
    +               ( (j+1<=length(AValue)) and (AValue[j+1]=FQuoteChar) ) ) do begin
    +        if (j<=length(AValue)) and (AValue[j]=FQuoteChar) then inc(j,2)
    +                                                          else inc(j);
    +       end;
    +       // j is position of closing quote
    +       Add( StringReplace (Copy(AValue,i+1,j-i-1),
    +                           FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
    +       i:=j+1;
    +      end else begin
    +       // next string is not quoted; read until delimiter
    +       j:=i;
    +       while (j<=length(AValue)) and
    +             (AValue[j]<>FDelimiter) do inc(j);
    +       Add( Copy(AValue,i,j-i));
    +       i:=j;
           end;
    -    If (Length(AValue)>0) then
    -      Add(Copy(AValue,J,I-J));  
    +     end else begin
    +      if aNotFirst then Add('');
    +     end;
    +
    +     aNotFirst:=true;
    +    end;
         end
       else 
         begin
    @@ -310,7 +339,7 @@
                                FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
            i:=j+1;
           end else begin
    -       // next string is not quoted
    +       // next string is not quoted; read until control character/space/delimiter
            j:=i;
            while (j<=length(AValue)) and
                  (Ord(AValue[j])>Ord(' ')) and
    
    DelimitedText2.diff (3,396 bytes)
  • stringl.inc (32,035 bytes)
    {
        This file is part of the Free Component Library (FCL)
        Copyright (c) 1999-2000 by the Free Pascal development team
    
        See the file COPYING.FPC, included in this distribution,
        for details about the copyright.
    
        This program is distributed in the hope that it will be useful,
        but WITHOUT ANY WARRANTY; without even the implied warranty of
        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    
     **********************************************************************}
    
    {****************************************************************************}
    {*                        TStringsEnumerator                                *}
    {****************************************************************************}
    
    constructor TStringsEnumerator.Create(AStrings: TStrings);
    begin
      inherited Create;
      FStrings := AStrings;
      FPosition := -1;
    end;
    
    function TStringsEnumerator.GetCurrent: String;
    begin
      Result := FStrings[FPosition];
    end;
    
    function TStringsEnumerator.MoveNext: Boolean;
    begin
      Inc(FPosition);
      Result := FPosition < FStrings.Count;
    end;
    
    {****************************************************************************}
    {*                             TStrings                                     *}
    {****************************************************************************}
    
    // Function to quote text. Should move maybe to sysutils !!
    // Also, it is not clear at this point what exactly should be done.
    
    { //!! is used to mark unsupported things. }
    
    Function QuoteString (Const S : String; Quote : String) : String;
    Var
      I,J : Integer;
    begin
      J:=0;
      Result:=S;
      for i:=1to length(s) do
       begin
         inc(j);
         if S[i]=Quote then
          begin
            System.Insert(Quote,Result,J);
            inc(j);
          end;
       end;
      Result:=Quote+Result+Quote;
    end;
    
    {
      For compatibility we can't add a Constructor to TSTrings to initialize
      the special characters. Therefore we add a routine which is called whenever
      the special chars are needed.
    }
    
    Procedure Tstrings.CheckSpecialChars;
    
    begin
      If Not FSpecialCharsInited then
        begin
        FQuoteChar:='"';
        FDelimiter:=',';
        FNameValueSeparator:='=';
        FSpecialCharsInited:=true;
        FLBS:=DefaultTextLineBreakStyle;
        end;
    end;
    
    Function TStrings.GetLBS : TTextLineBreakStyle;
    begin
      CheckSpecialChars;
      Result:=FLBS;
    end;
    
    Procedure TStrings.SetLBS (AValue : TTextLineBreakStyle);
    begin
      CheckSpecialChars;
      FLBS:=AValue;
    end;
    
    procedure TStrings.SetDelimiter(c:Char);
    begin
      CheckSpecialChars;
      FDelimiter:=c;
    end;
    
    
    procedure TStrings.SetQuoteChar(c:Char);
    begin
      CheckSpecialChars;
      FQuoteChar:=c;
    end;
    
    procedure TStrings.SetNameValueSeparator(c:Char);
    begin
      CheckSpecialChars;
      FNameValueSeparator:=c;
    end;
    
    
    function TStrings.GetCommaText: string;
    
    Var
      C1,C2 : Char;
      FSD : Boolean;
    
    begin
      CheckSpecialChars;
      FSD:=StrictDelimiter;
      C1:=Delimiter;
      C2:=QuoteChar;
      Delimiter:=',';
      QuoteChar:='"';
      StrictDelimiter:=False;
      Try
        Result:=GetDelimitedText;
      Finally
        Delimiter:=C1;
        QuoteChar:=C2;
        StrictDelimiter:=FSD;
      end;
    end;
    
    
    Function TStrings.GetDelimitedText: string;
    
    Var
      I : integer;
      p : pchar;
      BreakChars : set of char;
      S : String;
      
    begin
      CheckSpecialChars;
      result:='';
      if StrictDelimiter then
        BreakChars:=[#0,QuoteChar,Delimiter]
      else  
        BreakChars:=[#0..' ',QuoteChar,Delimiter];
    
      // Check for break characters and quote if required.
      For i:=0 to count-1 do
        begin
        S:=Strings[i];
        p:=pchar(S);
        //Quote strings that include BreakChars:
        while not(p^ in BreakChars) do
         inc(p);
        if (p<>pchar(S)+length(S)) then
          Result:=Result+QuoteString(S,QuoteChar)
        else
          Result:=Result+S;
        if I<Count-1 then 
          Result:=Result+Delimiter;
        end;
      // Quote empty string:
      If (Length(Result)=0) and (Count=1) then
        Result:=QuoteChar+QuoteChar;
    end;
    
    procedure TStrings.GetNameValue(Index : Integer; Out AName,AValue : String);
    
    Var L : longint;
    
    begin
      CheckSpecialChars;
      AValue:=Strings[Index];
      L:=Pos(FNameValueSeparator,AValue);
      If L<>0 then
        begin
        AName:=Copy(AValue,1,L-1);
        System.Delete(AValue,1,L);
        end
      else
        AName:='';
    end;
    
    function TStrings.ExtractName(const s:String):String;
    var
      L: Longint;
    begin
      CheckSpecialChars;
      L:=Pos(FNameValueSeparator,S);
      If L<>0 then
        Result:=Copy(S,1,L-1)
      else
        Result:='';
    end;
    
    function TStrings.GetName(Index: Integer): string;
    
    Var
      V : String;
    
    begin
      GetNameValue(Index,Result,V);
    end;
    
    Function TStrings.GetValue(const Name: string): string;
    
    Var
      L : longint;
      N : String;
    
    begin
      Result:='';
      L:=IndexOfName(Name);
      If L<>-1 then
        GetNameValue(L,N,Result);
    end;
    
    Function TStrings.GetValueFromIndex(Index: Integer): string;
    
    Var
      N : String;
    
    begin
      GetNameValue(Index,N,Result);
    end;
    
    Procedure TStrings.SetValueFromIndex(Index: Integer; const Value: string);
    
    begin
      If (Value='') then
        Delete(Index)
      else
        begin
        If (Index<0) then
          Index:=Add('');
        CheckSpecialChars;
        Strings[Index]:=GetName(Index)+FNameValueSeparator+Value;
        end;
    end;
    
    procedure TStrings.ReadData(Reader: TReader);
    begin
      Reader.ReadListBegin;
      BeginUpdate;
      try
        Clear;
        while not Reader.EndOfList do
          Add(Reader.ReadString);
      finally
        EndUpdate;
      end;
      Reader.ReadListEnd;
    end;
    
    
    Procedure TStrings.SetDelimitedText(const AValue: string);
    var i,j:integer;
        aNotFirst:boolean;
    begin
     CheckSpecialChars;
     BeginUpdate;
    
     i:=1;
     j:=1;
     aNotFirst:=false;
    
     { Paraphrased from Delphi XE2 help:
     Strings must be separated by Delimiter characters or spaces.
     They may be enclosed in QuoteChars.
     QuoteChars in the string must be repeated to distinguish them from the QuoteChars enclosing the string.
     }
     try
      Clear;
      If StrictDelimiter then
        begin
        while i<=length(AValue) do begin
         // skip delimiter
         if aNotFirst and (i<=length(AValue)) and (AValue[i]=FDelimiter) then inc(i);
    
         // read next string
         if i<=length(AValue) then begin
          if AValue[i]=FQuoteChar then begin
           // next string is quoted
           j:=i+1;
           while (j<=length(AValue)) and
                 ( (AValue[j]<>FQuoteChar) or
                   ( (j+1<=length(AValue)) and (AValue[j+1]=FQuoteChar) ) ) do begin
            if (j<=length(AValue)) and (AValue[j]=FQuoteChar) then inc(j,2)
                                                              else inc(j);
           end;
           // j is position of closing quote
           Add( StringReplace (Copy(AValue,i+1,j-i-1),
                               FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
           i:=j+1;
          end else begin
           // next string is not quoted; read until delimiter
           j:=i;
           while (j<=length(AValue)) and
                 (AValue[j]<>FDelimiter) do inc(j);
           Add( Copy(AValue,i,j-i));
           i:=j;
          end;
         end else begin
          if aNotFirst then Add('');
         end;
    
         aNotFirst:=true;
        end;
        end
      else 
        begin
        while i<=length(AValue) do begin
         // skip delimiter
         if aNotFirst and (i<=length(AValue)) and (AValue[i]=FDelimiter) then inc(i);
    
         // skip spaces
         while (i<=length(AValue)) and (Ord(AValue[i])<=Ord(' ')) do inc(i);
        
         // read next string
         if i<=length(AValue) then begin
          if AValue[i]=FQuoteChar then begin
           // next string is quoted
           j:=i+1;
           while (j<=length(AValue)) and
                 ( (AValue[j]<>FQuoteChar) or
                   ( (j+1<=length(AValue)) and (AValue[j+1]=FQuoteChar) ) ) do begin
            if (j<=length(AValue)) and (AValue[j]=FQuoteChar) then inc(j,2)
                                                              else inc(j);
           end;
           // j is position of closing quote
           Add( StringReplace (Copy(AValue,i+1,j-i-1),
                               FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
           i:=j+1;
          end else begin
           // next string is not quoted; read until control character/space/delimiter
           j:=i;
           while (j<=length(AValue)) and
                 (Ord(AValue[j])>Ord(' ')) and
                 (AValue[j]<>FDelimiter) do inc(j);
           Add( Copy(AValue,i,j-i));
           i:=j;
          end;
         end else begin
          if aNotFirst then Add('');
         end;
    
         // skip spaces
         while (i<=length(AValue)) and (Ord(AValue[i])<=Ord(' ')) do inc(i);
    
         aNotFirst:=true;
        end;
        end;
     finally
       EndUpdate;
     end;
    end;
    
    Procedure TStrings.SetCommaText(const Value: string);
    
    Var
      C1,C2 : Char;
    
    begin
      CheckSpecialChars;
      C1:=Delimiter;
      C2:=QuoteChar;
      Delimiter:=',';
      QuoteChar:='"';
      Try
        SetDelimitedText(Value);
      Finally
        Delimiter:=C1;
        QuoteChar:=C2;
      end;
    end;
    
    
    Procedure TStrings.SetStringsAdapter(const Value: IStringsAdapter);
    
    begin
    end;
    
    
    
    Procedure TStrings.SetValue(const Name, Value: string);
    
    Var L : longint;
    
    begin
      CheckSpecialChars;
      L:=IndexOfName(Name);
      if L=-1 then
       Add (Name+FNameValueSeparator+Value)
      else
       Strings[L]:=Name+FNameValueSeparator+value;
    end;
    
    
    
    procedure TStrings.WriteData(Writer: TWriter);
    var
      i: Integer;
    begin
      Writer.WriteListBegin;
      for i := 0 to Count - 1 do
        Writer.WriteString(Strings[i]);
      Writer.WriteListEnd;
    end;
    
    
    
    procedure TStrings.DefineProperties(Filer: TFiler);
    var
      HasData: Boolean;
    begin
      if Assigned(Filer.Ancestor) then
        // Only serialize if string list is different from ancestor
        if Filer.Ancestor.InheritsFrom(TStrings) then
          HasData := not Equals(TStrings(Filer.Ancestor))
        else
          HasData := True
      else
        HasData := Count > 0;
      Filer.DefineProperty('Strings', @ReadData, @WriteData, HasData);
    end;
    
    
    Procedure TStrings.Error(const Msg: string; Data: Integer);
    begin
      Raise EStringListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame);
    end;
    
    
    Procedure TStrings.Error(const Msg: pstring; Data: Integer);
    begin
      Raise EStringListError.CreateFmt(Msg^,[Data]) at get_caller_addr(get_frame);
    end;
    
    
    Function TStrings.GetCapacity: Integer;
    
    begin
      Result:=Count;
    end;
    
    
    
    Function TStrings.GetObject(Index: Integer): TObject;
    
    begin
      Result:=Nil;
    end;
    
    
    
    Function TStrings.GetTextStr: string;
    
    Var P : Pchar;
        I,L,NLS : Longint;
        S,NL : String;
    
    begin
      CheckSpecialChars;
      // Determine needed place
      Case FLBS of
        tlbsLF   : NL:=#10;
        tlbsCRLF : NL:=#13#10;
        tlbsCR   : NL:=#13; 
      end;
      L:=0;
      NLS:=Length(NL);
      For I:=0 to count-1 do
        L:=L+Length(Strings[I])+NLS;
      Setlength(Result,L);
      P:=Pointer(Result);
      For i:=0 To count-1 do
        begin
        S:=Strings[I];
        L:=Length(S);
        if L<>0 then
          System.Move(Pointer(S)^,P^,L);
        P:=P+L;
        For L:=1 to NLS do
          begin
          P^:=NL[L];
          inc(P);
          end;
        end;
    end;
    
    
    
    Procedure TStrings.Put(Index: Integer; const S: string);
    
    Var Obj : TObject;
    
    begin
      Obj:=Objects[Index];
      Delete(Index);
      InsertObject(Index,S,Obj);
    end;
    
    
    
    Procedure TStrings.PutObject(Index: Integer; AObject: TObject);
    
    begin
      // Empty.
    end;
    
    
    
    Procedure TStrings.SetCapacity(NewCapacity: Integer);
    
    begin
      // Empty.
    end;
    
    Function GetNextLine (Const Value : String; Var S : String; Var P : Integer) : Boolean;
    
    Var 
      PS : PChar;
      IP,L : Integer;
      
    begin
      L:=Length(Value);
      S:='';
      Result:=False;
      If ((L-P)<0) then 
        exit;
      if ((L-P)=0) and (not (value[P] in [#10,#13])) Then
        Begin
          s:=value[P];
          inc(P);
          Exit(True);
        End;
      PS:=PChar(Value)+P-1;
      IP:=P;
      While ((L-P)>=0) and (not (PS^ in [#10,#13])) do 
        begin
        P:=P+1;
        Inc(PS);
        end;
      SetLength (S,P-IP);
      System.Move (Value[IP],Pointer(S)^,P-IP);
      If (P<=L) and (Value[P]=#13) then 
        Inc(P);
      If (P<=L) and (Value[P]=#10) then
        Inc(P); // Point to character after #10(#13)
      Result:=True;
    end;
    
    Procedure TStrings.SetTextStr(const Value: string);
    
    Var
      S : String;
      P : Integer;
    
    begin
      Try
        beginUpdate;
        Clear;
        P:=1;
        While GetNextLine (Value,S,P) do
          Add(S);
      finally
        EndUpdate;
      end;
    end;
    
    
    
    Procedure TStrings.SetUpdateState(Updating: Boolean);
    
    begin
    end;
    
    
    
    destructor TSTrings.Destroy;
    
    begin
      inherited destroy;
    end;
    
    
    
    Function TStrings.Add(const S: string): Integer;
    
    begin
      Result:=Count;
      Insert (Count,S);
    end;
    
    
    
    Function TStrings.AddObject(const S: string; AObject: TObject): Integer;
    
    begin
      Result:=Add(S);
      Objects[result]:=AObject;
    end;
    
    
    
    Procedure TStrings.Append(const S: string);
    
    begin
      Add (S);
    end;
    
    
    
    Procedure TStrings.AddStrings(TheStrings: TStrings);
    
    Var Runner : longint;
    
    begin
      try
        beginupdate;
        For Runner:=0 to TheStrings.Count-1 do
          self.AddObject (Thestrings[Runner],TheStrings.Objects[Runner]);
      finally
        EndUpdate;
      end;
    end;
    
    
    
    Procedure TStrings.Assign(Source: TPersistent);
    
    Var
      S : TStrings;
    
    begin
      If Source is TStrings then
        begin
        S:=TStrings(Source);
        BeginUpdate;
        Try
          clear;
          FSpecialCharsInited:=S.FSpecialCharsInited;
          FQuoteChar:=S.FQuoteChar;
          FDelimiter:=S.FDelimiter;
          FNameValueSeparator:=S.FNameValueSeparator;
          FLBS:=S.FLBS;
          AddStrings(S);
        finally
          EndUpdate;
        end;
        end
      else
        Inherited Assign(Source);
    end;
    
    
    
    Procedure TStrings.BeginUpdate;
    
    begin
       if FUpdateCount = 0 then SetUpdateState(true);
       inc(FUpdateCount);
    end;
    
    
    
    Procedure TStrings.EndUpdate;
    
    begin
      If FUpdateCount>0 then
         Dec(FUpdateCount);
      if FUpdateCount=0 then
        SetUpdateState(False);
    end;
    
    
    
    Function TStrings.Equals(Obj: TObject): Boolean;
    
    begin
      if Obj is TStrings then
        Result := Equals(TStrings(Obj))
      else
        Result := inherited Equals(Obj);
    end;
    
    
    
    Function TStrings.Equals(TheStrings: TStrings): Boolean;
    
    Var Runner,Nr : Longint;
    
    begin
      Result:=False;
      Nr:=Self.Count;
      if Nr<>TheStrings.Count then exit;
      For Runner:=0 to Nr-1 do
        If Strings[Runner]<>TheStrings[Runner] then exit;
      Result:=True;
    end;
    
    
    
    Procedure TStrings.Exchange(Index1, Index2: Integer);
    
    Var
      Obj : TObject;
      Str : String;
    
    begin
      Try
        beginUpdate;
        Obj:=Objects[Index1];
        Str:=Strings[Index1];
        Objects[Index1]:=Objects[Index2];
        Strings[Index1]:=Strings[Index2];
        Objects[Index2]:=Obj;
        Strings[Index2]:=Str;
      finally
        EndUpdate;
      end;
    end;
    
    
    function TStrings.GetEnumerator: TStringsEnumerator;
    begin
      Result:=TStringsEnumerator.Create(Self);
    end;
    
    
    Function TStrings.GetText: PChar;
    begin
      Result:=StrNew(Pchar(Self.Text));
    end;
    
    
    Function TStrings.DoCompareText(const s1,s2 : string) : PtrInt;
      begin
        result:=CompareText(s1,s2);
      end;
    
    
    Function TStrings.IndexOf(const S: string): Integer;
    begin
      Result:=0;
      While (Result<Count) and (DoCompareText(Strings[Result],S)<>0) do Result:=Result+1;
      if Result=Count then Result:=-1;
    end;
    
    
    Function TStrings.IndexOfName(const Name: string): Integer;
    Var
      len : longint;
      S : String;
    begin
      CheckSpecialChars;
      Result:=0;
      while (Result<Count) do
        begin
        S:=Strings[Result];
        len:=pos(FNameValueSeparator,S)-1;
        if (len>0) and (DoCompareText(Name,Copy(S,1,Len))=0) then
          exit;
        inc(result);
        end;
      result:=-1;
    end;
    
    
    Function TStrings.IndexOfObject(AObject: TObject): Integer;
    begin
      Result:=0;
      While (Result<count) and (Objects[Result]<>AObject) do Result:=Result+1;
      If Result=Count then Result:=-1;
    end;
    
    
    Procedure TStrings.InsertObject(Index: Integer; const S: string;
      AObject: TObject);
    
    begin
      Insert (Index,S);
      Objects[Index]:=AObject;
    end;
    
    
    
    Procedure TStrings.LoadFromFile(const FileName: string);
    Var
            TheStream : TFileStream;
    begin
      TheStream:=TFileStream.Create(FileName,fmOpenRead or fmShareDenyWrite);
      try
        LoadFromStream(TheStream);
      finally
        TheStream.Free;
      end;
    end;
    
    
    
    Procedure TStrings.LoadFromStream(Stream: TStream);
    {
       Borlands method is no good, since a pipe for
       instance doesn't have a size.
       So we must do it the hard way.
    }
    Const
      BufSize = 1024;
      MaxGrow = 1 shl 29;
    
    Var
      Buffer     : AnsiString;
      BytesRead,
      BufLen,
      I,BufDelta     : Longint;
    begin
      // reread into a buffer
      try
        beginupdate;
        Buffer:='';
        BufLen:=0;
        I:=1;
        Repeat
          BufDelta:=BufSize*I;
          SetLength(Buffer,BufLen+BufDelta);
          BytesRead:=Stream.Read(Buffer[BufLen+1],BufDelta);
          inc(BufLen,BufDelta);
          If I<MaxGrow then
            I:=I shl 1;
        Until BytesRead<>BufDelta;
        SetLength(Buffer, BufLen-BufDelta+BytesRead);
        SetTextStr(Buffer);
        SetLength(Buffer,0);
      finally
        EndUpdate;
      end;
    end;
    
    
    Procedure TStrings.Move(CurIndex, NewIndex: Integer);
    Var
      Obj : TObject;
      Str : String;
    begin
      BeginUpdate;
      Obj:=Objects[CurIndex];
      Str:=Strings[CurIndex];
      Delete(Curindex);
      InsertObject(NewIndex,Str,Obj);
      EndUpdate;
    end;
    
    
    
    Procedure TStrings.SaveToFile(const FileName: string);
    
    Var TheStream : TFileStream;
    
    begin
      TheStream:=TFileStream.Create(FileName,fmCreate);
      try
        SaveToStream(TheStream);
      finally
        TheStream.Free;
      end;
    end;
    
    
    
    Procedure TStrings.SaveToStream(Stream: TStream);
    Var
      S : String;
    begin
      S:=Text;
      if S = '' then Exit;
      Stream.WriteBuffer(Pointer(S)^,Length(S));
    end;
    
    
    
    
    Procedure TStrings.SetText(TheText: PChar);
    
    Var S : String;
    
    begin
      If TheText<>Nil then
        S:=StrPas(TheText)
      else
        S:='';
      SetTextStr(S);  
    end;
    
    
    {****************************************************************************}
    {*                             TStringList                                  *}
    {****************************************************************************}
    
    {$if defined(VER2_0) or not defined(FPC_TESTGENERICS)}
    
    Procedure TStringList.ExchangeItems(Index1, Index2: Integer);
    
    Var P1,P2 : Pointer;
    
    begin
      P1:=Pointer(Flist^[Index1].FString);
      P2:=Pointer(Flist^[Index1].FObject);
      Pointer(Flist^[Index1].Fstring):=Pointer(Flist^[Index2].Fstring);
      Pointer(Flist^[Index1].FObject):=Pointer(Flist^[Index2].FObject);
      Pointer(Flist^[Index2].Fstring):=P1;
      Pointer(Flist^[Index2].FObject):=P2;
    end;
    
    
    
    Procedure TStringList.Grow;
    
    Var
      NC : Integer;
    
    begin
      NC:=FCapacity;
      If NC>=256 then
        NC:=NC+(NC Div 4)
      else if NC=0 then
        NC:=4
      else
        NC:=NC*4;
      SetCapacity(NC);
    end;
    
    
    
    Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
    var
      Pivot, vL, vR: Integer;
    begin
      if R - L <= 1 then begin // a little bit of time saver
        if L < R then
          if CompareFn(Self, L, R) > 0 then
            ExchangeItems(L, R);
    
        Exit;
      end;
    
      vL := L;
      vR := R;
    
      Pivot := L + Random(R - L); // they say random is best
    
      while vL < vR do begin
        while (vL < Pivot) and (CompareFn(Self, vL, Pivot) <= 0) do
          Inc(vL);
    
        while (vR > Pivot) and (CompareFn(Self, vR, Pivot) > 0) do
          Dec(vR);
    
        ExchangeItems(vL, vR);
    
        if Pivot = vL then // swap pivot if we just hit it from one side
          Pivot := vR
        else if Pivot = vR then
          Pivot := vL;
      end;
    
      if Pivot - 1 >= L then
        QuickSort(L, Pivot - 1, CompareFn);
      if Pivot + 1 <= R then
        QuickSort(Pivot + 1, R, CompareFn);
    end;
    
    
    Procedure TStringList.InsertItem(Index: Integer; const S: string);
    begin
      Changing;
      If FCount=Fcapacity then Grow;
      If Index<FCount then
        System.Move (FList^[Index],FList^[Index+1],
                     (FCount-Index)*SizeOf(TStringItem));
      Pointer(Flist^[Index].Fstring):=Nil;  // Needed to initialize...
      Flist^[Index].FString:=S;
      Flist^[Index].Fobject:=Nil;
      Inc(FCount);
      Changed;
    end;
    
    
    Procedure TStringList.InsertItem(Index: Integer; const S: string; O: TObject);
    begin
      Changing;
      If FCount=Fcapacity then Grow;
      If Index<FCount then
        System.Move (FList^[Index],FList^[Index+1],
                     (FCount-Index)*SizeOf(TStringItem));
      Pointer(Flist^[Index].Fstring):=Nil;  // Needed to initialize...
      Flist^[Index].FString:=S;
      Flist^[Index].FObject:=O;
      Inc(FCount);
      Changed;
    end;
    
    
    Procedure TStringList.SetSorted(Value: Boolean);
    
    begin
      If FSorted<>Value then
        begin
        If Value then sort;
        FSorted:=VAlue
        end;
    end;
    
    
    
    Procedure TStringList.Changed;
    
    begin
      If (FUpdateCount=0) Then
       If Assigned(FOnChange) then
         FOnchange(Self);
    end;
    
    
    
    Procedure TStringList.Changing;
    
    begin
      If FUpdateCount=0 then
        if Assigned(FOnChanging) then
          FOnchanging(Self);
    end;
    
    
    
    Function TStringList.Get(Index: Integer): string;
    
    begin
      If (Index<0) or (INdex>=Fcount)  then
        Error (SListIndexError,Index);
      Result:=Flist^[Index].FString;
    end;
    
    
    
    Function TStringList.GetCapacity: Integer;
    
    begin
      Result:=FCapacity;
    end;
    
    
    
    Function TStringList.GetCount: Integer;
    
    begin
      Result:=FCount;
    end;
    
    
    
    Function TStringList.GetObject(Index: Integer): TObject;
    
    begin
      If (Index<0) or (INdex>=Fcount)  then
        Error (SListIndexError,Index);
      Result:=Flist^[Index].FObject;
    end;
    
    
    
    Procedure TStringList.Put(Index: Integer; const S: string);
    
    begin
      If Sorted then
        Error(SSortedListError,0);
      If (Index<0) or (INdex>=Fcount)  then
        Error (SListIndexError,Index);
      Changing;
      Flist^[Index].FString:=S;
      Changed;
    end;
    
    
    
    Procedure TStringList.PutObject(Index: Integer; AObject: TObject);
    
    begin
      If (Index<0) or (INdex>=Fcount)  then
        Error (SListIndexError,Index);
      Changing;
      Flist^[Index].FObject:=AObject;
      Changed;
    end;
    
    
    
    Procedure TStringList.SetCapacity(NewCapacity: Integer);
    
    Var NewList : Pointer;
        MSize : Longint;
    
    begin
      If (NewCapacity<0) then
         Error (SListCapacityError,NewCapacity);
      If NewCapacity>FCapacity then
        begin
        GetMem (NewList,NewCapacity*SizeOf(TStringItem));
        If NewList=Nil then
          Error (SListCapacityError,NewCapacity);
        If Assigned(FList) then
          begin
          MSize:=FCapacity*Sizeof(TStringItem);
          System.Move (FList^,NewList^,MSize);
          FillWord (Pchar(NewList)[MSize],(NewCapacity-FCapacity)*WordRatio, 0);
          FreeMem (Flist,MSize);
          end;
        Flist:=NewList;
        FCapacity:=NewCapacity;
        end
      else if NewCapacity<FCapacity then
        begin
        if NewCapacity = 0 then
        begin
          FreeMem(FList);
          FList := nil;
        end else
        begin
          GetMem(NewList, NewCapacity * SizeOf(TStringItem));
          System.Move(FList^, NewList^, NewCapacity * SizeOf(TStringItem));
          FreeMem(FList);
          FList := NewList;
        end;
        FCapacity:=NewCapacity;
        end;
    end;
    
    
    
    Procedure TStringList.SetUpdateState(Updating: Boolean);
    
    begin
      If Updating then
        Changing
      else
        Changed
    end;
    
    
    
    destructor TStringList.Destroy;
    
    Var I : Longint;
    
    begin
      FOnChange:=Nil;
      FOnChanging:=Nil;
      // This will force a dereference. Can be done better...
      For I:=0 to FCount-1 do
        FList^[I].FString:='';
      FCount:=0;
      SetCapacity(0);
      Inherited destroy;
    end;
    
    
    
    Function TStringList.Add(const S: string): Integer;
    
    begin
      If Not Sorted then
        Result:=FCount
      else
        If Find (S,Result) then
          Case DUplicates of
            DupIgnore : Exit;
            DupError : Error(SDuplicateString,0)
          end;
       InsertItem (Result,S);
    end;
    
    Procedure TStringList.Clear;
    
    Var I : longint;
    
    begin
      if FCount = 0 then Exit;
      Changing;
      if FOwnsObjects then
        begin
          For I:=0 to FCount-1 do
            begin
              Flist^[I].FString:='';
              freeandnil(Flist^[i].FObject);
            end;
        end
      else
        begin
          For I:=0 to FCount-1 do
            Flist^[I].FString:='';
        end;
      FCount:=0;
      SetCapacity(0);
      Changed;
    end;
    
    Procedure TStringList.Delete(Index: Integer);
    
    begin
      If (Index<0) or (Index>=FCount) then
        Error(SlistINdexError,Index);
      Changing;
      Flist^[Index].FString:='';
      if FOwnsObjects then
        FreeAndNil(Flist^[Index].FObject);
      Dec(FCount);
      If Index<FCount then
        System.Move(Flist^[Index+1],
                    Flist^[Index],
                    (Fcount-Index)*SizeOf(TStringItem));
      Changed;
    end;
    
    
    
    Procedure TStringList.Exchange(Index1, Index2: Integer);
    
    begin
      If (Index1<0) or (Index1>=FCount) then
        Error(SListIndexError,Index1);
      If (Index2<0) or (Index2>=FCount) then
        Error(SListIndexError,Index2);
      Changing;
      ExchangeItems(Index1,Index2);
      changed;
    end;
    
    
    procedure TStringList.SetCaseSensitive(b : boolean);
      begin
            if b<>FCaseSensitive then
              begin
                    FCaseSensitive:=b;
                if FSorted then
                  sort;
              end;
      end;
    
    
    Function TStringList.DoCompareText(const s1,s2 : string) : PtrInt;
      begin
            if FCaseSensitive then
              result:=AnsiCompareStr(s1,s2)
            else
              result:=AnsiCompareText(s1,s2);
      end;
    
    
    Function TStringList.Find(const S: string; Out Index: Integer): Boolean;
    
    var
      L, R, I: Integer;
      CompareRes: PtrInt;
    begin
      Result := false;
      // Use binary search.
      L := 0;
      R := Count - 1;
      while (L<=R) do
      begin
        I := L + (R - L) div 2;
        CompareRes := DoCompareText(S, Flist^[I].FString);
        if (CompareRes>0) then
          L := I+1
        else begin
          R := I-1;
          if (CompareRes=0) then begin
             Result := true;
             if (Duplicates<>dupAccept) then
                L := I; // forces end of while loop
          end;
        end;
      end;
      Index := L;
    end;
    
    
    
    Function TStringList.IndexOf(const S: string): Integer;
    
    begin
      If Not Sorted then
        Result:=Inherited indexOf(S)
      else
        // faster using binary search...
        If Not Find (S,Result) then
          Result:=-1;
    end;
    
    
    
    Procedure TStringList.Insert(Index: Integer; const S: string);
    
    begin
      If Sorted then
        Error (SSortedListError,0)
      else
        If (Index<0) or (Index>FCount) then
          Error (SListIndexError,Index)
        else
          InsertItem (Index,S);
    end;
    
    
    Procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
    
    begin
      If Not Sorted and (FCount>1) then
        begin
        Changing;
        QuickSort(0,FCount-1, CompareFn);
        Changed;
        end;
    end;
    
    function StringListAnsiCompare(List: TStringList; Index1, Index: Integer): Integer;
    
    begin
      Result := List.DoCompareText(List.FList^[Index1].FString,
        List.FList^[Index].FString);
    end;
    
    Procedure TStringList.Sort;
    
    begin
      CustomSort(@StringListAnsiCompare);
    end;
    
    {$else}
    
    { generics based implementation of TStringList follows }
    
    function StringListAnsiCompare(List: TStringList; Index1, Index2: Integer): Integer;
    begin
      Result := List.DoCompareText(List.Strings[Index1], List.Strings[Index2]);
    end;
    
    constructor TStringList.Create;
    begin
      inherited;
      FOwnsObjects:=false;
      FMap := TFPStrObjMap.Create;
      FMap.OnPtrCompare := @MapPtrCompare;
      FOnCompareText := @DefaultCompareText;
      CheckSpecialChars;
    end;
    
    destructor TStringList.Destroy;
    begin
      FMap.Free;
      inherited;
    end;
    
    function TStringList.GetDuplicates: TDuplicates;
    begin
      Result := FMap.Duplicates;
    end;
    
    function TStringList.GetSorted: boolean;
    begin
      Result := FMap.Sorted;
    end;
    
    procedure TStringList.SetDuplicates(NewDuplicates: TDuplicates);
    begin
      FMap.Duplicates := NewDuplicates;
    end;
    
    procedure TStringList.SetSorted(NewSorted: Boolean);
    begin
      FMap.Sorted := NewSorted;
    end;
    
    procedure TStringList.Changed;
    begin
      if FUpdateCount = 0 then
       if Assigned(FOnChange) then
         FOnChange(Self);
    end;
    
    procedure TStringList.Changing;
    begin
      if FUpdateCount = 0 then
        if Assigned(FOnChanging) then
          FOnChanging(Self);
    end;
    
    function TStringList.Get(Index: Integer): string;
    begin
      Result := FMap.Keys[Index];
    end;
    
    function TStringList.GetCapacity: Integer;
    begin
      Result := FMap.Capacity;
    end;
    
    function TStringList.GetCount: Integer;
    begin
      Result := FMap.Count;
    end;
    
    function TStringList.GetObject(Index: Integer): TObject;
    begin
      Result := FMap.Data[Index];
    end;
    
    procedure TStringList.Put(Index: Integer; const S: string);
    begin
      Changing;
      FMap.Keys[Index] := S;
      Changed;
    end;
    
    procedure TStringList.PutObject(Index: Integer; AObject: TObject);
    begin
      Changing;
      FMap.Data[Index] := AObject;
      Changed;
    end;
    
    procedure TStringList.SetCapacity(NewCapacity: Integer);
    begin
      FMap.Capacity := NewCapacity;
    end;
    
    procedure TStringList.SetUpdateState(Updating: Boolean);
    begin
      if Updating then
        Changing
      else
        Changed
    end;
    
    function TStringList.Add(const S: string): Integer;
    begin
      Result := FMap.Add(S);
    end;
    
    procedure TStringList.Clear;
    begin
      if FMap.Count = 0 then exit;
      Changing;
      FMap.Clear;
      Changed;
    end;
    
    procedure TStringList.Delete(Index: Integer);
    begin
      if (Index < 0) or (Index >= FMap.Count) then
        Error(SListIndexError, Index);
      Changing;
      FMap.Delete(Index);
      Changed;
    end;
    
    procedure TStringList.Exchange(Index1, Index2: Integer);
    begin
      if (Index1 < 0) or (Index1 >= FMap.Count) then
        Error(SListIndexError, Index1);
      if (Index2 < 0) or (Index2 >= FMap.Count) then
        Error(SListIndexError, Index2);
      Changing;
      FMap.InternalExchange(Index1, Index2);
      Changed;
    end;
    
    procedure TStringList.SetCaseSensitive(NewSensitive: Boolean);
    begin
      if NewSensitive <> FCaseSensitive then
      begin
        FCaseSensitive := NewSensitive;
        if Sorted then
          Sort;
      end;
    end;
    
    function TStringList.MapPtrCompare(Key1, Key2: Pointer): Integer;
    begin
      Result := FOnCompareText(string(Key1^), string(Key2^));
    end;
    
    function TStringList.DefaultCompareText(const s1, s2: string): PtrInt;
    begin
      if FCaseSensitive then
        Result := AnsiCompareStr(s1, s2)
      else
        Result := AnsiCompareText(s1, s2);
    end;
    
    function TStringList.DoCompareText(const s1, s2: string): PtrInt;
    begin
      Result := FOnCompareText(s1, s2);
    end;
    
    function TStringList.Find(const S: string; var Index: Integer): Boolean;
    begin
      Result := FMap.Find(S, Index);
    end;
    
    function TStringList.IndexOf(const S: string): Integer;
    begin
      Result := FMap.IndexOf(S);
    end;
    
    procedure TStringList.Insert(Index: Integer; const S: string);
    begin
      if not Sorted and (0 <= Index) and (Index < FMap.Count) then
        Changing;
      FMap.InsertKey(Index, S);
      Changed;
    end;
    
    procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
    var 
      I, J, Pivot: Integer;
    begin
      repeat
        I := L;
        J := R;
        Pivot := (L + R) div 2;
        repeat
          while CompareFn(Self, I, Pivot) < 0 do Inc(I);
          while CompareFn(Self, J, Pivot) > 0 do Dec(J);
          if I <= J then
          begin
            FMap.InternalExchange(I, J); // No check, indices are correct.
            if Pivot = I then
              Pivot := J
            else if Pivot = J then
              Pivot := I;
            Inc(I);
            Dec(j);
          end;
        until I > J;
        if L < J then 
          QuickSort(L,J, CompareFn);
        L := I;
      until I >= R;
    end;
    
    procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
    begin
      if not Sorted and (FMap.Count > 1) then
      begin
        Changing;
        QuickSort(0, FMap.Count-1, CompareFn);
        Changed;
      end;
    end;
    
    procedure TStringList.Sort;
    begin
      if not Sorted and (FMap.Count > 1) then
      begin
        Changing;
        FMap.Sort;
        Changed;
      end;
    end;
    
    {$endif}
    
    
    stringl.inc (32,035 bytes)
  • delimited_with_test_output.zip (1,479 bytes)
  • delimited3.zip (4,517 bytes)
  • delimited3.dpr (4,758 bytes)
  • del4.zip (4,890 bytes)
  • tw19610.pp (24,594 bytes)
    { Source provided for Free Pascal bug report 19610 }
    { Submitted by Reinier Olislagers on 20120920 }
    {
    Note: the tests here are somewhat more extensive than the original bug report.
    They are aimed at confirming interoperability between Delphi and FPC sdf formats
    The basis for the tests is therefore Delphi's handling.
    
    The only exception are the Put tests, which also accept results that are always
    quoted. As Get_StrictDelimTrueSafeQuote and Get_StrictDelimFalseSafeQuote prove,
    always quoting output leads to correct/the same input.
    The advantage of this is that having strictdelimiter on or off does not matter
    and the output format is more unambiguous (i.e. more compatible with RFC4180
    for CSV).
    
    On Delphi, rename to .dpr.
    
    Tests successfully completed on:
    Turbo Delphi 2006 (Reinier Olislagers)
    Delphi 2007 (OBones)
    Delphi XE (Marco van de Voort, OBones)
    Delphi XE2 Win32 (OBones)
    Delphi XE2 Win64 (OBones)
    }
    {
        This file is part of the Free Pascal packages.
        Copyright (c) 1999-2012 by the Free Pascal development team
    
        See the file COPYING.FPC, included in this distribution,
        for details about the copyright.
    
        This program is distributed in the hope that it will be useful,
        but WITHOUT ANY WARRANTY; without even the implied warranty of
        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    
     **********************************************************************}
    {$apptype console}
    {$ifdef fpc}
      {$mode objfpc}{$H+}
    {$endif fpc}
    program tw19610;
    
    uses Classes, SysUtils;
    
    {$ifndef fpc}
    //Delphi
    const
      LineEnding=#13+#10;
    {$endif}
    
    function Get_StrictDelimFalse:boolean;
    // Test if input works with Delphi-compatible sdf output
    // Strictdelimiter:=false (default) when processing the delimitedtext
    //
    // Mainly check if reading quotes is according to Delphi sdf specs and works.
    // Based on del4.zip in bug 19610
    const
      // Matches del4.zip in bug 19610:
      DelimText='normal_string;"quoted_string";"quoted;delimiter";"quoted and space";"""quoted_and_starting_quote";"""quoted, starting quote, and space";"quoted_with_tab'+#9+'character";"quoted_multi'+LineEnding+
        'line";  UnquotedSpacesInfront;UnquotedSpacesAtTheEnd   ;  "Spaces before quoted string"';
      TestName='tw19610.Get_StrictDelimFalse';
    var
      TestSL: TStringList;
      Expected: TStringList;
      i: integer;
    begin
      result:=true;
      //Expected values:
      Expected:=TStringList.Create;
      TestSL:=TStringList.Create;
      try
        Expected.Add('normal_string');
        Expected.Add('quoted_string');
        Expected.Add('quoted;delimiter');
        Expected.Add('quoted and space');
        Expected.Add('"quoted_and_starting_quote');
        Expected.Add('"quoted, starting quote, and space');
        Expected.Add('quoted_with_tab'+#9+'character');
        Expected.Add('quoted_multi'+LineEnding+
          'line');
        Expected.Add('UnquotedSpacesInfront');
        Expected.Add('UnquotedSpacesAtTheEnd');
        Expected.Add('Spaces before quoted string');
    
        TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
        TestSL.StrictDelimiter:=false;
        TestSL.DelimitedText:=DelimText;
        //Test:
        if Expected.Count<>TestSL.Count then
        begin
          writeln('');
          writeln(TestName+': failed: count mismatch: '+
          inttostr(TestSL.Count)+' test strings; '+inttostr(Expected.Count)+' expected strings.');
        end;
    
        for i:=0 to TestSL.Count-1 do
        begin
          if (Expected.Count>i) and (TestSL[i]<>Expected[i]) then
          begin
            writeln('');
            writeln(TestName+': failed: result:');
            writeln('*'+TestSL[i]+'*');
            writeln('while expected was:');
            writeln('*'+Expected[i]+'*');
            result:=false;
          end;
        end;
      finally
        Expected.Free;
        TestSL.Free;
      end;
    end;
    
    function Get_StrictDelimTrue:boolean;
    // Test if input works with Delphi-compatible sdf output
    // Strictdelimiter:=true when processing the delimitedtext
    //
    // Mainly check if reading quotes is according to Delphi sdf specs and works.
    // Based on del4.zip in bug 19610
    const
      // Matches del4.zip in bug 19610:
      DelimText='normal_string;"quoted_string";"quoted;delimiter";"quoted and space";"""quoted_and_starting_quote";"""quoted, starting quote, and space";"quoted_with_tab'+#9+'character";"quoted_multi'+LineEnding+
        'line";  UnquotedSpacesInfront;UnquotedSpacesAtTheEnd   ;  "Spaces before quoted string"';
      TestName='tw19610.Get_StrictDelimTrue';
    var
      TestSL: TStringList;
      Expected: TStringList;
      i: integer;
    begin
      result:=true;
      //Expected values:
      Expected:=TStringList.Create;
      TestSL:=TStringList.Create;
      try
        Expected.Add('normal_string');
        Expected.Add('quoted_string');
        Expected.Add('quoted;delimiter');
        Expected.Add('quoted and space');
        Expected.Add('"quoted_and_starting_quote');
        Expected.Add('"quoted, starting quote, and space');
        Expected.Add('quoted_with_tab'+#9+'character');
        Expected.Add('quoted_multi'+LineEnding+
          'line');
        Expected.Add('  UnquotedSpacesInfront');
        Expected.Add('UnquotedSpacesAtTheEnd   ');
        Expected.Add('  "Spaces before quoted string"');
    
        TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
        TestSL.StrictDelimiter:=true;
        TestSL.DelimitedText:=DelimText;
        //Test:
        if Expected.Count<>TestSL.Count then
        begin
          writeln('');
          writeln(TestName+': failed: count mismatch: '+
          inttostr(TestSL.Count)+' test strings; '+inttostr(Expected.Count)+' expected strings.');
        end;
        for i:=0 to TestSL.Count-1 do
        begin
          if (Expected.Count>i) and (TestSL[i]<>Expected[i]) then
          begin
            writeln('');
            writeln(TestName+': failed: result:');
            writeln('*'+TestSL[i]+'*');
            writeln('while expected was:');
            writeln('*'+Expected[i]+'*');
            result:=false;
          end;
        end;
      finally
        Expected.Free;
        TestSL.Free;
      end;
    end;
    
    function Get_StrictDelimFalseCornerCases:boolean;
    // Test if input works with Delphi-compatible sdf output
    // Strictdelimiter:=false (default) when processing the delimitedtext
    //
    // Has some corner cases that Delphi produces but are not evident from their
    // documentation
    // Based on del4.zip in bug 19610
    const
      // Matches del4.zip in bug 19610:
      DelimText='"Spaces after quoted string"   ;';
      TestName='tw19610.Get_StrictDelimFalseCornerCases';
    var
      TestSL: TStringList;
      Expected: TStringList;
      i: integer;
    begin
      result:=true;
      //Expected values:
      Expected:=TStringList.Create;
      TestSL:=TStringList.Create;
      try
        Expected.Add('Spaces after quoted string');
        Expected.Add('');
    
        TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
        TestSL.StrictDelimiter:=false;
        TestSL.DelimitedText:=DelimText;
        //Test:
        if Expected.Count<>TestSL.Count then
        begin
          writeln('');
          writeln(TestName+': failed: count mismatch: '+
          inttostr(TestSL.Count)+' test strings; '+inttostr(Expected.Count)+' expected strings.');
        end;
        for i:=0 to TestSL.Count-1 do
        begin
          if (Expected.Count>i) and (TestSL[i]<>Expected[i]) then
          begin
            writeln('');
            writeln(TestName+': failed: result:');
            writeln('*'+TestSL[i]+'*');
            writeln('while expected was:');
            writeln('*'+Expected[i]+'*');
            result:=false;
          end;
        end;
      finally
        Expected.Free;
        TestSL.Free;
      end;
    end;
    
    function Get_StrictDelimTrueCornerCases:boolean;
    // Test if input works with Delphi-compatible sdf output
    // Strictdelimiter:=true when processing the delimitedtext
    //
    // Has some corner cases that Delphi produces but are not evident from their
    // documentation
    // Based on del4.zip in bug 19610
    const
      // Matches del4.zip in bug 19610:
      DelimText='"Spaces after quoted string"   ;';
      TestName='tw19610.Get_StrictDelimTrueCornerCases';
    var
      TestSL: TStringList;
      Expected: TStringList;
      i: integer;
    begin
      result:=true;
      //Expected values:
      Expected:=TStringList.Create;
      TestSL:=TStringList.Create;
      try
        // With delimiter true, we get 2 extra empty lines, also some spaces
        Expected.Add('Spaces after quoted string');
        Expected.Add('   ');
        Expected.Add('');
    
        TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
        TestSL.StrictDelimiter:=true;
        TestSL.DelimitedText:=DelimText;
        //Test:
        if Expected.Count<>TestSL.Count then
        begin
          writeln('');
          writeln(TestName+': failed: count mismatch: '+
          inttostr(TestSL.Count)+' test strings; '+inttostr(Expected.Count)+' expected strings.');
        end;
        for i:=0 to TestSL.Count-1 do
        begin
          if (Expected.Count>i) and (TestSL[i]<>Expected[i]) then
          begin
            writeln('');
            writeln(TestName+': failed: result:');
            writeln('*'+TestSL[i]+'*');
            writeln('while expected was:');
            writeln('*'+Expected[i]+'*');
            result:=false;
          end;
        end;
      finally
        Expected.Free;
        TestSL.Free;
      end;
    end;
    
    function Get_StrictDelimTrueSafeQuote:boolean;
    // Test if input works with sdf output that has always been quoted
    // Delphi accepts this input even though it does not write it by default
    // This is a more unambiguous format than unquoted
    // Strictdelimiter:=true when processing the delimitedtext
    //
    const
      DelimText='"normal_string";"""quoted_string""";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"string_with_tab'+#9+'character";"multi'+LineEnding+
        'line";"  SpacesInfront";"SpacesAtTheEnd   ";"  ""Spaces before quoted string"""';
      TestName='tw19610.Get_StrictDelimTrueSafeQuote';
    var
      TestSL: TStringList;
      Expected: TStringList;
      i: integer;
    begin
      result:=true;
      //Expected values:
      Expected:=TStringList.Create;
      TestSL:=TStringList.Create;
      try
        Expected.Add('normal_string');
        Expected.Add('"quoted_string"');
        Expected.Add('"quoted;delimiter"');
        Expected.Add('"quoted and space"');
        Expected.Add('"starting_quote');
        Expected.Add('string_with_tab'+#9+'character');
        Expected.Add('multi'+LineEnding+
          'line');
        Expected.Add('  SpacesInfront');
        Expected.Add('SpacesAtTheEnd   ');
        Expected.Add('  "Spaces before quoted string"');
    
        TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
        TestSL.StrictDelimiter:=true;
        TestSL.DelimitedText:=DelimText;
        //Test:
        if Expected.Count<>TestSL.Count then
        begin
          writeln('');
          writeln(TestName+': failed: count mismatch: '+
          inttostr(TestSL.Count)+' test strings; '+inttostr(Expected.Count)+' expected strings.');
        end;
        for i:=0 to TestSL.Count-1 do
        begin
          if (Expected.Count>i) and (TestSL[i]<>Expected[i]) then
          begin
            writeln('');
            writeln(TestName+': failed: result:');
            writeln('*'+TestSL[i]+'*');
            writeln('while expected was:');
            writeln('*'+Expected[i]+'*');
            result:=false;
          end;
        end;
      finally
        Expected.Free;
        TestSL.Free;
      end;
    end;
    
    function Get_StrictDelimFalseSafeQuote:boolean;
    // Test if input works with sdf output that has always been quoted
    // Delphi accepts this input even though it does not write it by default
    // This is a more unambiguous format than unquoted
    // Strictdelimiter:=false when processing the delimitedtext
    //
    const
      DelimText='"normal_string";"""quoted_string""";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"string_with_tab'+#9+'character";"multi'+LineEnding+
        'line";"  SpacesInfront";"SpacesAtTheEnd   ";"  ""Spaces before quoted string"""';
      TestName='tw19610.Get_StrictDelimTrueSafeQuote';
    var
      TestSL: TStringList;
      Expected: TStringList;
      i: integer;
    begin
      result:=true;
      //Expected values:
      Expected:=TStringList.Create;
      TestSL:=TStringList.Create;
      try
        Expected.Add('normal_string');
        Expected.Add('"quoted_string"');
        Expected.Add('"quoted;delimiter"');
        Expected.Add('"quoted and space"');
        Expected.Add('"starting_quote');
        Expected.Add('string_with_tab'+#9+'character');
        Expected.Add('multi'+LineEnding+
          'line');
        Expected.Add('  SpacesInfront');
        Expected.Add('SpacesAtTheEnd   ');
        Expected.Add('  "Spaces before quoted string"');
    
        TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
        TestSL.StrictDelimiter:=false;
        TestSL.DelimitedText:=DelimText;
        //Test:
        if Expected.Count<>TestSL.Count then
        begin
          writeln('');
          writeln(TestName+': failed: count mismatch: '+
          inttostr(TestSL.Count)+' test strings; '+inttostr(Expected.Count)+' expected strings.');
        end;
        for i:=0 to TestSL.Count-1 do
        begin
          if (Expected.Count>i) and (TestSL[i]<>Expected[i]) then
          begin
            writeln('');
            writeln(TestName+': failed: result:');
            writeln('*'+TestSL[i]+'*');
            writeln('while expected was:');
            writeln('*'+Expected[i]+'*');
            result:=false;
          end;
        end;
      finally
        Expected.Free;
        TestSL.Free;
      end;
    end;
    
    function Get_Commatext:boolean;
    // Test if input works with Delphi-compatible commatext
    const
      CommaText='normal_string,"quoted_string","quoted,delimiter","quoted and space","""quoted_and_starting_quote","""quoted, starting quote, and space","quoted_with_tab'+#9+'character","quoted_multi'+LineEnding+
        'line","  UnquotedSpacesInfront","UnquotedSpacesAtTheEnd   ","  ""Spaces before quoted string"""';
      TestName='tw19610.Get_Commatext';
    var
      TestSL: TStringList;
      Expected: TStringList;
      i: integer;
    begin
      result:=true;
      //Expected values:
      Expected:=TStringList.Create;
      TestSL:=TStringList.Create;
      try
        Expected.Add('normal_string');
        Expected.Add('quoted_string');
        Expected.Add('quoted,delimiter');
        Expected.Add('quoted and space');
        Expected.Add('"quoted_and_starting_quote');
        Expected.Add('"quoted, starting quote, and space');
        Expected.Add('quoted_with_tab'+#9+'character');
        Expected.Add('quoted_multi'+LineEnding+
          'line');
        Expected.Add('  UnquotedSpacesInfront');
        Expected.Add('UnquotedSpacesAtTheEnd   ');
        Expected.Add('  "Spaces before quoted string"');
    
        TestSL.CommaText:=CommaText;
        //Test:
        if Expected.Count<>TestSL.Count then
        begin
          writeln('');
          writeln(TestName+': failed: count mismatch: '+
          inttostr(TestSL.Count)+' test strings; '+inttostr(Expected.Count)+' expected strings.');
        end;
    
        for i:=0 to TestSL.Count-1 do
        begin
          if (Expected.Count>i) and (TestSL[i]<>Expected[i]) then
          begin
            writeln('');
            writeln(TestName+': failed: result:');
            writeln('*'+TestSL[i]+'*');
            writeln('while expected was:');
            writeln('*'+Expected[i]+'*');
            result:=false;
          end;
        end;
      finally
        Expected.Free;
        TestSL.Free;
      end;
    end;
    
    
    function Put_StrictDelimFalse:boolean;
    // Test if conversion stringlist=>delimitedtext gives the right data
    // (right in this case: what Delphi outputs)
    // Strictdelimiter:=false when processing the delimitedtext
    const
      Expected='normal_string;"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";"with_tab'+#9+'character";"multi'+LineEnding+
        'line";"   UnquotedSpacesInfront";"UnquotedSpacesAtTheEnd  ";"  ""Spaces before quoted string"""';
      //If we choose to output the "safely quoted" version, we need to test for it:
      //Though this version is not the same output as Delphi, it leads to the
      //same input if imported again (see Get_StrictDelimFalseSafeQuote for corresponding tests)
      ExpectedSafeQuote='"normal_string";"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";"with_tab'+#9+'character";"multi'+LineEnding+
        'line";"   UnquotedSpacesInfront";"UnquotedSpacesAtTheEnd  ";"  ""Spaces before quoted string"""';
      TestName='tw19610.Put_StrictDelimFalse';
    var
      TestSL: TStringList;
    begin
      result:=true;
      TestSL:=TStringList.Create;
      try
        TestSL.Add('normal_string');
        TestSL.Add('"quoted_string"');
        TestSL.Add('just;delimiter');
        TestSL.Add('"quoted;delimiter"');
        TestSL.Add('"quoted and space"');
        TestSL.Add('"starting_quote');
        TestSL.Add('single"quote');
        TestSL.Add('""quoted starting quote and space"');
        TestSL.Add('with_tab'+#9+'character');
        TestSL.Add('multi'+LineEnding+
          'line');
        TestSL.Add('   UnquotedSpacesInfront');
        TestSL.Add('UnquotedSpacesAtTheEnd  ');
        TestSL.Add('  "Spaces before quoted string"');
    
        TestSL.Delimiter:=';';
        TestSL.StrictDelimiter:=false;
        if (TestSL.DelimitedText<>Expected) and (TestSL.DelimitedText<>ExpectedSafeQuote) then
        begin
          writeln('');
          writeln(TestName+': failed: result:');
          writeln('*'+TestSL.DelimitedText+'*');
          writeln('while expected was:');
          writeln('*'+Expected+'*');
          writeln('- or, with safe quote output:');
          writeln('*'+ExpectedSafeQuote+'*');
          result:=false
        end;
      finally
        TestSL.Free;
      end;
    end;
    
    function Put_StrictDelimTrue:boolean;
    // Test if conversion stringlist=>delimitedtext gives the right data
    // (right in this case: what Delphi outputs)
    // Strictdelimiter:=true when processing the delimitedtext
    const
      Expected='normal_string;"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";with_tab'+#9+'character;multi'+LineEnding+
        'line;   UnquotedSpacesInfront;UnquotedSpacesAtTheEnd  ;"  ""Spaces before quoted string"""';
      //If we choose to output the "safely quoted" version, we need to test for it:
      //Though this version is not the same output as Delphi, it leads to the
      //same input if imported again (see Get_StrictDelimTrueSafeQuote for corresponding tests)
      ExpectedSafeQuote='"normal_string";"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";"with_tab'+#9+'character";"multi'+LineEnding+
        'line";"   UnquotedSpacesInfront";"UnquotedSpacesAtTheEnd  ";"  ""Spaces before quoted string"""';
      TestName='tw19610.Put_StrictDelimTrue';
    var
      TestSL: TStringList;
    begin
      result:=true;
      TestSL:=TStringList.Create;
      try
        TestSL.Add('normal_string');
        TestSL.Add('"quoted_string"');
        TestSL.Add('just;delimiter');
        TestSL.Add('"quoted;delimiter"');
        TestSL.Add('"quoted and space"');
        TestSL.Add('"starting_quote');
        TestSL.Add('single"quote');
        TestSL.Add('""quoted starting quote and space"');
        TestSL.Add('with_tab'+#9+'character');
        TestSL.Add('multi'+LineEnding+
          'line');
        TestSL.Add('   UnquotedSpacesInfront');
        TestSL.Add('UnquotedSpacesAtTheEnd  ');
        TestSL.Add('  "Spaces before quoted string"');
    
        TestSL.Delimiter:=';';
        TestSL.StrictDelimiter:=true;
        if (TestSL.DelimitedText<>Expected) and (TestSL.DelimitedText<>ExpectedSafeQuote) then
        begin
          writeln('');
          writeln(TestName+': failed: result:');
          writeln('*'+TestSL.DelimitedText+'*');
          writeln('while expected was:');
          writeln('*'+Expected+'*');
          writeln('- or, with safe quote output:');
          writeln('*'+ExpectedSafeQuote+'*');
          result:=false
        end;
      finally
        TestSL.Free;
      end;
    end;
    
    function GetPut_StrictDelimFalse:boolean;
    // Test if conversion stringlist=>delimitedtext=>stringlist gives identical data
    // Strictdelimiter:=false (default) when processing the delimitedtext
    const
      TestName='tw19610.GetPut_StrictDelimFalse';
    var
      TestSL: TStringList;
      ResultSL: TStringList;
      i: integer;
    begin
      result:=true;
      ResultSL:=TStringList.Create;
      TestSL:=TStringList.Create;
      try
        TestSL.Add('normal_string');
        TestSL.Add('"quoted_string"');
        TestSL.Add('"quoted;delimiter"');
        TestSL.Add('"quoted and space"');
        TestSL.Add('"starting_quote');
        TestSL.Add('""quoted, starting quote, and space"');
        TestSL.Add('with_tab'+#9+'character');
        TestSL.Add('multi'+LineEnding+
          'line');
        TestSL.Add('   UnquotedSpacesInfront');
        TestSL.Add('UnquotedSpacesAtTheEnd  ');
        TestSL.Add('  "Spaces before quoted string"');
    
        TestSL.Delimiter:=';';
        TestSL.StrictDelimiter:=false;
        ResultSL.Delimiter:=';';
        ResultSL.StrictDelimiter:=false;
        ResultSL.DelimitedText:=TestSL.DelimitedText;
        //Test:
        if ResultSL.Count<>TestSL.Count then
        begin
          writeln('');
          writeln(TestName+': failed: count mismatch: '+
          inttostr(TestSL.Count)+' test strings; '+inttostr(ResultSL.Count)+' expected strings.');
        end;
    
        for i:=0 to TestSL.Count-1 do
        begin
          if (ResultSL.Count>i) and (TestSL[i]<>ResultSL[i]) then
          begin
            writeln('');
            writeln(TestName+': failed: result:');
            writeln('*'+TestSL[i]+'*');
            writeln('while expected was:');
            writeln('*'+ResultSL[i]+'*');
            result:=false;
          end;
        end;
      finally
        ResultSL.Free;
        TestSL.Free;
      end;
    end;
    
    function GetPut_StrictDelimTrue:boolean;
    // Test if conversion stringlist=>delimitedtext=>stringlist gives identical data
    // Strictdelimiter:=true when processing the delimitedtext
    const
      TestName='tw19610.GetPut_StrictDelimTrue';
    var
      TestSL: TStringList;
      ResultSL: TStringList;
      i: integer;
    begin
      result:=true;
      ResultSL:=TStringList.Create;
      TestSL:=TStringList.Create;
      try
        TestSL.Add('normal_string');
        TestSL.Add('"quoted_string"');
        TestSL.Add('"quoted;delimiter"');
        TestSL.Add('"quoted and space"');
        TestSL.Add('"starting_quote');
        TestSL.Add('""quoted, starting quote, and space"');
        TestSL.Add('with_tab'+#9+'character');
        TestSL.Add('multi'+LineEnding+
          'line');
        TestSL.Add('   UnquotedSpacesInfront');
        TestSL.Add('UnquotedSpacesAtTheEnd  ');
        TestSL.Add('  "Spaces before quoted string"');
    
        TestSL.Delimiter:=';';
        TestSL.StrictDelimiter:=false;
        ResultSL.Delimiter:=';';
        ResultSL.StrictDelimiter:=true;
        ResultSL.DelimitedText:=TestSL.DelimitedText;
        //Test:
        if ResultSL.Count<>TestSL.Count then
        begin
          writeln('');
          writeln(TestName+': failed: count mismatch: '+
          inttostr(TestSL.Count)+' test strings; '+inttostr(ResultSL.Count)+' expected strings.');
        end;
    
        for i:=0 to TestSL.Count-1 do
        begin
          if (ResultSL.Count>i) and (TestSL[i]<>ResultSL[i]) then
          begin
            writeln('');
            writeln(TestName+': failed: result:');
            writeln('*'+TestSL[i]+'*');
            writeln('while expected was:');
            writeln('*'+ResultSL[i]+'*');
            result:=false;
          end;
        end;
      finally
        ResultSL.Free;
        TestSL.Free;
      end;
    end;
    
    var
      FailCount: integer;
    begin
      FailCount:=0;
      // The Get_... tests load in delimitedtext and test the resulting stringlist:
      if not(Get_StrictDelimFalse) then FailCount:=FailCount+1;
      if not(Get_StrictDelimTrue) then FailCount:=FailCount+1;
      if not(Get_StrictDelimFalseCornerCases) then FailCount:=FailCount+1;
      if not(Get_StrictDelimTrueCornerCases) then FailCount:=FailCount+1;
      if not(Get_StrictDelimTrueSafeQuote) then FailCount:=FailCount+1;
      if not(Get_StrictDelimFalseSafeQuote) then FailCount:=FailCount+1;
    
      if not(Get_CommaText) then FailCount:=FailCount+1;
    
      // The Put_... tests load strings and test the resulting delimitedtext:
      if not(Put_StrictDelimFalse) then FailCount:=FailCount+1;
      if not(Put_StrictDelimTrue) then FailCount:=FailCount+1;
    
      // Test writing to delimitedtext and reading from delimitedtext:
      if not(GetPut_StrictDelimFalse) then FailCount:=FailCount+1;
      if not(GetPut_StrictDelimTrue) then FailCount:=FailCount+1;
    
      // Indicate success or failure to test framework:
      if FailCount=0 then
      begin
        writeln('');
        writeln('tw19610: sdf tests succeeded.');
      end
      else
      begin
        writeln('');
        writeln('tw19610: sdf test(s) failed. Number of failed test group(s): '+inttostr(FailCount));
      end;
    
      halt(FailCount);
    end.
    
    tw19610.pp (24,594 bytes)
  • DelimitedText2_unixlineending.diff (3,389 bytes)
    Index: rtl/objpas/classes/stringl.inc
    ===================================================================
    --- rtl/objpas/classes/stringl.inc	(revision 20119)
    +++ rtl/objpas/classes/stringl.inc	(working copy)
    @@ -140,30 +140,33 @@
     Var
       I : integer;
       p : pchar;
    -  c : set of char;
    +  BreakChars : set of char;
       S : String;
       
     begin
       CheckSpecialChars;
       result:='';
       if StrictDelimiter then
    -    c:=[#0,Delimiter]
    +    BreakChars:=[#0,QuoteChar,Delimiter]
       else  
    -    c:=[#0..' ',QuoteChar,Delimiter];
    +    BreakChars:=[#0..' ',QuoteChar,Delimiter];
    +
    +  // Check for break characters and quote if required.
       For i:=0 to count-1 do
         begin
         S:=Strings[i];
         p:=pchar(S);
    -    while not(p^ in c) do
    +    //Quote strings that include BreakChars:
    +    while not(p^ in BreakChars) do
          inc(p);
    -// strings in list may contain #0
    -    if (p<>pchar(S)+length(S)) and not StrictDelimiter then
    +    if (p<>pchar(S)+length(S)) then
           Result:=Result+QuoteString(S,QuoteChar)
         else
           Result:=Result+S;
         if I<Count-1 then 
           Result:=Result+Delimiter;
         end;
    +  // Quote empty string:
       If (Length(Result)=0) and (Count=1) then
         Result:=QuoteChar+QuoteChar;
     end;
    @@ -268,22 +271,48 @@
      j:=1;
      aNotFirst:=false;
     
    + { Paraphrased from Delphi XE2 help:
    + Strings must be separated by Delimiter characters or spaces.
    + They may be enclosed in QuoteChars.
    + QuoteChars in the string must be repeated to distinguish them from the QuoteChars enclosing the string.
    + }
      try
       Clear;
       If StrictDelimiter then
         begin
    -    // Easier, faster loop.
    -    While I<=Length(AValue) do
    -      begin
    -      If (AValue[I] in [FDelimiter,#0]) then
    -        begin
    -        Add(Copy(AValue,J,I-J));
    -        J:=I+1;
    -        end;
    -      Inc(i);
    +    while i<=length(AValue) do begin
    +     // skip delimiter
    +     if aNotFirst and (i<=length(AValue)) and (AValue[i]=FDelimiter) then inc(i);
    +
    +     // read next string
    +     if i<=length(AValue) then begin
    +      if AValue[i]=FQuoteChar then begin
    +       // next string is quoted
    +       j:=i+1;
    +       while (j<=length(AValue)) and
    +             ( (AValue[j]<>FQuoteChar) or
    +               ( (j+1<=length(AValue)) and (AValue[j+1]=FQuoteChar) ) ) do begin
    +        if (j<=length(AValue)) and (AValue[j]=FQuoteChar) then inc(j,2)
    +                                                          else inc(j);
    +       end;
    +       // j is position of closing quote
    +       Add( StringReplace (Copy(AValue,i+1,j-i-1),
    +                           FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
    +       i:=j+1;
    +      end else begin
    +       // next string is not quoted; read until delimiter
    +       j:=i;
    +       while (j<=length(AValue)) and
    +             (AValue[j]<>FDelimiter) do inc(j);
    +       Add( Copy(AValue,i,j-i));
    +       i:=j;
           end;
    -    If (Length(AValue)>0) then
    -      Add(Copy(AValue,J,I-J));  
    +     end else begin
    +      if aNotFirst then Add('');
    +     end;
    +
    +     aNotFirst:=true;
    +    end;
         end
       else 
         begin
    @@ -310,7 +339,7 @@
                                FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
            i:=j+1;
           end else begin
    -       // next string is not quoted
    +       // next string is not quoted; read until control character/space/delimiter
            j:=i;
            while (j<=length(AValue)) and
                  (Ord(AValue[j])>Ord(' ')) and
    
  • tw19610_testsbefore.txt (5,103 bytes)
    tw19610.Get_StrictDelimTrue: failed: count mismatch: 12 test strings; 11 expected strings.
    
    tw19610.Get_StrictDelimTrue: failed: result:
    *"quoted_string"*
    while expected was:
    *quoted_string*
    
    tw19610.Get_StrictDelimTrue: failed: result:
    *"quoted*
    while expected was:
    *quoted;delimiter*
    
    tw19610.Get_StrictDelimTrue: failed: result:
    *delimiter"*
    while expected was:
    *quoted and space*
    
    tw19610.Get_StrictDelimTrue: failed: result:
    *"quoted and space"*
    while expected was:
    *"quoted_and_starting_quote*
    
    tw19610.Get_StrictDelimTrue: failed: result:
    *"""quoted_and_starting_quote"*
    while expected was:
    *"quoted, starting quote, and space*
    
    tw19610.Get_StrictDelimTrue: failed: result:
    *"""quoted, starting quote, and space"*
    while expected was:
    *quoted_with_tab	character*
    
    tw19610.Get_StrictDelimTrue: failed: result:
    *"quoted_with_tab	character"*
    while expected was:
    *quoted_multi
    line*
    
    tw19610.Get_StrictDelimTrue: failed: result:
    *"quoted_multi
    line"*
    while expected was:
    *  UnquotedSpacesInfront*
    
    tw19610.Get_StrictDelimTrue: failed: result:
    *  UnquotedSpacesInfront*
    while expected was:
    *UnquotedSpacesAtTheEnd   *
    
    tw19610.Get_StrictDelimTrue: failed: result:
    *UnquotedSpacesAtTheEnd   *
    while expected was:
    *  "Spaces before quoted string"*
    
    tw19610.Get_StrictDelimTrueCornerCases: failed: count mismatch: 2 test strings; 3 expected strings.
    
    tw19610.Get_StrictDelimTrueCornerCases: failed: result:
    *"Spaces after quoted string"   *
    while expected was:
    *Spaces after quoted string*
    
    tw19610.Get_StrictDelimTrueCornerCases: failed: result:
    **
    while expected was:
    *   *
    
    tw19610.Get_StrictDelimTrueSafeQuote: failed: count mismatch: 11 test strings; 10 expected strings.
    
    tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
    *"normal_string"*
    while expected was:
    *normal_string*
    
    tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
    *"""quoted_string"""*
    while expected was:
    *"quoted_string"*
    
    tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
    *"""quoted*
    while expected was:
    *"quoted;delimiter"*
    
    tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
    *delimiter"""*
    while expected was:
    *"quoted and space"*
    
    tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
    *"""quoted and space"""*
    while expected was:
    *"starting_quote*
    
    tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
    *"""starting_quote"*
    while expected was:
    *string_with_tab	character*
    
    tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
    *"string_with_tab	character"*
    while expected was:
    *multi
    line*
    
    tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
    *"multi
    line"*
    while expected was:
    *  SpacesInfront*
    
    tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
    *"  SpacesInfront"*
    while expected was:
    *SpacesAtTheEnd   *
    
    tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
    *"SpacesAtTheEnd   "*
    while expected was:
    *  "Spaces before quoted string"*
    
    tw19610.Put_StrictDelimTrue: failed: result:
    *normal_string;"quoted_string";just;delimiter;"quoted;delimiter";"quoted and space";"starting_quote;single"quote;""quoted starting quote and space";with_tab	character;multi
    line;   UnquotedSpacesInfront;UnquotedSpacesAtTheEnd  ;  "Spaces before quoted string"*
    while expected was:
    *normal_string;"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";with_tab	character;multi
    line;   UnquotedSpacesInfront;UnquotedSpacesAtTheEnd  ;"  ""Spaces before quoted string"""*
    - or, with safe quote output:
    *"normal_string";"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";"with_tab	character";"multi
    line";"   UnquotedSpacesInfront";"UnquotedSpacesAtTheEnd  ";"  ""Spaces before quoted string"""*
    
    tw19610.GetPut_StrictDelimTrue: failed: count mismatch: 11 test strings; 12 expected strings.
    
    tw19610.GetPut_StrictDelimTrue: failed: result:
    *"quoted_string"*
    while expected was:
    *"""quoted_string"""*
    
    tw19610.GetPut_StrictDelimTrue: failed: result:
    *"quoted;delimiter"*
    while expected was:
    *"""quoted*
    
    tw19610.GetPut_StrictDelimTrue: failed: result:
    *"quoted and space"*
    while expected was:
    *delimiter"""*
    
    tw19610.GetPut_StrictDelimTrue: failed: result:
    *"starting_quote*
    while expected was:
    *"""quoted and space"""*
    
    tw19610.GetPut_StrictDelimTrue: failed: result:
    *""quoted, starting quote, and space"*
    while expected was:
    *"""starting_quote"*
    
    tw19610.GetPut_StrictDelimTrue: failed: result:
    *with_tab	character*
    while expected was:
    *"""""quoted, starting quote, and space"""*
    
    tw19610.GetPut_StrictDelimTrue: failed: result:
    *multi
    line*
    while expected was:
    *"with_tab	character"*
    
    tw19610.GetPut_StrictDelimTrue: failed: result:
    *   UnquotedSpacesInfront*
    while expected was:
    *"multi
    line"*
    
    tw19610.GetPut_StrictDelimTrue: failed: result:
    *UnquotedSpacesAtTheEnd  *
    while expected was:
    *"   UnquotedSpacesInfront"*
    
    tw19610.GetPut_StrictDelimTrue: failed: result:
    *  "Spaces before quoted string"*
    while expected was:
    *"UnquotedSpacesAtTheEnd  "*
    
    tw19610: sdf test(s) failed. Number of failed test group(s): 5
    
    tw19610_testsbefore.txt (5,103 bytes)

Relationships

related to 0022182 resolvedBart Broersma Lazarus TStringGrid.LoadFromCSVFile: incorrect handling of unquoted spaces and quoted fields with delimiters 
parent of 0022939 closedMichael Van Canneyt FPC TStrings.Strictdelimiter does read quoted delimiters 

Activities

2011-06-22 10:41

 

strl.pp (537 bytes)
{$ifdef fpc}
  {$mode delphi}
{$else}
  {$apptype console}
{$endif}

uses classes;

var j : Integer;
    y : TStringList; 
begin
 y:=TStringList.create;
 y.strictdelimiter:=true;
 y.delimiter:=';';
 y.quotechar:='"';
 y.delimitedtext:='"Avl_Tree";"base";"common";"base";"AVL tree, used by laz*xml"';
 for j:=0 to y.count-1 do
   writeln(j,y[j]);
end.

FPC output:
0"Avl_Tree"
1"base"
2"common"
3"base"
4"AVL tree, used by laz*xml"

Delphi output:
0Avl_Tree
1base
2common
3base
4AVL tree, used by laz*xml
strl.pp (537 bytes)

Reinier Olislagers

2012-01-20 07:46

developer   ~0055872

Last edited: 2012-01-20 09:27

Not only aren't quotechars not trimmed, the FPC code can't handle delimiters inside the string when properly quoted.

Not only setting delimitedtext differs from Delphi, getting delimitedtext differs as well.

See expanded sample program; output:
==================================================
Turbo Delphi 2006 output:
Assigning delimitedtext:
0normal_string
1quoted_string
2quote;delimiter
3quote and space
4
5starting_quotes
6

Retrieving delimitedtext:
normal_string;"includes;delimiter";includes space;"includes""quote";"""single starting quote"

FPC fixes_2.6 output:
Assigning delimitedtext:
0normal_string
1"quoted_string"
2"quote
3delimiter"
4"quote and space"
5""starting_quotes
6

Retrieving delimitedtext:
normal_string;includes;delimiter;includes space;includes"quote;"single starting quote
==================================================
Paraphrased from Delphi help
http://docwiki.embarcadero.com/VCL/en/Classes.TStrings.DelimitedText
If you get DelimitedText, strings that include spaces, Delimiter or QuoteChar will be enclosed in QuoteChars. (Seems that my Turbo Delphi did not enclose spaced text in quotechars though, maybe fixed in XE2; or their cryptic sentence here leads me to misunderstand)
In addition, a QuoteChar in a string will be repeated.

When setting DelimitedText, strings must be separated by Delimiter characters or spaces.
They may be enclosed in QuoteChars. => could it be a good idea to always write quotechars when getting Delimitedtext, as setting it must support it? Though this will increase size, it's probably less bug-prone...

QuoteChars in the string must be repeated to distinguish them from the QuoteChars enclosing the string.

Spaces and Delimiters that are not contained within QuoteChar marks are delimiters.
Two Delimiters in a row indicate an empty string
==================================================
Attached a patch that seems to fix both assignment and retrieval cases (patch against fixes_2.6); going to expand test program to include StrictDelimiter:=false before final submission.

2012-01-20 07:46

 

delimitedtext.pas (2,079 bytes)
program delimitedtext;

{$ifdef fpc}
  {$mode delphi}
{$else}
  {$apptype console}
{$endif}

uses classes;

var j : Integer;
    y : TStringList; 
begin
 y:=TStringList.create;
 y.strictdelimiter:=true;
 y.delimiter:=';';
 y.quotechar:='"';
 //Note Turbo Delphi 2006 sees the null character as end of file, so we can't test NUL characters.
 //Note that we leave a delimiter at the end of the string on purpose.
 y.delimitedtext:='normal_string;"quoted_string";"quote;delimiter";"quote and space";""starting_quotes;';
 writeln('Assigning delimitedtext:');
 for j:=0 to y.count-1 do
   writeln(j,y[j]);
 writeln('');
 y.clear;
 y.add('normal_string');
 y.add('includes;delimiter');
 y.add('includes space');
 y.add('includes"quote'); 
 y.add('"single starting quote');
 writeln('Retrieving delimitedtext:');
 writeln(y.delimitedtext);
end.

{
Turbo Delphi 2006 output:
Assigning delimitedtext:
0normal_string
1quoted_string
2quote;delimiter
3quote and space
4
5starting_quotes
6

Retrieving delimitedtext:
normal_string;"includes;delimiter";includes space;"includes""quote";"""single starting quote"

FPC fixes_2.6 output:
Assigning delimitedtext:
0normal_string
1"quoted_string"
2"quote
3delimiter"
4"quote and space"
5""starting_quotes
6

Retrieving delimitedtext:
normal_string;includes;delimiter;includes space;includes"quote;"single starting quote


Paraphrased from
http://docwiki.embarcadero.com/VCL/en/Classes.TStrings.DelimitedText
If you get DelimitedText, strings that include spaces, Delimiter or QuoteChar will be enclosed QuoteChars. 
In addition, any QuoteChar character contained in an individual string will be repeated.

When setting DelimitedText strings must be separated by Delimiter characters or spaces.
They may be enclosed in QuoteChars.

QuoteChars in the string must be repeated to distinguish them from the QuoteChars enclosing the string.

Spaces and Delimiters that are not contained within QuoteChar marks are delimiters.
Two Delimiters in a row indicate an empty string

}
delimitedtext.pas (2,079 bytes)

Marco van de Voort

2012-01-20 08:50

manager   ~0055874

(Delphi XE output is the same as Turbo Delphi's)

2012-01-20 09:27

 

DelimitedText.diff (3,842 bytes)
Index: rtl/objpas/classes/stringl.inc
===================================================================
--- rtl/objpas/classes/stringl.inc	(revision 20119)
+++ rtl/objpas/classes/stringl.inc	(working copy)
@@ -140,30 +140,33 @@
 Var
   I : integer;
   p : pchar;
-  c : set of char;
+  BreakChars : set of char;
   S : String;
   
 begin
   CheckSpecialChars;
   result:='';
   if StrictDelimiter then
-    c:=[#0,Delimiter]
+    BreakChars:=[#0,QuoteChar,Delimiter]
   else  
-    c:=[#0..' ',QuoteChar,Delimiter];
+    BreakChars:=[#0..' ',QuoteChar,Delimiter];
+  // Check for break characters and quote if required.
   For i:=0 to count-1 do
     begin
     S:=Strings[i];
     p:=pchar(S);
-    while not(p^ in c) do
+    //strings that include spaces, Delimiter or QuoteChar will be enclosed in QuoteChars.
+    //Note: unclear what happens to control codes when strictdelimiter is on
+    while not(p^ in BreakChars) do
      inc(p);
-// strings in list may contain #0
-    if (p<>pchar(S)+length(S)) and not StrictDelimiter then
+    if (p<>pchar(S)+length(S)) then
       Result:=Result+QuoteString(S,QuoteChar)
     else
       Result:=Result+S;
     if I<Count-1 then 
       Result:=Result+Delimiter;
     end;
+  // Quote empty string:
   If (Length(Result)=0) and (Count=1) then
     Result:=QuoteChar+QuoteChar;
 end;
@@ -268,26 +271,58 @@
  j:=1;
  aNotFirst:=false;
 
+ {
+ Strings must be separated by Delimiter characters or spaces.
+ They may be enclosed in QuoteChars.
+ QuoteChars in the string must be repeated to distinguish them from the QuoteChars enclosing the string.
+ }
  try
   Clear;
   If StrictDelimiter then
     begin
-    // Easier, faster loop.
-    While I<=Length(AValue) do
-      begin
-      If (AValue[I] in [FDelimiter,#0]) then
-        begin
-        Add(Copy(AValue,J,I-J));
-        J:=I+1;
-        end;
-      Inc(i);
+    while i<=length(AValue) do begin
+     // todo: add check for double quotes
+     // """single starting quote" => "single starting quote
+
+     // skip delimiter
+     if aNotFirst and (i<=length(AValue)) and (AValue[i]=FDelimiter) then inc(i);
+
+     // read next string
+     if i<=length(AValue) then begin
+      if AValue[i]=FQuoteChar then begin
+       // next string is quoted
+       j:=i+1;
+       while (j<=length(AValue)) and
+             ( (AValue[j]<>FQuoteChar) or
+               ( (j+1<=length(AValue)) and (AValue[j+1]=FQuoteChar) ) ) do begin
+        if (j<=length(AValue)) and (AValue[j]=FQuoteChar) then inc(j,2)
+                                                          else inc(j);
+       end;
+       // j is position of closing quote
+       Add( StringReplace (Copy(AValue,i+1,j-i-1),
+                           FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
+       i:=j+1;
+      end else begin
+       // next string is not quoted; read until delimiter
+       j:=i;
+       while (j<=length(AValue)) and
+             (AValue[j]<>FDelimiter) do inc(j);
+       Add( Copy(AValue,i,j-i));
+       i:=j;
       end;
-    If (Length(AValue)>0) then
-      Add(Copy(AValue,J,I-J));  
+     end else begin
+      if aNotFirst then Add('');
+     end;
+
+     aNotFirst:=true;
+    end;
     end
   else 
     begin
     while i<=length(AValue) do begin
+     // todo: add check for double quotes
+     // """single starting quote" => "single starting quote
+
      // skip delimiter
      if aNotFirst and (i<=length(AValue)) and (AValue[i]=FDelimiter) then inc(i);
 
@@ -310,7 +345,7 @@
                            FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
        i:=j+1;
       end else begin
-       // next string is not quoted
+       // next string is not quoted; read until control character/space/delimiter
        j:=i;
        while (j<=length(AValue)) and
              (Ord(AValue[j])>Ord(' ')) and
DelimitedText.diff (3,842 bytes)

Reinier Olislagers

2012-01-20 09:38

developer   ~0055876

Last edited: 2012-01-31 16:28

Thanks, Marco.

Updated test program to also include StrictDelimiter:=false.
Output between Turbo Delphi 2006 and patched fixes_2.6 is the same.

Edit: <<uploaded program and test runs on Turbo Delphi and patched FPC as delimited_with_test_output.zip>>

2012-01-20 10:12

 

DelimitedText2.diff (3,396 bytes)
Index: rtl/objpas/classes/stringl.inc
===================================================================
--- rtl/objpas/classes/stringl.inc	(revision 20119)
+++ rtl/objpas/classes/stringl.inc	(working copy)
@@ -140,30 +140,33 @@
 Var
   I : integer;
   p : pchar;
-  c : set of char;
+  BreakChars : set of char;
   S : String;
   
 begin
   CheckSpecialChars;
   result:='';
   if StrictDelimiter then
-    c:=[#0,Delimiter]
+    BreakChars:=[#0,QuoteChar,Delimiter]
   else  
-    c:=[#0..' ',QuoteChar,Delimiter];
+    BreakChars:=[#0..' ',QuoteChar,Delimiter];
+
+  // Check for break characters and quote if required.
   For i:=0 to count-1 do
     begin
     S:=Strings[i];
     p:=pchar(S);
-    while not(p^ in c) do
+    //Quote strings that include BreakChars:
+    while not(p^ in BreakChars) do
      inc(p);
-// strings in list may contain #0
-    if (p<>pchar(S)+length(S)) and not StrictDelimiter then
+    if (p<>pchar(S)+length(S)) then
       Result:=Result+QuoteString(S,QuoteChar)
     else
       Result:=Result+S;
     if I<Count-1 then 
       Result:=Result+Delimiter;
     end;
+  // Quote empty string:
   If (Length(Result)=0) and (Count=1) then
     Result:=QuoteChar+QuoteChar;
 end;
@@ -268,22 +271,48 @@
  j:=1;
  aNotFirst:=false;
 
+ { Paraphrased from Delphi XE2 help:
+ Strings must be separated by Delimiter characters or spaces.
+ They may be enclosed in QuoteChars.
+ QuoteChars in the string must be repeated to distinguish them from the QuoteChars enclosing the string.
+ }
  try
   Clear;
   If StrictDelimiter then
     begin
-    // Easier, faster loop.
-    While I<=Length(AValue) do
-      begin
-      If (AValue[I] in [FDelimiter,#0]) then
-        begin
-        Add(Copy(AValue,J,I-J));
-        J:=I+1;
-        end;
-      Inc(i);
+    while i<=length(AValue) do begin
+     // skip delimiter
+     if aNotFirst and (i<=length(AValue)) and (AValue[i]=FDelimiter) then inc(i);
+
+     // read next string
+     if i<=length(AValue) then begin
+      if AValue[i]=FQuoteChar then begin
+       // next string is quoted
+       j:=i+1;
+       while (j<=length(AValue)) and
+             ( (AValue[j]<>FQuoteChar) or
+               ( (j+1<=length(AValue)) and (AValue[j+1]=FQuoteChar) ) ) do begin
+        if (j<=length(AValue)) and (AValue[j]=FQuoteChar) then inc(j,2)
+                                                          else inc(j);
+       end;
+       // j is position of closing quote
+       Add( StringReplace (Copy(AValue,i+1,j-i-1),
+                           FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
+       i:=j+1;
+      end else begin
+       // next string is not quoted; read until delimiter
+       j:=i;
+       while (j<=length(AValue)) and
+             (AValue[j]<>FDelimiter) do inc(j);
+       Add( Copy(AValue,i,j-i));
+       i:=j;
       end;
-    If (Length(AValue)>0) then
-      Add(Copy(AValue,J,I-J));  
+     end else begin
+      if aNotFirst then Add('');
+     end;
+
+     aNotFirst:=true;
+    end;
     end
   else 
     begin
@@ -310,7 +339,7 @@
                            FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
        i:=j+1;
       end else begin
-       // next string is not quoted
+       // next string is not quoted; read until control character/space/delimiter
        j:=i;
        while (j<=length(AValue)) and
              (Ord(AValue[j])>Ord(' ')) and
DelimitedText2.diff (3,396 bytes)

Reinier Olislagers

2012-01-20 10:17

developer   ~0055880

Last edited: 2012-01-21 14:56

Uploaded diff. Trunk (today) hasn't changed file stringl.inc compared to fixes_2.6.

Tested on 2.7 (Windows x32 compiler), same output as Delphi output.

Reinier Olislagers

2012-01-21 14:56

developer   ~0055915

Last edited: 2012-01-21 14:58

Ready for review. Though I used svn diff, I had troubles running patch.exe to apply the diff. For safety's sake, uploaded the entire modified file as well...

2012-01-21 14:58

 

stringl.inc (32,035 bytes)
{
    This file is part of the Free Component Library (FCL)
    Copyright (c) 1999-2000 by the Free Pascal development team

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

{****************************************************************************}
{*                        TStringsEnumerator                                *}
{****************************************************************************}

constructor TStringsEnumerator.Create(AStrings: TStrings);
begin
  inherited Create;
  FStrings := AStrings;
  FPosition := -1;
end;

function TStringsEnumerator.GetCurrent: String;
begin
  Result := FStrings[FPosition];
end;

function TStringsEnumerator.MoveNext: Boolean;
begin
  Inc(FPosition);
  Result := FPosition < FStrings.Count;
end;

{****************************************************************************}
{*                             TStrings                                     *}
{****************************************************************************}

// Function to quote text. Should move maybe to sysutils !!
// Also, it is not clear at this point what exactly should be done.

{ //!! is used to mark unsupported things. }

Function QuoteString (Const S : String; Quote : String) : String;
Var
  I,J : Integer;
begin
  J:=0;
  Result:=S;
  for i:=1to length(s) do
   begin
     inc(j);
     if S[i]=Quote then
      begin
        System.Insert(Quote,Result,J);
        inc(j);
      end;
   end;
  Result:=Quote+Result+Quote;
end;

{
  For compatibility we can't add a Constructor to TSTrings to initialize
  the special characters. Therefore we add a routine which is called whenever
  the special chars are needed.
}

Procedure Tstrings.CheckSpecialChars;

begin
  If Not FSpecialCharsInited then
    begin
    FQuoteChar:='"';
    FDelimiter:=',';
    FNameValueSeparator:='=';
    FSpecialCharsInited:=true;
    FLBS:=DefaultTextLineBreakStyle;
    end;
end;

Function TStrings.GetLBS : TTextLineBreakStyle;
begin
  CheckSpecialChars;
  Result:=FLBS;
end;

Procedure TStrings.SetLBS (AValue : TTextLineBreakStyle);
begin
  CheckSpecialChars;
  FLBS:=AValue;
end;

procedure TStrings.SetDelimiter(c:Char);
begin
  CheckSpecialChars;
  FDelimiter:=c;
end;


procedure TStrings.SetQuoteChar(c:Char);
begin
  CheckSpecialChars;
  FQuoteChar:=c;
end;

procedure TStrings.SetNameValueSeparator(c:Char);
begin
  CheckSpecialChars;
  FNameValueSeparator:=c;
end;


function TStrings.GetCommaText: string;

Var
  C1,C2 : Char;
  FSD : Boolean;

begin
  CheckSpecialChars;
  FSD:=StrictDelimiter;
  C1:=Delimiter;
  C2:=QuoteChar;
  Delimiter:=',';
  QuoteChar:='"';
  StrictDelimiter:=False;
  Try
    Result:=GetDelimitedText;
  Finally
    Delimiter:=C1;
    QuoteChar:=C2;
    StrictDelimiter:=FSD;
  end;
end;


Function TStrings.GetDelimitedText: string;

Var
  I : integer;
  p : pchar;
  BreakChars : set of char;
  S : String;
  
begin
  CheckSpecialChars;
  result:='';
  if StrictDelimiter then
    BreakChars:=[#0,QuoteChar,Delimiter]
  else  
    BreakChars:=[#0..' ',QuoteChar,Delimiter];

  // Check for break characters and quote if required.
  For i:=0 to count-1 do
    begin
    S:=Strings[i];
    p:=pchar(S);
    //Quote strings that include BreakChars:
    while not(p^ in BreakChars) do
     inc(p);
    if (p<>pchar(S)+length(S)) then
      Result:=Result+QuoteString(S,QuoteChar)
    else
      Result:=Result+S;
    if I<Count-1 then 
      Result:=Result+Delimiter;
    end;
  // Quote empty string:
  If (Length(Result)=0) and (Count=1) then
    Result:=QuoteChar+QuoteChar;
end;

procedure TStrings.GetNameValue(Index : Integer; Out AName,AValue : String);

Var L : longint;

begin
  CheckSpecialChars;
  AValue:=Strings[Index];
  L:=Pos(FNameValueSeparator,AValue);
  If L<>0 then
    begin
    AName:=Copy(AValue,1,L-1);
    System.Delete(AValue,1,L);
    end
  else
    AName:='';
end;

function TStrings.ExtractName(const s:String):String;
var
  L: Longint;
begin
  CheckSpecialChars;
  L:=Pos(FNameValueSeparator,S);
  If L<>0 then
    Result:=Copy(S,1,L-1)
  else
    Result:='';
end;

function TStrings.GetName(Index: Integer): string;

Var
  V : String;

begin
  GetNameValue(Index,Result,V);
end;

Function TStrings.GetValue(const Name: string): string;

Var
  L : longint;
  N : String;

begin
  Result:='';
  L:=IndexOfName(Name);
  If L<>-1 then
    GetNameValue(L,N,Result);
end;

Function TStrings.GetValueFromIndex(Index: Integer): string;

Var
  N : String;

begin
  GetNameValue(Index,N,Result);
end;

Procedure TStrings.SetValueFromIndex(Index: Integer; const Value: string);

begin
  If (Value='') then
    Delete(Index)
  else
    begin
    If (Index<0) then
      Index:=Add('');
    CheckSpecialChars;
    Strings[Index]:=GetName(Index)+FNameValueSeparator+Value;
    end;
end;

procedure TStrings.ReadData(Reader: TReader);
begin
  Reader.ReadListBegin;
  BeginUpdate;
  try
    Clear;
    while not Reader.EndOfList do
      Add(Reader.ReadString);
  finally
    EndUpdate;
  end;
  Reader.ReadListEnd;
end;


Procedure TStrings.SetDelimitedText(const AValue: string);
var i,j:integer;
    aNotFirst:boolean;
begin
 CheckSpecialChars;
 BeginUpdate;

 i:=1;
 j:=1;
 aNotFirst:=false;

 { Paraphrased from Delphi XE2 help:
 Strings must be separated by Delimiter characters or spaces.
 They may be enclosed in QuoteChars.
 QuoteChars in the string must be repeated to distinguish them from the QuoteChars enclosing the string.
 }
 try
  Clear;
  If StrictDelimiter then
    begin
    while i<=length(AValue) do begin
     // skip delimiter
     if aNotFirst and (i<=length(AValue)) and (AValue[i]=FDelimiter) then inc(i);

     // read next string
     if i<=length(AValue) then begin
      if AValue[i]=FQuoteChar then begin
       // next string is quoted
       j:=i+1;
       while (j<=length(AValue)) and
             ( (AValue[j]<>FQuoteChar) or
               ( (j+1<=length(AValue)) and (AValue[j+1]=FQuoteChar) ) ) do begin
        if (j<=length(AValue)) and (AValue[j]=FQuoteChar) then inc(j,2)
                                                          else inc(j);
       end;
       // j is position of closing quote
       Add( StringReplace (Copy(AValue,i+1,j-i-1),
                           FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
       i:=j+1;
      end else begin
       // next string is not quoted; read until delimiter
       j:=i;
       while (j<=length(AValue)) and
             (AValue[j]<>FDelimiter) do inc(j);
       Add( Copy(AValue,i,j-i));
       i:=j;
      end;
     end else begin
      if aNotFirst then Add('');
     end;

     aNotFirst:=true;
    end;
    end
  else 
    begin
    while i<=length(AValue) do begin
     // skip delimiter
     if aNotFirst and (i<=length(AValue)) and (AValue[i]=FDelimiter) then inc(i);

     // skip spaces
     while (i<=length(AValue)) and (Ord(AValue[i])<=Ord(' ')) do inc(i);
    
     // read next string
     if i<=length(AValue) then begin
      if AValue[i]=FQuoteChar then begin
       // next string is quoted
       j:=i+1;
       while (j<=length(AValue)) and
             ( (AValue[j]<>FQuoteChar) or
               ( (j+1<=length(AValue)) and (AValue[j+1]=FQuoteChar) ) ) do begin
        if (j<=length(AValue)) and (AValue[j]=FQuoteChar) then inc(j,2)
                                                          else inc(j);
       end;
       // j is position of closing quote
       Add( StringReplace (Copy(AValue,i+1,j-i-1),
                           FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
       i:=j+1;
      end else begin
       // next string is not quoted; read until control character/space/delimiter
       j:=i;
       while (j<=length(AValue)) and
             (Ord(AValue[j])>Ord(' ')) and
             (AValue[j]<>FDelimiter) do inc(j);
       Add( Copy(AValue,i,j-i));
       i:=j;
      end;
     end else begin
      if aNotFirst then Add('');
     end;

     // skip spaces
     while (i<=length(AValue)) and (Ord(AValue[i])<=Ord(' ')) do inc(i);

     aNotFirst:=true;
    end;
    end;
 finally
   EndUpdate;
 end;
end;

Procedure TStrings.SetCommaText(const Value: string);

Var
  C1,C2 : Char;

begin
  CheckSpecialChars;
  C1:=Delimiter;
  C2:=QuoteChar;
  Delimiter:=',';
  QuoteChar:='"';
  Try
    SetDelimitedText(Value);
  Finally
    Delimiter:=C1;
    QuoteChar:=C2;
  end;
end;


Procedure TStrings.SetStringsAdapter(const Value: IStringsAdapter);

begin
end;



Procedure TStrings.SetValue(const Name, Value: string);

Var L : longint;

begin
  CheckSpecialChars;
  L:=IndexOfName(Name);
  if L=-1 then
   Add (Name+FNameValueSeparator+Value)
  else
   Strings[L]:=Name+FNameValueSeparator+value;
end;



procedure TStrings.WriteData(Writer: TWriter);
var
  i: Integer;
begin
  Writer.WriteListBegin;
  for i := 0 to Count - 1 do
    Writer.WriteString(Strings[i]);
  Writer.WriteListEnd;
end;



procedure TStrings.DefineProperties(Filer: TFiler);
var
  HasData: Boolean;
begin
  if Assigned(Filer.Ancestor) then
    // Only serialize if string list is different from ancestor
    if Filer.Ancestor.InheritsFrom(TStrings) then
      HasData := not Equals(TStrings(Filer.Ancestor))
    else
      HasData := True
  else
    HasData := Count > 0;
  Filer.DefineProperty('Strings', @ReadData, @WriteData, HasData);
end;


Procedure TStrings.Error(const Msg: string; Data: Integer);
begin
  Raise EStringListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame);
end;


Procedure TStrings.Error(const Msg: pstring; Data: Integer);
begin
  Raise EStringListError.CreateFmt(Msg^,[Data]) at get_caller_addr(get_frame);
end;


Function TStrings.GetCapacity: Integer;

begin
  Result:=Count;
end;



Function TStrings.GetObject(Index: Integer): TObject;

begin
  Result:=Nil;
end;



Function TStrings.GetTextStr: string;

Var P : Pchar;
    I,L,NLS : Longint;
    S,NL : String;

begin
  CheckSpecialChars;
  // Determine needed place
  Case FLBS of
    tlbsLF   : NL:=#10;
    tlbsCRLF : NL:=#13#10;
    tlbsCR   : NL:=#13; 
  end;
  L:=0;
  NLS:=Length(NL);
  For I:=0 to count-1 do
    L:=L+Length(Strings[I])+NLS;
  Setlength(Result,L);
  P:=Pointer(Result);
  For i:=0 To count-1 do
    begin
    S:=Strings[I];
    L:=Length(S);
    if L<>0 then
      System.Move(Pointer(S)^,P^,L);
    P:=P+L;
    For L:=1 to NLS do
      begin
      P^:=NL[L];
      inc(P);
      end;
    end;
end;



Procedure TStrings.Put(Index: Integer; const S: string);

Var Obj : TObject;

begin
  Obj:=Objects[Index];
  Delete(Index);
  InsertObject(Index,S,Obj);
end;



Procedure TStrings.PutObject(Index: Integer; AObject: TObject);

begin
  // Empty.
end;



Procedure TStrings.SetCapacity(NewCapacity: Integer);

begin
  // Empty.
end;

Function GetNextLine (Const Value : String; Var S : String; Var P : Integer) : Boolean;

Var 
  PS : PChar;
  IP,L : Integer;
  
begin
  L:=Length(Value);
  S:='';
  Result:=False;
  If ((L-P)<0) then 
    exit;
  if ((L-P)=0) and (not (value[P] in [#10,#13])) Then
    Begin
      s:=value[P];
      inc(P);
      Exit(True);
    End;
  PS:=PChar(Value)+P-1;
  IP:=P;
  While ((L-P)>=0) and (not (PS^ in [#10,#13])) do 
    begin
    P:=P+1;
    Inc(PS);
    end;
  SetLength (S,P-IP);
  System.Move (Value[IP],Pointer(S)^,P-IP);
  If (P<=L) and (Value[P]=#13) then 
    Inc(P);
  If (P<=L) and (Value[P]=#10) then
    Inc(P); // Point to character after #10(#13)
  Result:=True;
end;

Procedure TStrings.SetTextStr(const Value: string);

Var
  S : String;
  P : Integer;

begin
  Try
    beginUpdate;
    Clear;
    P:=1;
    While GetNextLine (Value,S,P) do
      Add(S);
  finally
    EndUpdate;
  end;
end;



Procedure TStrings.SetUpdateState(Updating: Boolean);

begin
end;



destructor TSTrings.Destroy;

begin
  inherited destroy;
end;



Function TStrings.Add(const S: string): Integer;

begin
  Result:=Count;
  Insert (Count,S);
end;



Function TStrings.AddObject(const S: string; AObject: TObject): Integer;

begin
  Result:=Add(S);
  Objects[result]:=AObject;
end;



Procedure TStrings.Append(const S: string);

begin
  Add (S);
end;



Procedure TStrings.AddStrings(TheStrings: TStrings);

Var Runner : longint;

begin
  try
    beginupdate;
    For Runner:=0 to TheStrings.Count-1 do
      self.AddObject (Thestrings[Runner],TheStrings.Objects[Runner]);
  finally
    EndUpdate;
  end;
end;



Procedure TStrings.Assign(Source: TPersistent);

Var
  S : TStrings;

begin
  If Source is TStrings then
    begin
    S:=TStrings(Source);
    BeginUpdate;
    Try
      clear;
      FSpecialCharsInited:=S.FSpecialCharsInited;
      FQuoteChar:=S.FQuoteChar;
      FDelimiter:=S.FDelimiter;
      FNameValueSeparator:=S.FNameValueSeparator;
      FLBS:=S.FLBS;
      AddStrings(S);
    finally
      EndUpdate;
    end;
    end
  else
    Inherited Assign(Source);
end;



Procedure TStrings.BeginUpdate;

begin
   if FUpdateCount = 0 then SetUpdateState(true);
   inc(FUpdateCount);
end;



Procedure TStrings.EndUpdate;

begin
  If FUpdateCount>0 then
     Dec(FUpdateCount);
  if FUpdateCount=0 then
    SetUpdateState(False);
end;



Function TStrings.Equals(Obj: TObject): Boolean;

begin
  if Obj is TStrings then
    Result := Equals(TStrings(Obj))
  else
    Result := inherited Equals(Obj);
end;



Function TStrings.Equals(TheStrings: TStrings): Boolean;

Var Runner,Nr : Longint;

begin
  Result:=False;
  Nr:=Self.Count;
  if Nr<>TheStrings.Count then exit;
  For Runner:=0 to Nr-1 do
    If Strings[Runner]<>TheStrings[Runner] then exit;
  Result:=True;
end;



Procedure TStrings.Exchange(Index1, Index2: Integer);

Var
  Obj : TObject;
  Str : String;

begin
  Try
    beginUpdate;
    Obj:=Objects[Index1];
    Str:=Strings[Index1];
    Objects[Index1]:=Objects[Index2];
    Strings[Index1]:=Strings[Index2];
    Objects[Index2]:=Obj;
    Strings[Index2]:=Str;
  finally
    EndUpdate;
  end;
end;


function TStrings.GetEnumerator: TStringsEnumerator;
begin
  Result:=TStringsEnumerator.Create(Self);
end;


Function TStrings.GetText: PChar;
begin
  Result:=StrNew(Pchar(Self.Text));
end;


Function TStrings.DoCompareText(const s1,s2 : string) : PtrInt;
  begin
    result:=CompareText(s1,s2);
  end;


Function TStrings.IndexOf(const S: string): Integer;
begin
  Result:=0;
  While (Result<Count) and (DoCompareText(Strings[Result],S)<>0) do Result:=Result+1;
  if Result=Count then Result:=-1;
end;


Function TStrings.IndexOfName(const Name: string): Integer;
Var
  len : longint;
  S : String;
begin
  CheckSpecialChars;
  Result:=0;
  while (Result<Count) do
    begin
    S:=Strings[Result];
    len:=pos(FNameValueSeparator,S)-1;
    if (len>0) and (DoCompareText(Name,Copy(S,1,Len))=0) then
      exit;
    inc(result);
    end;
  result:=-1;
end;


Function TStrings.IndexOfObject(AObject: TObject): Integer;
begin
  Result:=0;
  While (Result<count) and (Objects[Result]<>AObject) do Result:=Result+1;
  If Result=Count then Result:=-1;
end;


Procedure TStrings.InsertObject(Index: Integer; const S: string;
  AObject: TObject);

begin
  Insert (Index,S);
  Objects[Index]:=AObject;
end;



Procedure TStrings.LoadFromFile(const FileName: string);
Var
        TheStream : TFileStream;
begin
  TheStream:=TFileStream.Create(FileName,fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(TheStream);
  finally
    TheStream.Free;
  end;
end;



Procedure TStrings.LoadFromStream(Stream: TStream);
{
   Borlands method is no good, since a pipe for
   instance doesn't have a size.
   So we must do it the hard way.
}
Const
  BufSize = 1024;
  MaxGrow = 1 shl 29;

Var
  Buffer     : AnsiString;
  BytesRead,
  BufLen,
  I,BufDelta     : Longint;
begin
  // reread into a buffer
  try
    beginupdate;
    Buffer:='';
    BufLen:=0;
    I:=1;
    Repeat
      BufDelta:=BufSize*I;
      SetLength(Buffer,BufLen+BufDelta);
      BytesRead:=Stream.Read(Buffer[BufLen+1],BufDelta);
      inc(BufLen,BufDelta);
      If I<MaxGrow then
        I:=I shl 1;
    Until BytesRead<>BufDelta;
    SetLength(Buffer, BufLen-BufDelta+BytesRead);
    SetTextStr(Buffer);
    SetLength(Buffer,0);
  finally
    EndUpdate;
  end;
end;


Procedure TStrings.Move(CurIndex, NewIndex: Integer);
Var
  Obj : TObject;
  Str : String;
begin
  BeginUpdate;
  Obj:=Objects[CurIndex];
  Str:=Strings[CurIndex];
  Delete(Curindex);
  InsertObject(NewIndex,Str,Obj);
  EndUpdate;
end;



Procedure TStrings.SaveToFile(const FileName: string);

Var TheStream : TFileStream;

begin
  TheStream:=TFileStream.Create(FileName,fmCreate);
  try
    SaveToStream(TheStream);
  finally
    TheStream.Free;
  end;
end;



Procedure TStrings.SaveToStream(Stream: TStream);
Var
  S : String;
begin
  S:=Text;
  if S = '' then Exit;
  Stream.WriteBuffer(Pointer(S)^,Length(S));
end;




Procedure TStrings.SetText(TheText: PChar);

Var S : String;

begin
  If TheText<>Nil then
    S:=StrPas(TheText)
  else
    S:='';
  SetTextStr(S);  
end;


{****************************************************************************}
{*                             TStringList                                  *}
{****************************************************************************}

{$if defined(VER2_0) or not defined(FPC_TESTGENERICS)}

Procedure TStringList.ExchangeItems(Index1, Index2: Integer);

Var P1,P2 : Pointer;

begin
  P1:=Pointer(Flist^[Index1].FString);
  P2:=Pointer(Flist^[Index1].FObject);
  Pointer(Flist^[Index1].Fstring):=Pointer(Flist^[Index2].Fstring);
  Pointer(Flist^[Index1].FObject):=Pointer(Flist^[Index2].FObject);
  Pointer(Flist^[Index2].Fstring):=P1;
  Pointer(Flist^[Index2].FObject):=P2;
end;



Procedure TStringList.Grow;

Var
  NC : Integer;

begin
  NC:=FCapacity;
  If NC>=256 then
    NC:=NC+(NC Div 4)
  else if NC=0 then
    NC:=4
  else
    NC:=NC*4;
  SetCapacity(NC);
end;



Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
var
  Pivot, vL, vR: Integer;
begin
  if R - L <= 1 then begin // a little bit of time saver
    if L < R then
      if CompareFn(Self, L, R) > 0 then
        ExchangeItems(L, R);

    Exit;
  end;

  vL := L;
  vR := R;

  Pivot := L + Random(R - L); // they say random is best

  while vL < vR do begin
    while (vL < Pivot) and (CompareFn(Self, vL, Pivot) <= 0) do
      Inc(vL);

    while (vR > Pivot) and (CompareFn(Self, vR, Pivot) > 0) do
      Dec(vR);

    ExchangeItems(vL, vR);

    if Pivot = vL then // swap pivot if we just hit it from one side
      Pivot := vR
    else if Pivot = vR then
      Pivot := vL;
  end;

  if Pivot - 1 >= L then
    QuickSort(L, Pivot - 1, CompareFn);
  if Pivot + 1 <= R then
    QuickSort(Pivot + 1, R, CompareFn);
end;


Procedure TStringList.InsertItem(Index: Integer; const S: string);
begin
  Changing;
  If FCount=Fcapacity then Grow;
  If Index<FCount then
    System.Move (FList^[Index],FList^[Index+1],
                 (FCount-Index)*SizeOf(TStringItem));
  Pointer(Flist^[Index].Fstring):=Nil;  // Needed to initialize...
  Flist^[Index].FString:=S;
  Flist^[Index].Fobject:=Nil;
  Inc(FCount);
  Changed;
end;


Procedure TStringList.InsertItem(Index: Integer; const S: string; O: TObject);
begin
  Changing;
  If FCount=Fcapacity then Grow;
  If Index<FCount then
    System.Move (FList^[Index],FList^[Index+1],
                 (FCount-Index)*SizeOf(TStringItem));
  Pointer(Flist^[Index].Fstring):=Nil;  // Needed to initialize...
  Flist^[Index].FString:=S;
  Flist^[Index].FObject:=O;
  Inc(FCount);
  Changed;
end;


Procedure TStringList.SetSorted(Value: Boolean);

begin
  If FSorted<>Value then
    begin
    If Value then sort;
    FSorted:=VAlue
    end;
end;



Procedure TStringList.Changed;

begin
  If (FUpdateCount=0) Then
   If Assigned(FOnChange) then
     FOnchange(Self);
end;



Procedure TStringList.Changing;

begin
  If FUpdateCount=0 then
    if Assigned(FOnChanging) then
      FOnchanging(Self);
end;



Function TStringList.Get(Index: Integer): string;

begin
  If (Index<0) or (INdex>=Fcount)  then
    Error (SListIndexError,Index);
  Result:=Flist^[Index].FString;
end;



Function TStringList.GetCapacity: Integer;

begin
  Result:=FCapacity;
end;



Function TStringList.GetCount: Integer;

begin
  Result:=FCount;
end;



Function TStringList.GetObject(Index: Integer): TObject;

begin
  If (Index<0) or (INdex>=Fcount)  then
    Error (SListIndexError,Index);
  Result:=Flist^[Index].FObject;
end;



Procedure TStringList.Put(Index: Integer; const S: string);

begin
  If Sorted then
    Error(SSortedListError,0);
  If (Index<0) or (INdex>=Fcount)  then
    Error (SListIndexError,Index);
  Changing;
  Flist^[Index].FString:=S;
  Changed;
end;



Procedure TStringList.PutObject(Index: Integer; AObject: TObject);

begin
  If (Index<0) or (INdex>=Fcount)  then
    Error (SListIndexError,Index);
  Changing;
  Flist^[Index].FObject:=AObject;
  Changed;
end;



Procedure TStringList.SetCapacity(NewCapacity: Integer);

Var NewList : Pointer;
    MSize : Longint;

begin
  If (NewCapacity<0) then
     Error (SListCapacityError,NewCapacity);
  If NewCapacity>FCapacity then
    begin
    GetMem (NewList,NewCapacity*SizeOf(TStringItem));
    If NewList=Nil then
      Error (SListCapacityError,NewCapacity);
    If Assigned(FList) then
      begin
      MSize:=FCapacity*Sizeof(TStringItem);
      System.Move (FList^,NewList^,MSize);
      FillWord (Pchar(NewList)[MSize],(NewCapacity-FCapacity)*WordRatio, 0);
      FreeMem (Flist,MSize);
      end;
    Flist:=NewList;
    FCapacity:=NewCapacity;
    end
  else if NewCapacity<FCapacity then
    begin
    if NewCapacity = 0 then
    begin
      FreeMem(FList);
      FList := nil;
    end else
    begin
      GetMem(NewList, NewCapacity * SizeOf(TStringItem));
      System.Move(FList^, NewList^, NewCapacity * SizeOf(TStringItem));
      FreeMem(FList);
      FList := NewList;
    end;
    FCapacity:=NewCapacity;
    end;
end;



Procedure TStringList.SetUpdateState(Updating: Boolean);

begin
  If Updating then
    Changing
  else
    Changed
end;



destructor TStringList.Destroy;

Var I : Longint;

begin
  FOnChange:=Nil;
  FOnChanging:=Nil;
  // This will force a dereference. Can be done better...
  For I:=0 to FCount-1 do
    FList^[I].FString:='';
  FCount:=0;
  SetCapacity(0);
  Inherited destroy;
end;



Function TStringList.Add(const S: string): Integer;

begin
  If Not Sorted then
    Result:=FCount
  else
    If Find (S,Result) then
      Case DUplicates of
        DupIgnore : Exit;
        DupError : Error(SDuplicateString,0)
      end;
   InsertItem (Result,S);
end;

Procedure TStringList.Clear;

Var I : longint;

begin
  if FCount = 0 then Exit;
  Changing;
  if FOwnsObjects then
    begin
      For I:=0 to FCount-1 do
        begin
          Flist^[I].FString:='';
          freeandnil(Flist^[i].FObject);
        end;
    end
  else
    begin
      For I:=0 to FCount-1 do
        Flist^[I].FString:='';
    end;
  FCount:=0;
  SetCapacity(0);
  Changed;
end;

Procedure TStringList.Delete(Index: Integer);

begin
  If (Index<0) or (Index>=FCount) then
    Error(SlistINdexError,Index);
  Changing;
  Flist^[Index].FString:='';
  if FOwnsObjects then
    FreeAndNil(Flist^[Index].FObject);
  Dec(FCount);
  If Index<FCount then
    System.Move(Flist^[Index+1],
                Flist^[Index],
                (Fcount-Index)*SizeOf(TStringItem));
  Changed;
end;



Procedure TStringList.Exchange(Index1, Index2: Integer);

begin
  If (Index1<0) or (Index1>=FCount) then
    Error(SListIndexError,Index1);
  If (Index2<0) or (Index2>=FCount) then
    Error(SListIndexError,Index2);
  Changing;
  ExchangeItems(Index1,Index2);
  changed;
end;


procedure TStringList.SetCaseSensitive(b : boolean);
  begin
        if b<>FCaseSensitive then
          begin
                FCaseSensitive:=b;
            if FSorted then
              sort;
          end;
  end;


Function TStringList.DoCompareText(const s1,s2 : string) : PtrInt;
  begin
        if FCaseSensitive then
          result:=AnsiCompareStr(s1,s2)
        else
          result:=AnsiCompareText(s1,s2);
  end;


Function TStringList.Find(const S: string; Out Index: Integer): Boolean;

var
  L, R, I: Integer;
  CompareRes: PtrInt;
begin
  Result := false;
  // Use binary search.
  L := 0;
  R := Count - 1;
  while (L<=R) do
  begin
    I := L + (R - L) div 2;
    CompareRes := DoCompareText(S, Flist^[I].FString);
    if (CompareRes>0) then
      L := I+1
    else begin
      R := I-1;
      if (CompareRes=0) then begin
         Result := true;
         if (Duplicates<>dupAccept) then
            L := I; // forces end of while loop
      end;
    end;
  end;
  Index := L;
end;



Function TStringList.IndexOf(const S: string): Integer;

begin
  If Not Sorted then
    Result:=Inherited indexOf(S)
  else
    // faster using binary search...
    If Not Find (S,Result) then
      Result:=-1;
end;



Procedure TStringList.Insert(Index: Integer; const S: string);

begin
  If Sorted then
    Error (SSortedListError,0)
  else
    If (Index<0) or (Index>FCount) then
      Error (SListIndexError,Index)
    else
      InsertItem (Index,S);
end;


Procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);

begin
  If Not Sorted and (FCount>1) then
    begin
    Changing;
    QuickSort(0,FCount-1, CompareFn);
    Changed;
    end;
end;

function StringListAnsiCompare(List: TStringList; Index1, Index: Integer): Integer;

begin
  Result := List.DoCompareText(List.FList^[Index1].FString,
    List.FList^[Index].FString);
end;

Procedure TStringList.Sort;

begin
  CustomSort(@StringListAnsiCompare);
end;

{$else}

{ generics based implementation of TStringList follows }

function StringListAnsiCompare(List: TStringList; Index1, Index2: Integer): Integer;
begin
  Result := List.DoCompareText(List.Strings[Index1], List.Strings[Index2]);
end;

constructor TStringList.Create;
begin
  inherited;
  FOwnsObjects:=false;
  FMap := TFPStrObjMap.Create;
  FMap.OnPtrCompare := @MapPtrCompare;
  FOnCompareText := @DefaultCompareText;
  CheckSpecialChars;
end;

destructor TStringList.Destroy;
begin
  FMap.Free;
  inherited;
end;

function TStringList.GetDuplicates: TDuplicates;
begin
  Result := FMap.Duplicates;
end;

function TStringList.GetSorted: boolean;
begin
  Result := FMap.Sorted;
end;

procedure TStringList.SetDuplicates(NewDuplicates: TDuplicates);
begin
  FMap.Duplicates := NewDuplicates;
end;

procedure TStringList.SetSorted(NewSorted: Boolean);
begin
  FMap.Sorted := NewSorted;
end;

procedure TStringList.Changed;
begin
  if FUpdateCount = 0 then
   if Assigned(FOnChange) then
     FOnChange(Self);
end;

procedure TStringList.Changing;
begin
  if FUpdateCount = 0 then
    if Assigned(FOnChanging) then
      FOnChanging(Self);
end;

function TStringList.Get(Index: Integer): string;
begin
  Result := FMap.Keys[Index];
end;

function TStringList.GetCapacity: Integer;
begin
  Result := FMap.Capacity;
end;

function TStringList.GetCount: Integer;
begin
  Result := FMap.Count;
end;

function TStringList.GetObject(Index: Integer): TObject;
begin
  Result := FMap.Data[Index];
end;

procedure TStringList.Put(Index: Integer; const S: string);
begin
  Changing;
  FMap.Keys[Index] := S;
  Changed;
end;

procedure TStringList.PutObject(Index: Integer; AObject: TObject);
begin
  Changing;
  FMap.Data[Index] := AObject;
  Changed;
end;

procedure TStringList.SetCapacity(NewCapacity: Integer);
begin
  FMap.Capacity := NewCapacity;
end;

procedure TStringList.SetUpdateState(Updating: Boolean);
begin
  if Updating then
    Changing
  else
    Changed
end;

function TStringList.Add(const S: string): Integer;
begin
  Result := FMap.Add(S);
end;

procedure TStringList.Clear;
begin
  if FMap.Count = 0 then exit;
  Changing;
  FMap.Clear;
  Changed;
end;

procedure TStringList.Delete(Index: Integer);
begin
  if (Index < 0) or (Index >= FMap.Count) then
    Error(SListIndexError, Index);
  Changing;
  FMap.Delete(Index);
  Changed;
end;

procedure TStringList.Exchange(Index1, Index2: Integer);
begin
  if (Index1 < 0) or (Index1 >= FMap.Count) then
    Error(SListIndexError, Index1);
  if (Index2 < 0) or (Index2 >= FMap.Count) then
    Error(SListIndexError, Index2);
  Changing;
  FMap.InternalExchange(Index1, Index2);
  Changed;
end;

procedure TStringList.SetCaseSensitive(NewSensitive: Boolean);
begin
  if NewSensitive <> FCaseSensitive then
  begin
    FCaseSensitive := NewSensitive;
    if Sorted then
      Sort;
  end;
end;

function TStringList.MapPtrCompare(Key1, Key2: Pointer): Integer;
begin
  Result := FOnCompareText(string(Key1^), string(Key2^));
end;

function TStringList.DefaultCompareText(const s1, s2: string): PtrInt;
begin
  if FCaseSensitive then
    Result := AnsiCompareStr(s1, s2)
  else
    Result := AnsiCompareText(s1, s2);
end;

function TStringList.DoCompareText(const s1, s2: string): PtrInt;
begin
  Result := FOnCompareText(s1, s2);
end;

function TStringList.Find(const S: string; var Index: Integer): Boolean;
begin
  Result := FMap.Find(S, Index);
end;

function TStringList.IndexOf(const S: string): Integer;
begin
  Result := FMap.IndexOf(S);
end;

procedure TStringList.Insert(Index: Integer; const S: string);
begin
  if not Sorted and (0 <= Index) and (Index < FMap.Count) then
    Changing;
  FMap.InsertKey(Index, S);
  Changed;
end;

procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
var 
  I, J, Pivot: Integer;
begin
  repeat
    I := L;
    J := R;
    Pivot := (L + R) div 2;
    repeat
      while CompareFn(Self, I, Pivot) < 0 do Inc(I);
      while CompareFn(Self, J, Pivot) > 0 do Dec(J);
      if I <= J then
      begin
        FMap.InternalExchange(I, J); // No check, indices are correct.
        if Pivot = I then
          Pivot := J
        else if Pivot = J then
          Pivot := I;
        Inc(I);
        Dec(j);
      end;
    until I > J;
    if L < J then 
      QuickSort(L,J, CompareFn);
    L := I;
  until I >= R;
end;

procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
begin
  if not Sorted and (FMap.Count > 1) then
  begin
    Changing;
    QuickSort(0, FMap.Count-1, CompareFn);
    Changed;
  end;
end;

procedure TStringList.Sort;
begin
  if not Sorted and (FMap.Count > 1) then
  begin
    Changing;
    FMap.Sort;
    Changed;
  end;
end;

{$endif}

stringl.inc (32,035 bytes)

2012-01-31 16:26

 

delimited_with_test_output.zip (1,479 bytes)

Reinier Olislagers

2012-06-07 09:14

developer   ~0060326

Last edited: 2012-06-07 12:12

Attached more comprehensive test and results that also includes suspect or wrong values.

Turbo Delphi 2006 and patched FPC trunk output (included) are the same.

2012-06-07 11:27

 

delimited3.zip (4,517 bytes)

Reinier Olislagers

2012-06-07 12:10

developer   ~0060335

Conclusions:
- Test program output is same in Delphi+FPC after patch.
- FPC and Delphi always accept quoted strings and correctly strip out the quotes. It may therefore be an option to write quoted strings (which would make sdf more csv compatible and make it easier to use the sdf code in savetocsv routines. However, that is perhaps for a next bug report.


Strange things:
- tab character seemingly replaced when output with strictdelimiter off
- delimitedtext property gets "massaged" (see beginning of test) after assigning delimitedtext

Done. Suggest implementing this; thanks.

Bart Broersma

2012-06-07 19:29

reporter   ~0060346

Regarding SetDelimitedText consider:
 Strictdelimiter := True;
 DelimitedText := ' SpacesInFront,SpacesAtTheEnd ';

This will give
0: ' SpacesInFront'
1: 'SpacesAtTheEnd '

I cannot test with Delphi, but I suspect these spaces should be trimmed?

...
+ end else begin
+ // next string is not quoted; read until delimiter
+ j:=i;
+ while (j<=length(AValue)) and
+ (AValue[j]<>FDelimiter) do inc(j);
+ Add( Trim(Copy(AValue,i,j-i))); //Trim preceding and trailing spaces
+ i:=j;
....

Reinier Olislagers

2012-06-07 19:33

developer   ~0060347

Last edited: 2012-06-07 19:42

Edit: no, this is correct, IIRC, if you use delimitedtext, spaces are not trimmed. That is why I suggest quoting them anyway, even though it might not be necessary.

Bart Broersma

2012-06-07 19:34

reporter   ~0060348

Another borderline case regarding SetDelimitedText:

 Strictdelimiter := True;
 DelimitedText := ' "Spaces before quote","Spaces after quote" ';

This will give
0: ' "Spaces before quote"'
1: 'Spaces after quote'
2: ' '

Intuitively this doesn't look OK to me (again: I cannot test with Delphi)

Bart Broersma

2012-06-07 19:35

reporter   ~0060349

This bug is parent of 0022182 (Lazarus issue)

Reinier Olislagers

2012-06-07 19:43

developer   ~0060350

Please feel free to add your tests to the test program, as well as a remark on what you think the output should be.
I can test it on Turbo Delphi 2006.

Bart Broersma

2012-06-07 19:44

reporter   ~0060351

Last edited: 2012-06-07 19:59

> No, I suspect they should be quoted. At least if I read the Delphi help right
> (see earlier post).

Maybe, but can you test in Delphi?
Reason for asking is related Lazarus issue 0022182
If your new implementation is correct, I should fix current StringGrid behaviour (again).

> Please feel free to add your tests to the test program
I made slight changes to .dpr file

2012-06-07 19:59

 

delimited3.dpr (4,758 bytes)

Reinier Olislagers

2012-06-07 20:11

developer   ~0060352

Last edited: 2012-06-08 08:17

Conclusion after new tests:
* Delphi and FPC output are still the same after patch.

* This test:' "Spaces before quoted string"'. If strictdelimiter is true, the spaces are not seen as delimiters but data. So the quotes are data too (you can only quote at begin and end). Test output 10 is correct for sdf
Similar reasoning for test 8 and 9.

* Test 11: '"Spaces after quoted string" ': quotes need to be at beginning and end (before delimiter). Here they aren't. Apparently a quote is picked up as delimiter in this case. This is strange.

I suggest this patch be applied now as it aligns FPC behaviour with Delphi behaviour, the de facto sdf standard.

Suggestion: when this patch is applied, suggest looking into something like adding a property CSVText that always quotes output that has spaces, delimiters, quotes in order to avoid generating these weird cases where sdf and csv (RFC 4180) differ. After all, the tests prove that Delphi+FPC read the resulting quoted data correctly.

After that, adapting/copying the sdf input routine for the CSVText case would be needed; there are obviously too many differences to be able to make do with the existing code.

Then we can adapt 22182 by using CSVText:=true; (or whatever other mechanism is chosen)

2012-06-08 07:43

 

del4.zip (4,890 bytes)

Bart Broersma

2012-06-08 08:43

reporter   ~0060363

[Getting a bit off-topic]
With regard to reading/writing CSV files, we might try and comply with rfc 4180.
Amongst others it states (quoted from http://en.wikipedia.org/wiki/Comma-separated_values):

- Fields containing a line-break, double-quote, and/or commas should be quoted

So my borderline cases probably may be considered "invalid data".

Any case, when writing to file (using GetDelimitedText) all these fields will get quoted anyway.

Reinier Olislagers

2012-06-08 10:26

developer   ~0060369

Last edited: 2012-06-08 10:27

@Bart, I'm glad you're repeating my previous post, and expanding on it saying we need to quote by default. That would be my preference too as I've proven Delphi will interoperate.

In any case, can we please implement this patch so we can move on to better support for CSV?
If quoting is to be enabled by default for fields containing cr,lf," and delimiter, let me know, I'll provide another patch in another issue.

Bart Broersma

2012-06-08 13:58

reporter   ~0060376

The same source (as my previous post) also states that spaces are considered to be part of the field.
However, as has been pointed out to me, CSV format <> SDF format.
As far as Get/SetDelimitedText is concerned, I'ld say: make it behave like Delphi.

> we need to quote by default. That would be my preference too
For TStringGrid.SaveToCsvFile this can easily be achieved using GetDelimitedText with StrictDelimiter := false (as we currently do). All fields with spaces, delimeters etc. will be quoted.

Reinier Olislagers

2012-06-08 14:23

developer   ~0060378

Last edited: 2012-06-08 14:58

"However, as has been pointed out to me, CSV format <> SDF format."=>edit: yes, on the forum by me (aka BigChimp)... though it would have been easier if you actually read the comments, such as 0055872 first.

"> we need to quote by default. That would be my preference too
For TStringGrid.SaveToCsvFile this can easily be achieved using GetDelimitedText with StrictDelimiter := false (as we currently do). All fields with spaces, delimeters etc. will be quoted."
See the output in the tests. Although it quotes, the tab character gets lost on output with StrictDelimited:=false;

Bart Broersma

2012-06-12 10:28

reporter   ~0060470

> * Test 11: '"Spaces after quoted string" ': quotes need to be at beginning
> and end (before delimiter). Here they aren't. Apparently a quote is picked up
> as delimiter in this case. This is strange.

Regardless wether this is how Delphi does it, it does not comply with the meaning of StrictDelimiter := True.
Obviously the data ,"text with trainlg space after quote" , is invalid, but this should not lead to then treating the following character as part of a new field, since _only_ FDelimiter can separate fields.

OTOH we can state (in the documentation) that the parsing of "invalid data fields" is undefined (so any solution would be OK).

Reinier Olislagers

2012-06-12 11:36

developer   ~0060472

I am in favour of further improving/extending the delimitedtext handling code (so that it can be used e.g. in Lazarus grid loadfromcsvtext), but think we should not do it all at once.

I've implemented a patch, a test program, made sure Delphi and FPC demonstrably produce the same output, solving the issue as described (and, admittedly, some more).
I'm done here.

Why not implement the patch right now so the fix for bad behaviour is in and people that have trouble with the existing implementation finally get a fix.
Other items such as the one you indicated above and my remark on always quoting can have their own issues opened including a clear problem description and proposed solution, which can refer to this issue and use e.g. the test program here.

If you think the issues involved need to be fixed at the same time as this issue (and in this issue as well), by all means, submit a patch (to either docs or code)... which Marco will review along with the rest.

2012-09-20 13:37

 

tw19610.pp (24,594 bytes)
{ Source provided for Free Pascal bug report 19610 }
{ Submitted by Reinier Olislagers on 20120920 }
{
Note: the tests here are somewhat more extensive than the original bug report.
They are aimed at confirming interoperability between Delphi and FPC sdf formats
The basis for the tests is therefore Delphi's handling.

The only exception are the Put tests, which also accept results that are always
quoted. As Get_StrictDelimTrueSafeQuote and Get_StrictDelimFalseSafeQuote prove,
always quoting output leads to correct/the same input.
The advantage of this is that having strictdelimiter on or off does not matter
and the output format is more unambiguous (i.e. more compatible with RFC4180
for CSV).

On Delphi, rename to .dpr.

Tests successfully completed on:
Turbo Delphi 2006 (Reinier Olislagers)
Delphi 2007 (OBones)
Delphi XE (Marco van de Voort, OBones)
Delphi XE2 Win32 (OBones)
Delphi XE2 Win64 (OBones)
}
{
    This file is part of the Free Pascal packages.
    Copyright (c) 1999-2012 by the Free Pascal development team

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
{$apptype console}
{$ifdef fpc}
  {$mode objfpc}{$H+}
{$endif fpc}
program tw19610;

uses Classes, SysUtils;

{$ifndef fpc}
//Delphi
const
  LineEnding=#13+#10;
{$endif}

function Get_StrictDelimFalse:boolean;
// Test if input works with Delphi-compatible sdf output
// Strictdelimiter:=false (default) when processing the delimitedtext
//
// Mainly check if reading quotes is according to Delphi sdf specs and works.
// Based on del4.zip in bug 19610
const
  // Matches del4.zip in bug 19610:
  DelimText='normal_string;"quoted_string";"quoted;delimiter";"quoted and space";"""quoted_and_starting_quote";"""quoted, starting quote, and space";"quoted_with_tab'+#9+'character";"quoted_multi'+LineEnding+
    'line";  UnquotedSpacesInfront;UnquotedSpacesAtTheEnd   ;  "Spaces before quoted string"';
  TestName='tw19610.Get_StrictDelimFalse';
var
  TestSL: TStringList;
  Expected: TStringList;
  i: integer;
begin
  result:=true;
  //Expected values:
  Expected:=TStringList.Create;
  TestSL:=TStringList.Create;
  try
    Expected.Add('normal_string');
    Expected.Add('quoted_string');
    Expected.Add('quoted;delimiter');
    Expected.Add('quoted and space');
    Expected.Add('"quoted_and_starting_quote');
    Expected.Add('"quoted, starting quote, and space');
    Expected.Add('quoted_with_tab'+#9+'character');
    Expected.Add('quoted_multi'+LineEnding+
      'line');
    Expected.Add('UnquotedSpacesInfront');
    Expected.Add('UnquotedSpacesAtTheEnd');
    Expected.Add('Spaces before quoted string');

    TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
    TestSL.StrictDelimiter:=false;
    TestSL.DelimitedText:=DelimText;
    //Test:
    if Expected.Count<>TestSL.Count then
    begin
      writeln('');
      writeln(TestName+': failed: count mismatch: '+
      inttostr(TestSL.Count)+' test strings; '+inttostr(Expected.Count)+' expected strings.');
    end;

    for i:=0 to TestSL.Count-1 do
    begin
      if (Expected.Count>i) and (TestSL[i]<>Expected[i]) then
      begin
        writeln('');
        writeln(TestName+': failed: result:');
        writeln('*'+TestSL[i]+'*');
        writeln('while expected was:');
        writeln('*'+Expected[i]+'*');
        result:=false;
      end;
    end;
  finally
    Expected.Free;
    TestSL.Free;
  end;
end;

function Get_StrictDelimTrue:boolean;
// Test if input works with Delphi-compatible sdf output
// Strictdelimiter:=true when processing the delimitedtext
//
// Mainly check if reading quotes is according to Delphi sdf specs and works.
// Based on del4.zip in bug 19610
const
  // Matches del4.zip in bug 19610:
  DelimText='normal_string;"quoted_string";"quoted;delimiter";"quoted and space";"""quoted_and_starting_quote";"""quoted, starting quote, and space";"quoted_with_tab'+#9+'character";"quoted_multi'+LineEnding+
    'line";  UnquotedSpacesInfront;UnquotedSpacesAtTheEnd   ;  "Spaces before quoted string"';
  TestName='tw19610.Get_StrictDelimTrue';
var
  TestSL: TStringList;
  Expected: TStringList;
  i: integer;
begin
  result:=true;
  //Expected values:
  Expected:=TStringList.Create;
  TestSL:=TStringList.Create;
  try
    Expected.Add('normal_string');
    Expected.Add('quoted_string');
    Expected.Add('quoted;delimiter');
    Expected.Add('quoted and space');
    Expected.Add('"quoted_and_starting_quote');
    Expected.Add('"quoted, starting quote, and space');
    Expected.Add('quoted_with_tab'+#9+'character');
    Expected.Add('quoted_multi'+LineEnding+
      'line');
    Expected.Add('  UnquotedSpacesInfront');
    Expected.Add('UnquotedSpacesAtTheEnd   ');
    Expected.Add('  "Spaces before quoted string"');

    TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
    TestSL.StrictDelimiter:=true;
    TestSL.DelimitedText:=DelimText;
    //Test:
    if Expected.Count<>TestSL.Count then
    begin
      writeln('');
      writeln(TestName+': failed: count mismatch: '+
      inttostr(TestSL.Count)+' test strings; '+inttostr(Expected.Count)+' expected strings.');
    end;
    for i:=0 to TestSL.Count-1 do
    begin
      if (Expected.Count>i) and (TestSL[i]<>Expected[i]) then
      begin
        writeln('');
        writeln(TestName+': failed: result:');
        writeln('*'+TestSL[i]+'*');
        writeln('while expected was:');
        writeln('*'+Expected[i]+'*');
        result:=false;
      end;
    end;
  finally
    Expected.Free;
    TestSL.Free;
  end;
end;

function Get_StrictDelimFalseCornerCases:boolean;
// Test if input works with Delphi-compatible sdf output
// Strictdelimiter:=false (default) when processing the delimitedtext
//
// Has some corner cases that Delphi produces but are not evident from their
// documentation
// Based on del4.zip in bug 19610
const
  // Matches del4.zip in bug 19610:
  DelimText='"Spaces after quoted string"   ;';
  TestName='tw19610.Get_StrictDelimFalseCornerCases';
var
  TestSL: TStringList;
  Expected: TStringList;
  i: integer;
begin
  result:=true;
  //Expected values:
  Expected:=TStringList.Create;
  TestSL:=TStringList.Create;
  try
    Expected.Add('Spaces after quoted string');
    Expected.Add('');

    TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
    TestSL.StrictDelimiter:=false;
    TestSL.DelimitedText:=DelimText;
    //Test:
    if Expected.Count<>TestSL.Count then
    begin
      writeln('');
      writeln(TestName+': failed: count mismatch: '+
      inttostr(TestSL.Count)+' test strings; '+inttostr(Expected.Count)+' expected strings.');
    end;
    for i:=0 to TestSL.Count-1 do
    begin
      if (Expected.Count>i) and (TestSL[i]<>Expected[i]) then
      begin
        writeln('');
        writeln(TestName+': failed: result:');
        writeln('*'+TestSL[i]+'*');
        writeln('while expected was:');
        writeln('*'+Expected[i]+'*');
        result:=false;
      end;
    end;
  finally
    Expected.Free;
    TestSL.Free;
  end;
end;

function Get_StrictDelimTrueCornerCases:boolean;
// Test if input works with Delphi-compatible sdf output
// Strictdelimiter:=true when processing the delimitedtext
//
// Has some corner cases that Delphi produces but are not evident from their
// documentation
// Based on del4.zip in bug 19610
const
  // Matches del4.zip in bug 19610:
  DelimText='"Spaces after quoted string"   ;';
  TestName='tw19610.Get_StrictDelimTrueCornerCases';
var
  TestSL: TStringList;
  Expected: TStringList;
  i: integer;
begin
  result:=true;
  //Expected values:
  Expected:=TStringList.Create;
  TestSL:=TStringList.Create;
  try
    // With delimiter true, we get 2 extra empty lines, also some spaces
    Expected.Add('Spaces after quoted string');
    Expected.Add('   ');
    Expected.Add('');

    TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
    TestSL.StrictDelimiter:=true;
    TestSL.DelimitedText:=DelimText;
    //Test:
    if Expected.Count<>TestSL.Count then
    begin
      writeln('');
      writeln(TestName+': failed: count mismatch: '+
      inttostr(TestSL.Count)+' test strings; '+inttostr(Expected.Count)+' expected strings.');
    end;
    for i:=0 to TestSL.Count-1 do
    begin
      if (Expected.Count>i) and (TestSL[i]<>Expected[i]) then
      begin
        writeln('');
        writeln(TestName+': failed: result:');
        writeln('*'+TestSL[i]+'*');
        writeln('while expected was:');
        writeln('*'+Expected[i]+'*');
        result:=false;
      end;
    end;
  finally
    Expected.Free;
    TestSL.Free;
  end;
end;

function Get_StrictDelimTrueSafeQuote:boolean;
// Test if input works with sdf output that has always been quoted
// Delphi accepts this input even though it does not write it by default
// This is a more unambiguous format than unquoted
// Strictdelimiter:=true when processing the delimitedtext
//
const
  DelimText='"normal_string";"""quoted_string""";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"string_with_tab'+#9+'character";"multi'+LineEnding+
    'line";"  SpacesInfront";"SpacesAtTheEnd   ";"  ""Spaces before quoted string"""';
  TestName='tw19610.Get_StrictDelimTrueSafeQuote';
var
  TestSL: TStringList;
  Expected: TStringList;
  i: integer;
begin
  result:=true;
  //Expected values:
  Expected:=TStringList.Create;
  TestSL:=TStringList.Create;
  try
    Expected.Add('normal_string');
    Expected.Add('"quoted_string"');
    Expected.Add('"quoted;delimiter"');
    Expected.Add('"quoted and space"');
    Expected.Add('"starting_quote');
    Expected.Add('string_with_tab'+#9+'character');
    Expected.Add('multi'+LineEnding+
      'line');
    Expected.Add('  SpacesInfront');
    Expected.Add('SpacesAtTheEnd   ');
    Expected.Add('  "Spaces before quoted string"');

    TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
    TestSL.StrictDelimiter:=true;
    TestSL.DelimitedText:=DelimText;
    //Test:
    if Expected.Count<>TestSL.Count then
    begin
      writeln('');
      writeln(TestName+': failed: count mismatch: '+
      inttostr(TestSL.Count)+' test strings; '+inttostr(Expected.Count)+' expected strings.');
    end;
    for i:=0 to TestSL.Count-1 do
    begin
      if (Expected.Count>i) and (TestSL[i]<>Expected[i]) then
      begin
        writeln('');
        writeln(TestName+': failed: result:');
        writeln('*'+TestSL[i]+'*');
        writeln('while expected was:');
        writeln('*'+Expected[i]+'*');
        result:=false;
      end;
    end;
  finally
    Expected.Free;
    TestSL.Free;
  end;
end;

function Get_StrictDelimFalseSafeQuote:boolean;
// Test if input works with sdf output that has always been quoted
// Delphi accepts this input even though it does not write it by default
// This is a more unambiguous format than unquoted
// Strictdelimiter:=false when processing the delimitedtext
//
const
  DelimText='"normal_string";"""quoted_string""";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"string_with_tab'+#9+'character";"multi'+LineEnding+
    'line";"  SpacesInfront";"SpacesAtTheEnd   ";"  ""Spaces before quoted string"""';
  TestName='tw19610.Get_StrictDelimTrueSafeQuote';
var
  TestSL: TStringList;
  Expected: TStringList;
  i: integer;
begin
  result:=true;
  //Expected values:
  Expected:=TStringList.Create;
  TestSL:=TStringList.Create;
  try
    Expected.Add('normal_string');
    Expected.Add('"quoted_string"');
    Expected.Add('"quoted;delimiter"');
    Expected.Add('"quoted and space"');
    Expected.Add('"starting_quote');
    Expected.Add('string_with_tab'+#9+'character');
    Expected.Add('multi'+LineEnding+
      'line');
    Expected.Add('  SpacesInfront');
    Expected.Add('SpacesAtTheEnd   ');
    Expected.Add('  "Spaces before quoted string"');

    TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
    TestSL.StrictDelimiter:=false;
    TestSL.DelimitedText:=DelimText;
    //Test:
    if Expected.Count<>TestSL.Count then
    begin
      writeln('');
      writeln(TestName+': failed: count mismatch: '+
      inttostr(TestSL.Count)+' test strings; '+inttostr(Expected.Count)+' expected strings.');
    end;
    for i:=0 to TestSL.Count-1 do
    begin
      if (Expected.Count>i) and (TestSL[i]<>Expected[i]) then
      begin
        writeln('');
        writeln(TestName+': failed: result:');
        writeln('*'+TestSL[i]+'*');
        writeln('while expected was:');
        writeln('*'+Expected[i]+'*');
        result:=false;
      end;
    end;
  finally
    Expected.Free;
    TestSL.Free;
  end;
end;

function Get_Commatext:boolean;
// Test if input works with Delphi-compatible commatext
const
  CommaText='normal_string,"quoted_string","quoted,delimiter","quoted and space","""quoted_and_starting_quote","""quoted, starting quote, and space","quoted_with_tab'+#9+'character","quoted_multi'+LineEnding+
    'line","  UnquotedSpacesInfront","UnquotedSpacesAtTheEnd   ","  ""Spaces before quoted string"""';
  TestName='tw19610.Get_Commatext';
var
  TestSL: TStringList;
  Expected: TStringList;
  i: integer;
begin
  result:=true;
  //Expected values:
  Expected:=TStringList.Create;
  TestSL:=TStringList.Create;
  try
    Expected.Add('normal_string');
    Expected.Add('quoted_string');
    Expected.Add('quoted,delimiter');
    Expected.Add('quoted and space');
    Expected.Add('"quoted_and_starting_quote');
    Expected.Add('"quoted, starting quote, and space');
    Expected.Add('quoted_with_tab'+#9+'character');
    Expected.Add('quoted_multi'+LineEnding+
      'line');
    Expected.Add('  UnquotedSpacesInfront');
    Expected.Add('UnquotedSpacesAtTheEnd   ');
    Expected.Add('  "Spaces before quoted string"');

    TestSL.CommaText:=CommaText;
    //Test:
    if Expected.Count<>TestSL.Count then
    begin
      writeln('');
      writeln(TestName+': failed: count mismatch: '+
      inttostr(TestSL.Count)+' test strings; '+inttostr(Expected.Count)+' expected strings.');
    end;

    for i:=0 to TestSL.Count-1 do
    begin
      if (Expected.Count>i) and (TestSL[i]<>Expected[i]) then
      begin
        writeln('');
        writeln(TestName+': failed: result:');
        writeln('*'+TestSL[i]+'*');
        writeln('while expected was:');
        writeln('*'+Expected[i]+'*');
        result:=false;
      end;
    end;
  finally
    Expected.Free;
    TestSL.Free;
  end;
end;


function Put_StrictDelimFalse:boolean;
// Test if conversion stringlist=>delimitedtext gives the right data
// (right in this case: what Delphi outputs)
// Strictdelimiter:=false when processing the delimitedtext
const
  Expected='normal_string;"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";"with_tab'+#9+'character";"multi'+LineEnding+
    'line";"   UnquotedSpacesInfront";"UnquotedSpacesAtTheEnd  ";"  ""Spaces before quoted string"""';
  //If we choose to output the "safely quoted" version, we need to test for it:
  //Though this version is not the same output as Delphi, it leads to the
  //same input if imported again (see Get_StrictDelimFalseSafeQuote for corresponding tests)
  ExpectedSafeQuote='"normal_string";"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";"with_tab'+#9+'character";"multi'+LineEnding+
    'line";"   UnquotedSpacesInfront";"UnquotedSpacesAtTheEnd  ";"  ""Spaces before quoted string"""';
  TestName='tw19610.Put_StrictDelimFalse';
var
  TestSL: TStringList;
begin
  result:=true;
  TestSL:=TStringList.Create;
  try
    TestSL.Add('normal_string');
    TestSL.Add('"quoted_string"');
    TestSL.Add('just;delimiter');
    TestSL.Add('"quoted;delimiter"');
    TestSL.Add('"quoted and space"');
    TestSL.Add('"starting_quote');
    TestSL.Add('single"quote');
    TestSL.Add('""quoted starting quote and space"');
    TestSL.Add('with_tab'+#9+'character');
    TestSL.Add('multi'+LineEnding+
      'line');
    TestSL.Add('   UnquotedSpacesInfront');
    TestSL.Add('UnquotedSpacesAtTheEnd  ');
    TestSL.Add('  "Spaces before quoted string"');

    TestSL.Delimiter:=';';
    TestSL.StrictDelimiter:=false;
    if (TestSL.DelimitedText<>Expected) and (TestSL.DelimitedText<>ExpectedSafeQuote) then
    begin
      writeln('');
      writeln(TestName+': failed: result:');
      writeln('*'+TestSL.DelimitedText+'*');
      writeln('while expected was:');
      writeln('*'+Expected+'*');
      writeln('- or, with safe quote output:');
      writeln('*'+ExpectedSafeQuote+'*');
      result:=false
    end;
  finally
    TestSL.Free;
  end;
end;

function Put_StrictDelimTrue:boolean;
// Test if conversion stringlist=>delimitedtext gives the right data
// (right in this case: what Delphi outputs)
// Strictdelimiter:=true when processing the delimitedtext
const
  Expected='normal_string;"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";with_tab'+#9+'character;multi'+LineEnding+
    'line;   UnquotedSpacesInfront;UnquotedSpacesAtTheEnd  ;"  ""Spaces before quoted string"""';
  //If we choose to output the "safely quoted" version, we need to test for it:
  //Though this version is not the same output as Delphi, it leads to the
  //same input if imported again (see Get_StrictDelimTrueSafeQuote for corresponding tests)
  ExpectedSafeQuote='"normal_string";"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";"with_tab'+#9+'character";"multi'+LineEnding+
    'line";"   UnquotedSpacesInfront";"UnquotedSpacesAtTheEnd  ";"  ""Spaces before quoted string"""';
  TestName='tw19610.Put_StrictDelimTrue';
var
  TestSL: TStringList;
begin
  result:=true;
  TestSL:=TStringList.Create;
  try
    TestSL.Add('normal_string');
    TestSL.Add('"quoted_string"');
    TestSL.Add('just;delimiter');
    TestSL.Add('"quoted;delimiter"');
    TestSL.Add('"quoted and space"');
    TestSL.Add('"starting_quote');
    TestSL.Add('single"quote');
    TestSL.Add('""quoted starting quote and space"');
    TestSL.Add('with_tab'+#9+'character');
    TestSL.Add('multi'+LineEnding+
      'line');
    TestSL.Add('   UnquotedSpacesInfront');
    TestSL.Add('UnquotedSpacesAtTheEnd  ');
    TestSL.Add('  "Spaces before quoted string"');

    TestSL.Delimiter:=';';
    TestSL.StrictDelimiter:=true;
    if (TestSL.DelimitedText<>Expected) and (TestSL.DelimitedText<>ExpectedSafeQuote) then
    begin
      writeln('');
      writeln(TestName+': failed: result:');
      writeln('*'+TestSL.DelimitedText+'*');
      writeln('while expected was:');
      writeln('*'+Expected+'*');
      writeln('- or, with safe quote output:');
      writeln('*'+ExpectedSafeQuote+'*');
      result:=false
    end;
  finally
    TestSL.Free;
  end;
end;

function GetPut_StrictDelimFalse:boolean;
// Test if conversion stringlist=>delimitedtext=>stringlist gives identical data
// Strictdelimiter:=false (default) when processing the delimitedtext
const
  TestName='tw19610.GetPut_StrictDelimFalse';
var
  TestSL: TStringList;
  ResultSL: TStringList;
  i: integer;
begin
  result:=true;
  ResultSL:=TStringList.Create;
  TestSL:=TStringList.Create;
  try
    TestSL.Add('normal_string');
    TestSL.Add('"quoted_string"');
    TestSL.Add('"quoted;delimiter"');
    TestSL.Add('"quoted and space"');
    TestSL.Add('"starting_quote');
    TestSL.Add('""quoted, starting quote, and space"');
    TestSL.Add('with_tab'+#9+'character');
    TestSL.Add('multi'+LineEnding+
      'line');
    TestSL.Add('   UnquotedSpacesInfront');
    TestSL.Add('UnquotedSpacesAtTheEnd  ');
    TestSL.Add('  "Spaces before quoted string"');

    TestSL.Delimiter:=';';
    TestSL.StrictDelimiter:=false;
    ResultSL.Delimiter:=';';
    ResultSL.StrictDelimiter:=false;
    ResultSL.DelimitedText:=TestSL.DelimitedText;
    //Test:
    if ResultSL.Count<>TestSL.Count then
    begin
      writeln('');
      writeln(TestName+': failed: count mismatch: '+
      inttostr(TestSL.Count)+' test strings; '+inttostr(ResultSL.Count)+' expected strings.');
    end;

    for i:=0 to TestSL.Count-1 do
    begin
      if (ResultSL.Count>i) and (TestSL[i]<>ResultSL[i]) then
      begin
        writeln('');
        writeln(TestName+': failed: result:');
        writeln('*'+TestSL[i]+'*');
        writeln('while expected was:');
        writeln('*'+ResultSL[i]+'*');
        result:=false;
      end;
    end;
  finally
    ResultSL.Free;
    TestSL.Free;
  end;
end;

function GetPut_StrictDelimTrue:boolean;
// Test if conversion stringlist=>delimitedtext=>stringlist gives identical data
// Strictdelimiter:=true when processing the delimitedtext
const
  TestName='tw19610.GetPut_StrictDelimTrue';
var
  TestSL: TStringList;
  ResultSL: TStringList;
  i: integer;
begin
  result:=true;
  ResultSL:=TStringList.Create;
  TestSL:=TStringList.Create;
  try
    TestSL.Add('normal_string');
    TestSL.Add('"quoted_string"');
    TestSL.Add('"quoted;delimiter"');
    TestSL.Add('"quoted and space"');
    TestSL.Add('"starting_quote');
    TestSL.Add('""quoted, starting quote, and space"');
    TestSL.Add('with_tab'+#9+'character');
    TestSL.Add('multi'+LineEnding+
      'line');
    TestSL.Add('   UnquotedSpacesInfront');
    TestSL.Add('UnquotedSpacesAtTheEnd  ');
    TestSL.Add('  "Spaces before quoted string"');

    TestSL.Delimiter:=';';
    TestSL.StrictDelimiter:=false;
    ResultSL.Delimiter:=';';
    ResultSL.StrictDelimiter:=true;
    ResultSL.DelimitedText:=TestSL.DelimitedText;
    //Test:
    if ResultSL.Count<>TestSL.Count then
    begin
      writeln('');
      writeln(TestName+': failed: count mismatch: '+
      inttostr(TestSL.Count)+' test strings; '+inttostr(ResultSL.Count)+' expected strings.');
    end;

    for i:=0 to TestSL.Count-1 do
    begin
      if (ResultSL.Count>i) and (TestSL[i]<>ResultSL[i]) then
      begin
        writeln('');
        writeln(TestName+': failed: result:');
        writeln('*'+TestSL[i]+'*');
        writeln('while expected was:');
        writeln('*'+ResultSL[i]+'*');
        result:=false;
      end;
    end;
  finally
    ResultSL.Free;
    TestSL.Free;
  end;
end;

var
  FailCount: integer;
begin
  FailCount:=0;
  // The Get_... tests load in delimitedtext and test the resulting stringlist:
  if not(Get_StrictDelimFalse) then FailCount:=FailCount+1;
  if not(Get_StrictDelimTrue) then FailCount:=FailCount+1;
  if not(Get_StrictDelimFalseCornerCases) then FailCount:=FailCount+1;
  if not(Get_StrictDelimTrueCornerCases) then FailCount:=FailCount+1;
  if not(Get_StrictDelimTrueSafeQuote) then FailCount:=FailCount+1;
  if not(Get_StrictDelimFalseSafeQuote) then FailCount:=FailCount+1;

  if not(Get_CommaText) then FailCount:=FailCount+1;

  // The Put_... tests load strings and test the resulting delimitedtext:
  if not(Put_StrictDelimFalse) then FailCount:=FailCount+1;
  if not(Put_StrictDelimTrue) then FailCount:=FailCount+1;

  // Test writing to delimitedtext and reading from delimitedtext:
  if not(GetPut_StrictDelimFalse) then FailCount:=FailCount+1;
  if not(GetPut_StrictDelimTrue) then FailCount:=FailCount+1;

  // Indicate success or failure to test framework:
  if FailCount=0 then
  begin
    writeln('');
    writeln('tw19610: sdf tests succeeded.');
  end
  else
  begin
    writeln('');
    writeln('tw19610: sdf test(s) failed. Number of failed test group(s): '+inttostr(FailCount));
  end;

  halt(FailCount);
end.
tw19610.pp (24,594 bytes)

Reinier Olislagers

2012-09-20 13:48

developer   ~0062518

Added tw19610.pp for compiler test suite; tested on various Delphi versions (see source code). tw19610.pp can replace del4.zip as testing code.

Suggest:
- add tw19610.pp to the fpc tests direcotry (e.g. tests\webtbs)
- implementing patch DelimitedText2.diff

Reinier Olislagers

2012-09-21 11:28

developer   ~0062534

Last edited: 2012-09-21 13:33

Attached unix line ending version (DelimitedText2_unixlineending.diff) of (DelimitedText2.diff)
Patch still applies cleanly against current trunk (r22420).

Tested on Linux x64: before (see tw19610_testsbefore.txt): 5 test group failures
After: all tests succeeded.

Draft text for
http://wiki.lazarus.freepascal.org/User_Changes_Trunk#Unit_changes
TStrings.DelimitedText (unit Classes)
Old behaviour: If StrictDelim is true, TStrings.DelimitedText did not completely follow the SDF format specification (which is defined in Delphi help) at least in case of spaces (and presumably other low ASCII characters) in front and at the end of fields as well as quotes and line endings.
Worse, if StrictDelimiter is true, and in the cases mentioned above, saving a TString .DelimitedText and loading that text in another TString lead to differences between the two.
Note: StrictDelimiter is false by default.
New behaviour: FPC follows Delphi behavior.
Reason: Consistency (writing out and reading in DelimitedText should result in the same strings), Delphi compatibility (following the SDF specification).
Remedy: Review your existing code that reads or write DelimitedText; if necessary convert data or write converter code. See tests\webtbs\tw19610.pp for a detailed test.
***end draft text***

Related/parent of: Documentation patch in 22939

2012-09-21 11:28

 

DelimitedText2_unixlineending.diff (3,389 bytes)
Index: rtl/objpas/classes/stringl.inc
===================================================================
--- rtl/objpas/classes/stringl.inc	(revision 20119)
+++ rtl/objpas/classes/stringl.inc	(working copy)
@@ -140,30 +140,33 @@
 Var
   I : integer;
   p : pchar;
-  c : set of char;
+  BreakChars : set of char;
   S : String;
   
 begin
   CheckSpecialChars;
   result:='';
   if StrictDelimiter then
-    c:=[#0,Delimiter]
+    BreakChars:=[#0,QuoteChar,Delimiter]
   else  
-    c:=[#0..' ',QuoteChar,Delimiter];
+    BreakChars:=[#0..' ',QuoteChar,Delimiter];
+
+  // Check for break characters and quote if required.
   For i:=0 to count-1 do
     begin
     S:=Strings[i];
     p:=pchar(S);
-    while not(p^ in c) do
+    //Quote strings that include BreakChars:
+    while not(p^ in BreakChars) do
      inc(p);
-// strings in list may contain #0
-    if (p<>pchar(S)+length(S)) and not StrictDelimiter then
+    if (p<>pchar(S)+length(S)) then
       Result:=Result+QuoteString(S,QuoteChar)
     else
       Result:=Result+S;
     if I<Count-1 then 
       Result:=Result+Delimiter;
     end;
+  // Quote empty string:
   If (Length(Result)=0) and (Count=1) then
     Result:=QuoteChar+QuoteChar;
 end;
@@ -268,22 +271,48 @@
  j:=1;
  aNotFirst:=false;
 
+ { Paraphrased from Delphi XE2 help:
+ Strings must be separated by Delimiter characters or spaces.
+ They may be enclosed in QuoteChars.
+ QuoteChars in the string must be repeated to distinguish them from the QuoteChars enclosing the string.
+ }
  try
   Clear;
   If StrictDelimiter then
     begin
-    // Easier, faster loop.
-    While I<=Length(AValue) do
-      begin
-      If (AValue[I] in [FDelimiter,#0]) then
-        begin
-        Add(Copy(AValue,J,I-J));
-        J:=I+1;
-        end;
-      Inc(i);
+    while i<=length(AValue) do begin
+     // skip delimiter
+     if aNotFirst and (i<=length(AValue)) and (AValue[i]=FDelimiter) then inc(i);
+
+     // read next string
+     if i<=length(AValue) then begin
+      if AValue[i]=FQuoteChar then begin
+       // next string is quoted
+       j:=i+1;
+       while (j<=length(AValue)) and
+             ( (AValue[j]<>FQuoteChar) or
+               ( (j+1<=length(AValue)) and (AValue[j+1]=FQuoteChar) ) ) do begin
+        if (j<=length(AValue)) and (AValue[j]=FQuoteChar) then inc(j,2)
+                                                          else inc(j);
+       end;
+       // j is position of closing quote
+       Add( StringReplace (Copy(AValue,i+1,j-i-1),
+                           FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
+       i:=j+1;
+      end else begin
+       // next string is not quoted; read until delimiter
+       j:=i;
+       while (j<=length(AValue)) and
+             (AValue[j]<>FDelimiter) do inc(j);
+       Add( Copy(AValue,i,j-i));
+       i:=j;
       end;
-    If (Length(AValue)>0) then
-      Add(Copy(AValue,J,I-J));  
+     end else begin
+      if aNotFirst then Add('');
+     end;
+
+     aNotFirst:=true;
+    end;
     end
   else 
     begin
@@ -310,7 +339,7 @@
                            FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
        i:=j+1;
       end else begin
-       // next string is not quoted
+       // next string is not quoted; read until control character/space/delimiter
        j:=i;
        while (j<=length(AValue)) and
              (Ord(AValue[j])>Ord(' ')) and

2012-09-21 11:29

 

tw19610_testsbefore.txt (5,103 bytes)
tw19610.Get_StrictDelimTrue: failed: count mismatch: 12 test strings; 11 expected strings.

tw19610.Get_StrictDelimTrue: failed: result:
*"quoted_string"*
while expected was:
*quoted_string*

tw19610.Get_StrictDelimTrue: failed: result:
*"quoted*
while expected was:
*quoted;delimiter*

tw19610.Get_StrictDelimTrue: failed: result:
*delimiter"*
while expected was:
*quoted and space*

tw19610.Get_StrictDelimTrue: failed: result:
*"quoted and space"*
while expected was:
*"quoted_and_starting_quote*

tw19610.Get_StrictDelimTrue: failed: result:
*"""quoted_and_starting_quote"*
while expected was:
*"quoted, starting quote, and space*

tw19610.Get_StrictDelimTrue: failed: result:
*"""quoted, starting quote, and space"*
while expected was:
*quoted_with_tab	character*

tw19610.Get_StrictDelimTrue: failed: result:
*"quoted_with_tab	character"*
while expected was:
*quoted_multi
line*

tw19610.Get_StrictDelimTrue: failed: result:
*"quoted_multi
line"*
while expected was:
*  UnquotedSpacesInfront*

tw19610.Get_StrictDelimTrue: failed: result:
*  UnquotedSpacesInfront*
while expected was:
*UnquotedSpacesAtTheEnd   *

tw19610.Get_StrictDelimTrue: failed: result:
*UnquotedSpacesAtTheEnd   *
while expected was:
*  "Spaces before quoted string"*

tw19610.Get_StrictDelimTrueCornerCases: failed: count mismatch: 2 test strings; 3 expected strings.

tw19610.Get_StrictDelimTrueCornerCases: failed: result:
*"Spaces after quoted string"   *
while expected was:
*Spaces after quoted string*

tw19610.Get_StrictDelimTrueCornerCases: failed: result:
**
while expected was:
*   *

tw19610.Get_StrictDelimTrueSafeQuote: failed: count mismatch: 11 test strings; 10 expected strings.

tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
*"normal_string"*
while expected was:
*normal_string*

tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
*"""quoted_string"""*
while expected was:
*"quoted_string"*

tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
*"""quoted*
while expected was:
*"quoted;delimiter"*

tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
*delimiter"""*
while expected was:
*"quoted and space"*

tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
*"""quoted and space"""*
while expected was:
*"starting_quote*

tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
*"""starting_quote"*
while expected was:
*string_with_tab	character*

tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
*"string_with_tab	character"*
while expected was:
*multi
line*

tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
*"multi
line"*
while expected was:
*  SpacesInfront*

tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
*"  SpacesInfront"*
while expected was:
*SpacesAtTheEnd   *

tw19610.Get_StrictDelimTrueSafeQuote: failed: result:
*"SpacesAtTheEnd   "*
while expected was:
*  "Spaces before quoted string"*

tw19610.Put_StrictDelimTrue: failed: result:
*normal_string;"quoted_string";just;delimiter;"quoted;delimiter";"quoted and space";"starting_quote;single"quote;""quoted starting quote and space";with_tab	character;multi
line;   UnquotedSpacesInfront;UnquotedSpacesAtTheEnd  ;  "Spaces before quoted string"*
while expected was:
*normal_string;"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";with_tab	character;multi
line;   UnquotedSpacesInfront;UnquotedSpacesAtTheEnd  ;"  ""Spaces before quoted string"""*
- or, with safe quote output:
*"normal_string";"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";"with_tab	character";"multi
line";"   UnquotedSpacesInfront";"UnquotedSpacesAtTheEnd  ";"  ""Spaces before quoted string"""*

tw19610.GetPut_StrictDelimTrue: failed: count mismatch: 11 test strings; 12 expected strings.

tw19610.GetPut_StrictDelimTrue: failed: result:
*"quoted_string"*
while expected was:
*"""quoted_string"""*

tw19610.GetPut_StrictDelimTrue: failed: result:
*"quoted;delimiter"*
while expected was:
*"""quoted*

tw19610.GetPut_StrictDelimTrue: failed: result:
*"quoted and space"*
while expected was:
*delimiter"""*

tw19610.GetPut_StrictDelimTrue: failed: result:
*"starting_quote*
while expected was:
*"""quoted and space"""*

tw19610.GetPut_StrictDelimTrue: failed: result:
*""quoted, starting quote, and space"*
while expected was:
*"""starting_quote"*

tw19610.GetPut_StrictDelimTrue: failed: result:
*with_tab	character*
while expected was:
*"""""quoted, starting quote, and space"""*

tw19610.GetPut_StrictDelimTrue: failed: result:
*multi
line*
while expected was:
*"with_tab	character"*

tw19610.GetPut_StrictDelimTrue: failed: result:
*   UnquotedSpacesInfront*
while expected was:
*"multi
line"*

tw19610.GetPut_StrictDelimTrue: failed: result:
*UnquotedSpacesAtTheEnd  *
while expected was:
*"   UnquotedSpacesInfront"*

tw19610.GetPut_StrictDelimTrue: failed: result:
*  "Spaces before quoted string"*
while expected was:
*"UnquotedSpacesAtTheEnd  "*

tw19610: sdf test(s) failed. Number of failed test group(s): 5
tw19610_testsbefore.txt (5,103 bytes)

Marco van de Voort

2012-10-05 18:56

manager   ~0062909

Committed...... finally.

Issue History

Date Modified Username Field Change
2011-06-22 10:41 Marco van de Voort New Issue
2011-06-22 10:41 Marco van de Voort File Added: strl.pp
2011-06-22 10:41 Marco van de Voort FPCOldBugId => 0
2011-06-22 10:46 Marco van de Voort Summary TStringList doesn't respect quotechar => TStringList.delimitedtext doesn't respect quotechar
2011-06-22 10:46 Marco van de Voort Description Updated
2012-01-20 07:46 Reinier Olislagers Note Added: 0055872
2012-01-20 07:46 Reinier Olislagers File Added: delimitedtext.pas
2012-01-20 07:51 Reinier Olislagers Note Edited: 0055872
2012-01-20 08:50 Marco van de Voort Note Added: 0055874
2012-01-20 08:57 Reinier Olislagers Note Edited: 0055872
2012-01-20 09:27 Reinier Olislagers Note Edited: 0055872
2012-01-20 09:27 Reinier Olislagers File Added: DelimitedText.diff
2012-01-20 09:38 Reinier Olislagers Note Added: 0055876
2012-01-20 09:57 Reinier Olislagers Note Edited: 0055876
2012-01-20 10:12 Reinier Olislagers File Added: DelimitedText2.diff
2012-01-20 10:17 Reinier Olislagers Note Added: 0055880
2012-01-20 10:24 Reinier Olislagers Note Edited: 0055880
2012-01-21 12:25 Reinier Olislagers Note Edited: 0055880
2012-01-21 12:30 Reinier Olislagers Note Edited: 0055880
2012-01-21 12:47 Reinier Olislagers Note Edited: 0055876
2012-01-21 12:48 Reinier Olislagers Note Edited: 0055876
2012-01-21 12:48 Reinier Olislagers Note Edited: 0055880
2012-01-21 12:55 Reinier Olislagers Note Edited: 0055880
2012-01-21 13:28 Reinier Olislagers Note Edited: 0055880
2012-01-21 14:13 Reinier Olislagers Note Edited: 0055880
2012-01-21 14:56 Reinier Olislagers Note Edited: 0055880
2012-01-21 14:56 Reinier Olislagers Note Added: 0055915
2012-01-21 14:58 Reinier Olislagers File Added: stringl.inc
2012-01-21 14:58 Reinier Olislagers Note Edited: 0055915
2012-01-31 16:26 Reinier Olislagers File Added: delimited_with_test_output.zip
2012-01-31 16:27 Reinier Olislagers Note Edited: 0055876
2012-01-31 16:28 Reinier Olislagers Note Edited: 0055876
2012-06-04 22:11 Marco van de Voort Status new => assigned
2012-06-04 22:11 Marco van de Voort Assigned To => Marco van de Voort
2012-06-07 09:14 Reinier Olislagers Note Added: 0060326
2012-06-07 11:27 Reinier Olislagers Note Edited: 0060326
2012-06-07 11:27 Reinier Olislagers File Added: delimited3.zip
2012-06-07 12:10 Reinier Olislagers Note Added: 0060335
2012-06-07 12:12 Reinier Olislagers Note Edited: 0060326
2012-06-07 19:29 Bart Broersma Note Added: 0060346
2012-06-07 19:33 Reinier Olislagers Note Added: 0060347
2012-06-07 19:34 Bart Broersma Note Added: 0060348
2012-06-07 19:35 Bart Broersma Note Added: 0060349
2012-06-07 19:40 Reinier Olislagers Note Edited: 0060347
2012-06-07 19:42 Reinier Olislagers Note Edited: 0060347
2012-06-07 19:43 Reinier Olislagers Note Added: 0060350
2012-06-07 19:44 Bart Broersma Note Added: 0060351
2012-06-07 19:50 Bart Broersma Note Edited: 0060351
2012-06-07 19:59 Bart Broersma File Added: delimited3.dpr
2012-06-07 19:59 Bart Broersma Note Edited: 0060351
2012-06-07 20:11 Reinier Olislagers Note Added: 0060352
2012-06-07 21:20 Marco van de Voort Relationship added related to 0022182
2012-06-08 07:43 Reinier Olislagers File Added: del4.zip
2012-06-08 07:59 Reinier Olislagers Note Edited: 0060352
2012-06-08 08:12 Reinier Olislagers Note Edited: 0060352
2012-06-08 08:17 Reinier Olislagers Note Edited: 0060352
2012-06-08 08:43 Bart Broersma Note Added: 0060363
2012-06-08 10:26 Reinier Olislagers Note Added: 0060369
2012-06-08 10:27 Reinier Olislagers Note Edited: 0060369
2012-06-08 13:58 Bart Broersma Note Added: 0060376
2012-06-08 14:23 Reinier Olislagers Note Added: 0060378
2012-06-08 14:58 Reinier Olislagers Note Edited: 0060378
2012-06-12 10:28 Bart Broersma Note Added: 0060470
2012-06-12 11:36 Reinier Olislagers Note Added: 0060472
2012-09-20 13:37 Reinier Olislagers File Added: tw19610.pp
2012-09-20 13:48 Reinier Olislagers Note Added: 0062518
2012-09-21 11:28 Reinier Olislagers Note Added: 0062534
2012-09-21 11:28 Reinier Olislagers File Added: DelimitedText2_unixlineending.diff
2012-09-21 11:29 Reinier Olislagers File Added: tw19610_testsbefore.txt
2012-09-21 12:09 Reinier Olislagers Note Edited: 0062534
2012-09-21 13:33 Reinier Olislagers Note Edited: 0062534
2012-10-05 18:55 Marco van de Voort Relationship added parent of 0022939
2012-10-05 18:56 Marco van de Voort Fixed in Revision => 22549
2012-10-05 18:56 Marco van de Voort Status assigned => resolved
2012-10-05 18:56 Marco van de Voort Fixed in Version => 2.7.1
2012-10-05 18:56 Marco van de Voort Resolution open => fixed
2012-10-05 18:56 Marco van de Voort Note Added: 0062909
2014-03-04 17:53 Jonas Maebe Fixed in Revision 22549 => 23652
2014-03-04 17:53 Jonas Maebe Fixed in Version 2.7.1 => 2.6.4
2017-03-01 19:26 Marco van de Voort Status resolved => closed