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

git-svn-id: trunk@18205 -

.gitattributes

@@ -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

rtl/objpas/fgl.pp

@@ -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;

tests/webtbs/tw19960.pp

@@ -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.
+