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

* fix TFPGList.Extract to return the correct values by a patch by Michalis Kamburelis, resolves #19960

Browse Source 
git-svn-id: trunk@18205 -
This commit is contained in:
florian 2011-08-14 13:57:33 +00:00
parent 1fb6fd25af
commit 4a34192510
3 changed files with 65 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -11721,6 +11721,7 @@ tests/webtbs/tw1964.pp svneol=native#text/plain
tests/webtbs/tw19700.pp svneol=native#text/plain
tests/webtbs/tw19864.pp svneol=native#text/pascal
tests/webtbs/tw1996.pp svneol=native#text/plain
tests/webtbs/tw19960.pp svneol=native#text/pascal
tests/webtbs/tw19974.pp svneol=native#text/pascal
tests/webtbs/tw2001.pp svneol=native#text/plain
tests/webtbs/tw2002.pp svneol=native#text/plain

39
rtl/objpas/fgl.pp
View File

@ -66,7 +66,7 @@ type
class procedure Error(const Msg: string; Data: PtrInt);
procedure Exchange(Index1, Index2: Integer);
function Expand: TFPSList;
function Extract(Item: Pointer): Pointer;
procedure Extract(Item: Pointer; ResultPtr: Pointer);
function First: Pointer;
function IndexOf(Item: Pointer): Integer;
procedure Insert(Index: Integer; Item: Pointer);
@ -486,18 +486,21 @@ begin
end;
end;
function TFPSList.Extract(Item: Pointer): Pointer;
procedure TFPSList.Extract(Item: Pointer; ResultPtr: Pointer);
var
i : Integer;
ListItemPtr : Pointer;
begin
Result := nil;
i := IndexOf(Item);
if i >= 0 then
begin
Result := InternalItems[i];
System.Move(Result^, InternalItems[FCapacity]^, FItemSize);
ListItemPtr := InternalItems[i];
System.Move(ListItemPtr^, ResultPtr^, FItemSize);
{ fill with zeros, to avoid freeing/decreasing reference on following Delete }
System.FillByte(ListItemPtr^, FItemSize, 0);
Delete(i);
end;
end else
System.FillByte(ResultPtr^, FItemSize, 0);
end;
class procedure TFPSList.Error(const Msg: string; Data: PtrInt);
@ -761,14 +764,8 @@ begin
end;
function TFPGList.Extract(const Item: T): T;
var
ResPtr: Pointer;
begin
ResPtr := inherited Extract(@Item);
if ResPtr <> nil then
Result := T(ResPtr^)
else
FillByte(Result, sizeof(T), 0);
inherited Extract(@Item, @Result);
end;
function TFPGList.First: T;
@ -873,14 +870,8 @@ begin
end;
function TFPGObjectList.Extract(const Item: T): T;
var
ResPtr: Pointer;
begin
ResPtr := inherited Extract(@Item);
if ResPtr <> nil then
Result := T(ResPtr^)
else
FillByte(Result, sizeof(T), 0);
inherited Extract(@Item, @Result);
end;
function TFPGObjectList.First: T;
@ -988,14 +979,8 @@ begin
end;
function TFPGInterfacedObjectList.Extract(const Item: T): T;
var
ResPtr: Pointer;
begin
ResPtr := inherited Extract(@Item);
if ResPtr <> nil then
Result := T(ResPtr^)
else
FillByte(Result, sizeof(T), 0);
inherited Extract(@Item, @Result);
end;
function TFPGInterfacedObjectList.First: T;

52
tests/webtbs/tw19960.pp Normal file
View File

@ -0,0 +1,52 @@
program extracttest;
{$mode objfpc}{$H+}
{$apptype console}
uses
fgl;
type
TIntegerList = specialize TFPGList<Integer>;
procedure PrintList(aList: TIntegerList);
var
i: Integer;
begin
for i := 0 to aList.Count - 1 do
Write(#9, aList[i]);
Writeln;
end;
var
list: TIntegerList;
i, j: Integer;
begin
list := TIntegerList.Create;
try
for i := 0 to 5 do
list.Add(i);
while list.Count > 0 do begin
if 6-list.Count<>list.Extract(list.First) then
halt(1);
PrintList(list);
end;
list.Clear;
Writeln;
for i := 0 to 5 do
list.Add(i);
for i := 2 to 4 do begin
if list.Extract(i)<>i then
halt(1);
PrintList(list);
end;
finally
list.Free;
end;
writeln('ok');
end.