paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 20:29:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed tstringlist.setcapacity for growing

Browse Source
This commit is contained in:
peter 1998-11-12 23:43:44 +00:00
parent 70261b4c01
commit 551046a9cd
1 changed files with 89 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

176
fcl/inc/strings.inc
View File

@ -32,7 +32,7 @@ begin
begin begin
I:=I+1; I:=I+1;
J:=J+1; J:=J+1;
if S[i]=Quote then if S[i]=Quote then
begin begin
System.Insert(Result,Quote,J); System.Insert(Result,Quote,J);
J:=J+1; J:=J+1;
@ -47,7 +47,7 @@ Var I : Longint;
begin begin
result:=''; result:='';
For i:=0 to count-1 do For i:=0 to count-1 do
begin begin
Result:=Result+QuoteString (Strings[I],'"'); Result:=Result+QuoteString (Strings[I],'"');
if I<Count-1 then Result:=Result+','; if I<Count-1 then Result:=Result+',';
@ -94,7 +94,7 @@ Procedure TStrings.ReadData(Reader: TReader);
begin begin
end; end;
Function GetQuotedString (Var P : Pchar) : AnsiString; Function GetQuotedString (Var P : Pchar) : String;
Var P1,L : Pchar; Var P1,L : Pchar;
@ -103,16 +103,16 @@ begin
P1:=P+1; P1:=P+1;
While P1^<>#0 do While P1^<>#0 do
begin begin
If (P1^='"') and (P1[1]<>'"') then If (P1^='"') and (P1[1]<>'"') then
break; break;
P1:=P1+1; P1:=P1+1;
If P1^='"' then P1:=P1+1; If P1^='"' then P1:=P1+1;
end; end;
// P1 points to last quote, or to #0; // P1 points to last quote, or to #0;
P:=P+1; P:=P+1;
If P1-P>0 then If P1-P>0 then
begin begin
SetLength(Result,(P1-P)); SetLength(Result,P1-P);
L:=Pointer(Result); L:=Pointer(Result);
Move (P^,L^,P1-P); Move (P^,L^,P1-P);
P:=P1+1; P:=P1+1;
@ -184,7 +184,7 @@ end;
Procedure TStrings.DefineProperties(Filer: TFiler); Procedure TStrings.DefineProperties(Filer: TFiler);
begin begin
end; end;
@ -200,7 +200,7 @@ end;
Function TStrings.GetCapacity: Integer; Function TStrings.GetCapacity: Integer;
begin begin
Result:=Count; Result:=Count;
@ -208,7 +208,7 @@ end;
Function TStrings.GetObject(Index: Integer): TObject; Function TStrings.GetObject(Index: Integer): TObject;
begin begin
Result:=Nil; Result:=Nil;
@ -216,7 +216,7 @@ end;
Function TStrings.GetTextStr: string; Function TStrings.GetTextStr: string;
Const Const
{$ifdef linux} {$ifdef linux}
@ -226,7 +226,7 @@ Const
{$endif} {$endif}
Var P : Pchar; Var P : Pchar;
I,L : Longint; I,L : Longint;
S : String; S : String;
PS : Pointer; PS : Pointer;
@ -235,12 +235,12 @@ begin
L:=0; L:=0;
For I:=0 to count-1 do L:=L+Length(Strings[I])+NewLineSize; For I:=0 to count-1 do L:=L+Length(Strings[I])+NewLineSize;
Setlength(Result,0); Setlength(Result,0);
P:=Pointer(Result); P:=Pointer(Result);
For i:=0 To count-1 do For i:=0 To count-1 do
begin begin
S:=Strings[I]; S:=Strings[I];
L:=Length(S); L:=Length(S);
if L<>0 then if L<>0 then
System.Move(Pointer(S)^,P^,L); System.Move(Pointer(S)^,P^,L);
P:=P+L; P:=P+L;
p[0]:=#10; p[0]:=#10;
@ -253,7 +253,7 @@ end;
Procedure TStrings.Put(Index: Integer; const S: string); Procedure TStrings.Put(Index: Integer; const S: string);
Var Obj : TObject; Var Obj : TObject;
@ -265,7 +265,7 @@ end;
Procedure TStrings.PutObject(Index: Integer; AObject: TObject); Procedure TStrings.PutObject(Index: Integer; AObject: TObject);
begin begin
// Empty. // Empty.
@ -273,14 +273,14 @@ end;
Procedure TStrings.SetCapacity(NewCapacity: Integer); Procedure TStrings.SetCapacity(NewCapacity: Integer);
begin begin
// Empty. // Empty.
end; end;
Procedure TStrings.SetTextStr(const Value: string); Procedure TStrings.SetTextStr(const Value: string);
begin begin
SetText(PChar(Value)); SetText(PChar(Value));
@ -288,14 +288,14 @@ end;
Procedure TStrings.SetUpdateState(Updating: Boolean); Procedure TStrings.SetUpdateState(Updating: Boolean);
begin begin
end; end;
destructor TSTrings.Destroy; destructor TSTrings.Destroy;
begin begin
inherited destroy; inherited destroy;
@ -303,7 +303,7 @@ end;
Function TStrings.Add(const S: string): Integer; Function TStrings.Add(const S: string): Integer;
begin begin
Result:=Count; Result:=Count;
@ -312,7 +312,7 @@ end;
Function TStrings.AddObject(const S: string; AObject: TObject): Integer; Function TStrings.AddObject(const S: string; AObject: TObject): Integer;
begin begin
Result:=Add(S); Result:=Add(S);
@ -329,7 +329,7 @@ end;
Procedure TStrings.AddStrings(TheStrings: TStrings); Procedure TStrings.AddStrings(TheStrings: TStrings);
Var Runner : longint; Var Runner : longint;
@ -340,7 +340,7 @@ end;
Procedure TStrings.Assign(Source: TPersistent); Procedure TStrings.Assign(Source: TPersistent);
begin begin
If Source is TStrings then If Source is TStrings then
@ -376,14 +376,14 @@ begin
Result:=False; Result:=False;
Nr:=Self.Count; Nr:=Self.Count;
if Nr<>TheStrings.Count then exit; if Nr<>TheStrings.Count then exit;
For Runner:=0 to Nr-1 do For Runner:=0 to Nr-1 do
If Strings[Runner]<>TheStrings[Runner] then exit; If Strings[Runner]<>TheStrings[Runner] then exit;
Result:=True; Result:=True;
end; end;
Procedure TStrings.Exchange(Index1, Index2: Integer); Procedure TStrings.Exchange(Index1, Index2: Integer);
Var Var
Obj : TObject; Obj : TObject;
@ -400,7 +400,7 @@ end;
Function TStrings.GetText: PChar; Function TStrings.GetText: PChar;
begin begin
Result:=StrNew(Pchar(Self.Text)); Result:=StrNew(Pchar(Self.Text));
@ -408,7 +408,7 @@ end;
Function TStrings.IndexOf(const S: string): Integer; Function TStrings.IndexOf(const S: string): Integer;
begin begin
@ -431,7 +431,7 @@ begin
if (len>0) and (Name=Copy(Strings[Result],1,Len)) then exit; if (len>0) and (Name=Copy(Strings[Result],1,Len)) then exit;
inc(result); inc(result);
end; end;
result:=-1; result:=-1;
end; end;
@ -456,7 +456,7 @@ end;
Procedure TStrings.LoadFromFile(const FileName: string); Procedure TStrings.LoadFromFile(const FileName: string);
Var TheStream : TFileStream; Var TheStream : TFileStream;
@ -468,7 +468,7 @@ end;
Procedure TStrings.LoadFromStream(Stream: TStream); Procedure TStrings.LoadFromStream(Stream: TStream);
begin begin
Text:=Stream.ReadAnsiString; Text:=Stream.ReadAnsiString;
@ -476,7 +476,7 @@ end;
Procedure TStrings.Move(CurIndex, NewIndex: Integer); Procedure TStrings.Move(CurIndex, NewIndex: Integer);
Var Obj : TObject; Var Obj : TObject;
Str : String; Str : String;
@ -485,12 +485,12 @@ begin
Obj:=Objects[CurIndex]; Obj:=Objects[CurIndex];
Str:=Strings[CurIndex]; Str:=Strings[CurIndex];
Delete(Curindex); Delete(Curindex);
InsertObject(NewIndex,Str,Obj); InsertObject(NewIndex,Str,Obj);
end; end;
Procedure TStrings.SaveToFile(const FileName: string); Procedure TStrings.SaveToFile(const FileName: string);
Var TheStream : TFileStream; Var TheStream : TFileStream;
@ -502,7 +502,7 @@ end;
Procedure TStrings.SaveToStream(Stream: TStream); Procedure TStrings.SaveToStream(Stream: TStream);
begin begin
Stream.WriteAnsiString(Text); Stream.WriteAnsiString(Text);
@ -526,7 +526,7 @@ begin
end; end;
Procedure TStrings.SetText(TheText: PChar); Procedure TStrings.SetText(TheText: PChar);
Var S : String; Var S : String;
@ -563,11 +563,11 @@ Var Extra : Longint;
begin begin
If FCapacity>64 then If FCapacity>64 then
Extra:=FCapacity Div 4 Extra:=FCapacity Div 4
Else If FCapacity>8 Then Else If FCapacity>8 Then
Extra:=16 Extra:=16
Else Else
Extra:=4; Extra:=4;
SetCapacity(FCapacity+Extra); SetCapacity(FCapacity+Extra);
end; end;
@ -585,7 +585,7 @@ begin
Repeat Repeat
While AnsiCompareText(Flist^[I].Fstring,Pivot)<0 do Inc(I); While AnsiCompareText(Flist^[I].Fstring,Pivot)<0 do Inc(I);
While AnsiCompareText(Flist^[J].Fstring,Pivot)>0 do Dec(J); While AnsiCompareText(Flist^[J].Fstring,Pivot)>0 do Dec(J);
If I<=J then If I<=J then
begin begin
ExchangeItems(I,J); // No check, indices are correct. ExchangeItems(I,J); // No check, indices are correct.
Inc(I); Inc(I);
@ -627,7 +627,7 @@ end;
Procedure TStringList.Changed; Procedure TStringList.Changed;
begin begin
If (FUpdateCount=0) Then If (FUpdateCount=0) Then
@ -637,7 +637,7 @@ end;
Procedure TStringList.Changing; Procedure TStringList.Changing;
begin begin
If FUpdateCount=0 then If FUpdateCount=0 then
@ -647,9 +647,10 @@ end;
Function TStringList.Get(Index: Integer): string; Function TStringList.Get(Index: Integer): string;
begin begin
pointer(Result):=nil;
If (Index<0) or (INdex>=Fcount) then If (Index<0) or (INdex>=Fcount) then
Error (SListIndexError,Index); Error (SListIndexError,Index);
Result:=Flist^[Index].FString; Result:=Flist^[Index].FString;
@ -657,7 +658,7 @@ end;
Function TStringList.GetCapacity: Integer; Function TStringList.GetCapacity: Integer;
begin begin
Result:=FCapacity; Result:=FCapacity;
@ -665,7 +666,7 @@ end;
Function TStringList.GetCount: Integer; Function TStringList.GetCount: Integer;
begin begin
Result:=FCount; Result:=FCount;
@ -673,7 +674,7 @@ end;
Function TStringList.GetObject(Index: Integer): TObject; Function TStringList.GetObject(Index: Integer): TObject;
begin begin
If (Index<0) or (INdex>=Fcount) then If (Index<0) or (INdex>=Fcount) then
@ -683,10 +684,10 @@ end;
Procedure TStringList.Put(Index: Integer; const S: string); Procedure TStringList.Put(Index: Integer; const S: string);
begin begin
If Sorted then If Sorted then
Error(SSortedListError,0); Error(SSortedListError,0);
If (Index<0) or (INdex>=Fcount) then If (Index<0) or (INdex>=Fcount) then
Error (SListIndexError,Index); Error (SListIndexError,Index);
@ -697,52 +698,53 @@ end;
Procedure TStringList.PutObject(Index: Integer; AObject: TObject); Procedure TStringList.PutObject(Index: Integer; AObject: TObject);
begin begin
If (Index<0) or (INdex>=Fcount) then If (Index<0) or (INdex>=Fcount) then
Error (SListIndexError,Index); Error (SListIndexError,Index);
Changing; Changing;
Flist^[Index].FObject:=AObject; Flist^[Index].FObject:=AObject;
Changed; Changed;
end; end;
Procedure TStringList.SetCapacity(NewCapacity: Integer); Procedure TStringList.SetCapacity(NewCapacity: Integer);
Var NewList,ToFree : Pointer;
Var NewList : Pointer;
MSize : Longint;
begin begin
If (NewCapacity<0) then If (NewCapacity<0) then
Error (SListCapacityError,NewCapacity); Error (SListCapacityError,NewCapacity);
If NewCapacity>FCapacity then If NewCapacity>FCapacity then
begin begin
GetMem (NewList,NewCapacity*SizeOf(TStringItem)); GetMem (NewList,NewCapacity*SizeOf(TStringItem));
If NewList=Nil then If NewList=Nil then
//!! Find another one here !!
Error (SListCapacityError,NewCapacity); Error (SListCapacityError,NewCapacity);
If Assigned(FList) then If Assigned(FList) then
begin begin
MSize:=FCapacity*Sizeof(TStringItem); System.Move (FList^,NewList^,FCapacity*Sizeof(TStringItem));
System.Move (FList^,NewList^,MSize); FillChar (PStringItemList(NewList)^[FCapacity],(NewCapacity-FCapacity)*sizeof(TStringItem), 0);
FillWord (Pchar(NewList)[MSize],(NewCapacity-FCapacity)*WordRatio, 0); FreeMem (Flist,FCapacity*SizeOf(TStringItem));
FreeMem (Flist,MSize);
end; end;
Flist:=NewList; Flist:=NewList;
FCapacity:=NewCapacity; FCapacity:=NewCapacity;
end end
else if NewCapacity<FCapacity then else if NewCapacity<FCapacity then
begin begin
NewList:=Flist+NewCapacity*SizeOf(TStringItem); If NewCapacity<0 then
FreeMem (NewList, (FCapacity-NewCapacity)*SizeOf(TStringItem)); Error (SListCapacityError,NewCapacity);
ToFree:=Flist+NewCapacity*SizeOf(TStringItem);
FreeMem (ToFree, (FCapacity-NewCapacity)*SizeOf(TStringItem));
FCapacity:=NewCapacity; FCapacity:=NewCapacity;
end; end;
end; end;
Procedure TStringList.SetUpdateState(Updating: Boolean); Procedure TStringList.SetUpdateState(Updating: Boolean);
begin begin
If Updating then If Updating then
@ -753,7 +755,7 @@ end;
destructor TStringList.Destroy; destructor TStringList.Destroy;
Var I : Longint; Var I : Longint;
@ -761,23 +763,23 @@ begin
FOnChange:=Nil; FOnChange:=Nil;
FOnChanging:=Nil; FOnChanging:=Nil;
// This will force a dereference. Can be done better... // This will force a dereference. Can be done better...
For I:=0 to FCount-1 do For I:=0 to FCount-1 do
FList^[I].FString:=''; FList^[I].FString:='';
FCount:=0; FCount:=0;
SetCapacity(0); SetCapacity(0);
Inherited destroy; Inherited destroy;
end; end;
Function TStringList.Add(const S: string): Integer; Function TStringList.Add(const S: string): Integer;
begin begin
If Not Sorted then If Not Sorted then
Result:=FCount Result:=FCount
else else
If Find (S,Result) then If Find (S,Result) then
Case DUplicates of Case DUplicates of
DupIgnore : Exit; DupIgnore : Exit;
DupError : Error(SDuplicateString,0) DupError : Error(SDuplicateString,0)
end; end;
@ -786,7 +788,7 @@ end;
Procedure TStringList.Clear; Procedure TStringList.Clear;
Var I : longint; Var I : longint;
@ -799,7 +801,7 @@ end;
Procedure TStringList.Delete(Index: Integer); Procedure TStringList.Delete(Index: Integer);
begin begin
If (Index<0) or (Index>=FCount) then If (Index<0) or (Index>=FCount) then
@ -814,19 +816,19 @@ end;
Procedure TStringList.Exchange(Index1, Index2: Integer); Procedure TStringList.Exchange(Index1, Index2: Integer);
begin begin
If (Index1<0) or (Index1>=FCount) then If (Index1<0) or (Index1>=FCount) then
Error(SListIndexError,Index1); Error(SListIndexError,Index1);
If (Index2<0) or (Index2>=FCount) then If (Index2<0) or (Index2>=FCount) then
Error(SListIndexError,Index1); Error(SListIndexError,Index1);
Changing; Changing;
ExchangeItems(Index1,Index2); ExchangeItems(Index1,Index2);
changed; changed;
end; end;
Function TStringList.Find(const S: string; var Index: Integer): Boolean; Function TStringList.Find(const S: string; var Index: Integer): Boolean;
{ Searches for the first string <= S, returns True if exact match, { Searches for the first string <= S, returns True if exact match,
sets index to the index f the found string. } sets index to the index f the found string. }
@ -842,7 +844,7 @@ begin
begin begin
I:=(L+R) div 2; I:=(L+R) div 2;
Temp:=AnsiCompareText(FList^ [I].FString,S); Temp:=AnsiCompareText(FList^ [I].FString,S);
If Temp<0 then If Temp<0 then
L:=I+1 L:=I+1
else else
begin begin
@ -854,38 +856,38 @@ begin
end; end;
end; end;
end; end;
Index:=L; Index:=L;
end; end;
Function TStringList.IndexOf(const S: string): Integer; Function TStringList.IndexOf(const S: string): Integer;
begin begin
If Not Sorted then If Not Sorted then
Result:=Inherited indexOf(S) Result:=Inherited indexOf(S)
else else
// faster using binary search... // faster using binary search...
If Not Find (S,Result) then If Not Find (S,Result) then
Result:=-1; Result:=-1;
end; end;
Procedure TStringList.Insert(Index: Integer; const S: string); Procedure TStringList.Insert(Index: Integer; const S: string);
begin begin
If Sorted then If Sorted then
Error (SSortedListError,0) Error (SSortedListError,0)
else else
If (Index<0) or (Index>FCount) then If (Index<0) or (Index>FCount) then
Error (SListIndexError,Index) Error (SListIndexError,Index)
else else
InsertItem (Index,S); InsertItem (Index,S);
end; end;
Procedure TStringList.Sort; Procedure TStringList.Sort;
begin begin
If Not Sorted and FCount>1 then If Not Sorted and FCount>1 then
@ -898,8 +900,8 @@ end;
{ {
$Log$ $Log$
Revision 1.6 1998-11-09 10:07:24 michael Revision 1.7 1998-11-12 23:43:44 peter
+ Bugfix in setcapacity, sizes were wrong * fixed tstringlist.setcapacity for growing
Revision 1.5 1998/10/30 14:52:52 michael Revision 1.5 1998/10/30 14:52:52 michael
+ Added format in interface + Added format in interface