ошибка в TStringList

[Attid]

ФПЦ 2,2,0

если поставить sorted в тру то при добавлении обьектов мы теряем обьекты

все просто код 1

Код: Выделить всё

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

begin
  Result:=Add(S);
  Objects[result]:=AObject;
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;


строка 1080 Stringl.inc

как видим если Find ничего не нашел то обьект будет присвен или 0 строке или последней. или я не правильно понял поиск

Код: Выделить всё

Function TStringList.Find(const S: string; var 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;     

но то что не работает это в этом я уверен =)

хотя может опять ЮТФ8 шалит. %)

[Logo]

FPC 2.2.3 в Linux работает нормально. Только что проверил.
Вообще, то у меня сложилась практика, сортировку включать после того, как строки добавлены. Когда-то, где то оно некрасиво подтормаживало, вот и начал сортировать после добавления, так и привык.

[Sergei I. Gorelkin]

Метод Find на сортированном списке работает так:
- если искомая строка есть, то возвращается ее индекс
- если ее нет, возвращается тот индекс, куда нужно вставить строку, чтобы список остался отсортированным.

Но с utf-8 строками, если не переопределить DoCompareText, сортировка будет явно не похожа на то, что предполагается увидеть...

[Attid]

загадочно сделал тест на работе

Код: Выделить всё

program project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes
  { you can add units after this };

{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
var i : integer;
var sl : TStringList;
begin
  sl := TStringList.Create;

  sl.AddObject('мама',TObject(1));
  sl.AddObject('папа',TObject(2));
  sl.AddObject('бабушка',TObject(4));
  sl.AddObject('дедушка',TObject(3));

  for i := 0 to sl.Count -1 do
    WriteLn(sl[i],Integer(sl.Objects[i]));

  WriteLn('**************************');
  sl.Clear;
  sl.Sorted:=True;
  sl.AddObject('мама',TObject(1));
  sl.AddObject('папа',TObject(2));
  sl.AddObject('дедушка',TObject(3));
  sl.AddObject('бабушка',TObject(4));

  for i := 0 to sl.Count -1 do
    WriteLn(sl[i],Integer(sl.Objects[i]));

  WriteLn('**************************');
  sl.Clear;
  sl.Sorted:=True;
  sl.AddObject('mother',TObject(1));
  sl.AddObject('father',TObject(2));
  sl.AddObject('greny',TObject(3));
  sl.AddObject('older',TObject(4));

  for i := 0 to sl.Count -1 do
    WriteLn(sl[i],Integer(sl.Objects[i]));

end.



все нормально отработало, хотя компилятор как и дома. только лазарус свн =/

а дома час потерял пока искал куда деваются обьекты =(