Browse Source

--- Merging r18205 into '.':
U rtl/objpas/fgl.pp
A tests/webtbs/tw19960.pp
--- Merging r18210 into '.':
G rtl/objpas/fgl.pp
--- Merging r18223 into '.':
G rtl/objpas/fgl.pp
A tests/webtbs/tw19874.pp
--- Merging r18237 into '.':
G rtl/objpas/fgl.pp
A tests/webtbs/tw20005.pp
--- Merging r18238 into '.':
G rtl/objpas/fgl.pp
--- Merging r18244 into '.':
G rtl/objpas/fgl.pp

# revisions: 18205,18210,18223,18237,18238,18244
------------------------------------------------------------------------
r18205 | florian | 2011-08-14 15:57:33 +0200 (Sun, 14 Aug 2011) | 1 line
Changed paths:
M /trunk/rtl/objpas/fgl.pp
A /trunk/tests/webtbs/tw19960.pp

* fix TFPGList.Extract to return the correct values by a patch by Michalis Kamburelis, resolves #19960
------------------------------------------------------------------------
------------------------------------------------------------------------
r18210 | florian | 2011-08-14 21:52:01 +0200 (Sun, 14 Aug 2011) | 1 line
Changed paths:
M /trunk/rtl/objpas/fgl.pp

* made some fields in fgl.pp private as proposed by Michalis Kamburelis, resolves #19873
------------------------------------------------------------------------
------------------------------------------------------------------------
r18223 | florian | 2011-08-16 19:11:48 +0200 (Tue, 16 Aug 2011) | 2 lines
Changed paths:
M /trunk/rtl/objpas/fgl.pp
A /trunk/tests/webtbs/tw19874.pp

* patch by Michalis Kamburelis to make FGL lists First and Last properties that are settable, resolves #19874

------------------------------------------------------------------------
------------------------------------------------------------------------
r18237 | florian | 2011-08-17 11:05:58 +0200 (Wed, 17 Aug 2011) | 1 line
Changed paths:
M /trunk/rtl/objpas/fgl.pp
A /trunk/tests/webtbs/tw20005.pp

* patch by Michalis Kamburelis to keep the ending of TFPSList filled with zeros (space between count and capacity), resolves #20005
------------------------------------------------------------------------
------------------------------------------------------------------------
r18238 | florian | 2011-08-17 11:20:28 +0200 (Wed, 17 Aug 2011) | 1 line
Changed paths:
M /trunk/rtl/objpas/fgl.pp

* fix indention
------------------------------------------------------------------------
------------------------------------------------------------------------
r18244 | florian | 2011-08-17 13:47:41 +0200 (Wed, 17 Aug 2011) | 1 line
Changed paths:
M /trunk/rtl/objpas/fgl.pp

* commented pdata type as proposed in #20004 by Michalis Kamburelis, resolves #20004
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@19018 -

marco 14 years ago
parent
commit
a640bd0e46
5 changed files with 280 additions and 66 deletions
  1. 3 0
      .gitattributes
  2. 112 66
      rtl/objpas/fgl.pp
  3. 72 0
      tests/webtbs/tw19874.pp
  4. 52 0
      tests/webtbs/tw19960.pp
  5. 41 0
      tests/webtbs/tw20005.pp

+ 3 - 0
.gitattributes

@@ -11704,8 +11704,11 @@ tests/webtbs/tw1950.pp svneol=native#text/plain
 tests/webtbs/tw19548.pp svneol=native#text/pascal
 tests/webtbs/tw19548.pp svneol=native#text/pascal
 tests/webtbs/tw1964.pp svneol=native#text/plain
 tests/webtbs/tw1964.pp svneol=native#text/plain
 tests/webtbs/tw19700.pp svneol=native#text/plain
 tests/webtbs/tw19700.pp svneol=native#text/plain
+tests/webtbs/tw19874.pp svneol=native#text/pascal
 tests/webtbs/tw1996.pp svneol=native#text/plain
 tests/webtbs/tw1996.pp svneol=native#text/plain
+tests/webtbs/tw19960.pp svneol=native#text/pascal
 tests/webtbs/tw19977.pp svneol=native#text/pascal
 tests/webtbs/tw19977.pp svneol=native#text/pascal
+tests/webtbs/tw20005.pp svneol=native#text/pascal
 tests/webtbs/tw2001.pp svneol=native#text/plain
 tests/webtbs/tw2001.pp svneol=native#text/plain
 tests/webtbs/tw2002.pp svneol=native#text/plain
 tests/webtbs/tw2002.pp svneol=native#text/plain
 tests/webtbs/tw2004.pp svneol=native#text/plain
 tests/webtbs/tw2004.pp svneol=native#text/plain

+ 112 - 66
rtl/objpas/fgl.pp

@@ -57,6 +57,10 @@ type
     procedure SetCount(NewCount: Integer);
     procedure SetCount(NewCount: Integer);
     procedure RaiseIndexError(Index : Integer);
     procedure RaiseIndexError(Index : Integer);
     property InternalItems[Index: Integer]: Pointer read InternalGet write InternalPut;
     property InternalItems[Index: Integer]: Pointer read InternalGet write InternalPut;
+    function GetLast: Pointer;
+    procedure SetLast(const Value: Pointer);
+    function GetFirst: Pointer;
+    procedure SetFirst(const Value: Pointer);
   public
   public
     constructor Create(AItemSize: Integer = sizeof(Pointer));
     constructor Create(AItemSize: Integer = sizeof(Pointer));
     destructor Destroy; override;
     destructor Destroy; override;
@@ -66,12 +70,10 @@ type
     class procedure Error(const Msg: string; Data: PtrInt);
     class procedure Error(const Msg: string; Data: PtrInt);
     procedure Exchange(Index1, Index2: Integer);
     procedure Exchange(Index1, Index2: Integer);
     function Expand: TFPSList;
     function Expand: TFPSList;
-    function Extract(Item: Pointer): Pointer;
-    function First: Pointer;
+    procedure Extract(Item: Pointer; ResultPtr: Pointer);
     function IndexOf(Item: Pointer): Integer;
     function IndexOf(Item: Pointer): Integer;
     procedure Insert(Index: Integer; Item: Pointer);
     procedure Insert(Index: Integer; Item: Pointer);
     function Insert(Index: Integer): Pointer;
     function Insert(Index: Integer): Pointer;
-    function Last: Pointer;
     procedure Move(CurIndex, NewIndex: Integer);
     procedure Move(CurIndex, NewIndex: Integer);
     procedure Assign(Obj: TFPSList);
     procedure Assign(Obj: TFPSList);
     function Remove(Item: Pointer): Integer;
     function Remove(Item: Pointer): Integer;
@@ -82,6 +84,8 @@ type
     property Items[Index: Integer]: Pointer read Get write Put; default;
     property Items[Index: Integer]: Pointer read Get write Put; default;
     property ItemSize: Integer read FItemSize;
     property ItemSize: Integer read FItemSize;
     property List: PByte read FList;
     property List: PByte read FList;
+    property First: Pointer read GetFirst write SetFirst;
+    property Last: Pointer read GetLast write SetLast;
   end;
   end;
 
 
 const
 const
@@ -100,7 +104,7 @@ type
   end;
   end;
 
 
   generic TFPGList<T> = class(TFPSList)
   generic TFPGList<T> = class(TFPSList)
-  public
+  private
     type
     type
       TCompareFunc = function(const Item1, Item2: T): Integer;
       TCompareFunc = function(const Item1, Item2: T): Integer;
       TTypeList = array[0..MaxGListSize] of T;
       TTypeList = array[0..MaxGListSize] of T;
@@ -115,15 +119,19 @@ type
     function  GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif}
     function  GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif}
     function  ItemPtrCompare(Item1, Item2: Pointer): Integer;
     function  ItemPtrCompare(Item1, Item2: Pointer): Integer;
     procedure Put(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
     procedure Put(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
+    function GetLast: T; {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure SetLast(const Value: T); {$ifdef CLASSESINLINE} inline; {$endif}
+    function GetFirst: T; {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure SetFirst(const Value: T); {$ifdef CLASSESINLINE} inline; {$endif}
   public
   public
     constructor Create;
     constructor Create;
     function Add(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
     function Add(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
     function Extract(const Item: T): T; {$ifdef CLASSESINLINE} inline; {$endif}
     function Extract(const Item: T): T; {$ifdef CLASSESINLINE} inline; {$endif}
-    function First: T; {$ifdef CLASSESINLINE} inline; {$endif}
+    property First: T read GetFirst write SetFirst;
     function GetEnumerator: TFPGListEnumeratorSpec; {$ifdef CLASSESINLINE} inline; {$endif}
     function GetEnumerator: TFPGListEnumeratorSpec; {$ifdef CLASSESINLINE} inline; {$endif}
     function IndexOf(const Item: T): Integer;
     function IndexOf(const Item: T): Integer;
     procedure Insert(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
     procedure Insert(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
-    function Last: T; {$ifdef CLASSESINLINE} inline; {$endif}
+    property Last: T read GetLast write SetLast;
 {$ifndef VER2_4}
 {$ifndef VER2_4}
     procedure Assign(Source: TFPGList);
     procedure Assign(Source: TFPGList);
 {$endif VER2_4}
 {$endif VER2_4}
@@ -134,7 +142,7 @@ type
   end;
   end;
 
 
   generic TFPGObjectList<T> = class(TFPSList)
   generic TFPGObjectList<T> = class(TFPSList)
-  public
+  private
     type
     type
       TCompareFunc = function(const Item1, Item2: T): Integer;
       TCompareFunc = function(const Item1, Item2: T): Integer;
       TTypeList = array[0..MaxGListSize] of T;
       TTypeList = array[0..MaxGListSize] of T;
@@ -150,15 +158,19 @@ type
     function  GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif}
     function  GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif}
     function  ItemPtrCompare(Item1, Item2: Pointer): Integer;
     function  ItemPtrCompare(Item1, Item2: Pointer): Integer;
     procedure Put(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
     procedure Put(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
+    function GetLast: T; {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure SetLast(const Value: T); {$ifdef CLASSESINLINE} inline; {$endif}
+    function GetFirst: T; {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure SetFirst(const Value: T); {$ifdef CLASSESINLINE} inline; {$endif}
   public
   public
     constructor Create(FreeObjects: Boolean = True);
     constructor Create(FreeObjects: Boolean = True);
     function Add(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
     function Add(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
     function Extract(const Item: T): T; {$ifdef CLASSESINLINE} inline; {$endif}
     function Extract(const Item: T): T; {$ifdef CLASSESINLINE} inline; {$endif}
-    function First: T; {$ifdef CLASSESINLINE} inline; {$endif}
+    property First: T read GetFirst write SetFirst;
     function GetEnumerator: TFPGListEnumeratorSpec; {$ifdef CLASSESINLINE} inline; {$endif}
     function GetEnumerator: TFPGListEnumeratorSpec; {$ifdef CLASSESINLINE} inline; {$endif}
     function IndexOf(const Item: T): Integer;
     function IndexOf(const Item: T): Integer;
     procedure Insert(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
     procedure Insert(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
-    function Last: T; {$ifdef CLASSESINLINE} inline; {$endif}
+    property Last: T read GetLast write SetLast;
 {$ifndef VER2_4}
 {$ifndef VER2_4}
     procedure Assign(Source: TFPGObjectList);
     procedure Assign(Source: TFPGObjectList);
 {$endif VER2_4}
 {$endif VER2_4}
@@ -170,7 +182,7 @@ type
   end;
   end;
 
 
   generic TFPGInterfacedObjectList<T> = class(TFPSList)
   generic TFPGInterfacedObjectList<T> = class(TFPSList)
-  public
+  private
     type
     type
       TCompareFunc = function(const Item1, Item2: T): Integer;
       TCompareFunc = function(const Item1, Item2: T): Integer;
       TTypeList = array[0..MaxGListSize] of T;
       TTypeList = array[0..MaxGListSize] of T;
@@ -185,15 +197,19 @@ type
     function  GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif}
     function  GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif}
     function  ItemPtrCompare(Item1, Item2: Pointer): Integer;
     function  ItemPtrCompare(Item1, Item2: Pointer): Integer;
     procedure Put(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
     procedure Put(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
+    function GetLast: T; {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure SetLast(const Value: T); {$ifdef CLASSESINLINE} inline; {$endif}
+    function GetFirst: T; {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure SetFirst(const Value: T); {$ifdef CLASSESINLINE} inline; {$endif}
   public
   public
     constructor Create;
     constructor Create;
     function Add(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
     function Add(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
     function Extract(const Item: T): T; {$ifdef CLASSESINLINE} inline; {$endif}
     function Extract(const Item: T): T; {$ifdef CLASSESINLINE} inline; {$endif}
-    function First: T; {$ifdef CLASSESINLINE} inline; {$endif}
+    property First: T read GetFirst write SetFirst;
     function GetEnumerator: TFPGListEnumeratorSpec; {$ifdef CLASSESINLINE} inline; {$endif}
     function GetEnumerator: TFPGListEnumeratorSpec; {$ifdef CLASSESINLINE} inline; {$endif}
     function IndexOf(const Item: T): Integer;
     function IndexOf(const Item: T): Integer;
     procedure Insert(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
     procedure Insert(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
-    function Last: T; {$ifdef CLASSESINLINE} inline; {$endif}
+    property Last: T read GetLast write SetLast;
 {$ifndef VER2_4}
 {$ifndef VER2_4}
     procedure Assign(Source: TFPGInterfacedObjectList);
     procedure Assign(Source: TFPGInterfacedObjectList);
 {$endif VER2_4}
 {$endif VER2_4}
@@ -254,20 +270,20 @@ type
   end;
   end;
 
 
   generic TFPGMap<TKey, TData> = class(TFPSMap)
   generic TFPGMap<TKey, TData> = class(TFPSMap)
-  public
+  private
     type
     type
       TKeyCompareFunc = function(const Key1, Key2: TKey): Integer;
       TKeyCompareFunc = function(const Key1, Key2: TKey): Integer;
       TDataCompareFunc = function(const Data1, Data2: TData): Integer;
       TDataCompareFunc = function(const Data1, Data2: TData): Integer;
       PKey = ^TKey;
       PKey = ^TKey;
-      PData = ^TData;
+// unsed      PData = ^TData;
   {$ifndef OldSyntax}protected var{$else}var protected{$endif}
   {$ifndef OldSyntax}protected var{$else}var protected{$endif}
       FOnKeyCompare: TKeyCompareFunc;
       FOnKeyCompare: TKeyCompareFunc;
       FOnDataCompare: TDataCompareFunc;
       FOnDataCompare: TDataCompareFunc;
-      procedure CopyItem(Src, Dest: Pointer); override;
-      procedure CopyKey(Src, Dest: Pointer); override;
-      procedure CopyData(Src, Dest: Pointer); override;
-      procedure Deref(Item: Pointer); override;
-      procedure InitOnPtrCompare; override;
+    procedure CopyItem(Src, Dest: Pointer); override;
+    procedure CopyKey(Src, Dest: Pointer); override;
+    procedure CopyData(Src, Dest: Pointer); override;
+    procedure Deref(Item: Pointer); override;
+    procedure InitOnPtrCompare; override;
     function GetKey(Index: Integer): TKey; {$ifdef CLASSESINLINE} inline; {$endif}
     function GetKey(Index: Integer): TKey; {$ifdef CLASSESINLINE} inline; {$endif}
     function GetKeyData(const AKey: TKey): TData; {$ifdef CLASSESINLINE} inline; {$endif}
     function GetKeyData(const AKey: TKey): TData; {$ifdef CLASSESINLINE} inline; {$endif}
     function GetData(Index: Integer): TData; {$ifdef CLASSESINLINE} inline; {$endif}
     function GetData(Index: Integer): TData; {$ifdef CLASSESINLINE} inline; {$endif}
@@ -299,20 +315,20 @@ type
   end;
   end;
 
 
   generic TFPGMapInterfacedObjectData<TKey, TData> = class(TFPSMap)
   generic TFPGMapInterfacedObjectData<TKey, TData> = class(TFPSMap)
-  public
+  private
     type
     type
       TKeyCompareFunc = function(const Key1, Key2: TKey): Integer;
       TKeyCompareFunc = function(const Key1, Key2: TKey): Integer;
       TDataCompareFunc = function(const Data1, Data2: TData): Integer;
       TDataCompareFunc = function(const Data1, Data2: TData): Integer;
       PKey = ^TKey;
       PKey = ^TKey;
-      PData = ^TData;
+// unsed      PData = ^TData;
   {$ifndef OldSyntax}protected var{$else}var protected{$endif}
   {$ifndef OldSyntax}protected var{$else}var protected{$endif}
       FOnKeyCompare: TKeyCompareFunc;
       FOnKeyCompare: TKeyCompareFunc;
       FOnDataCompare: TDataCompareFunc;
       FOnDataCompare: TDataCompareFunc;
-      procedure CopyItem(Src, Dest: Pointer); override;
-      procedure CopyKey(Src, Dest: Pointer); override;
-      procedure CopyData(Src, Dest: Pointer); override;
-      procedure Deref(Item: Pointer); override;
-      procedure InitOnPtrCompare; override;
+    procedure CopyItem(Src, Dest: Pointer); override;
+    procedure CopyKey(Src, Dest: Pointer); override;
+    procedure CopyData(Src, Dest: Pointer); override;
+    procedure Deref(Item: Pointer); override;
+    procedure InitOnPtrCompare; override;
     function GetKey(Index: Integer): TKey; {$ifdef CLASSESINLINE} inline; {$endif}
     function GetKey(Index: Integer): TKey; {$ifdef CLASSESINLINE} inline; {$endif}
     function GetKeyData(const AKey: TKey): TData; {$ifdef CLASSESINLINE} inline; {$endif}
     function GetKeyData(const AKey: TKey): TData; {$ifdef CLASSESINLINE} inline; {$endif}
     function GetData(Index: Integer): TData; {$ifdef CLASSESINLINE} inline; {$endif}
     function GetData(Index: Integer): TData; {$ifdef CLASSESINLINE} inline; {$endif}
@@ -484,20 +500,28 @@ begin
     FCapacity := FCapacity shr 1;
     FCapacity := FCapacity shr 1;
     ReallocMem(FList, (FCapacity+1) * FItemSize);
     ReallocMem(FList, (FCapacity+1) * FItemSize);
   end;
   end;
+  { Keep the ending of the list filled with zeros, don't leave garbage data
+    there. Otherwise, we could accidentally have there a copy of some item
+    on the list, and accidentally Deref it too soon.
+    See http://bugs.freepascal.org/view.php?id=20005. }
+  FillChar(InternalItems[FCount]^, (FCapacity+1-FCount) * FItemSize, #0);
 end;
 end;
 
 
-function TFPSList.Extract(Item: Pointer): Pointer;
+procedure TFPSList.Extract(Item: Pointer; ResultPtr: Pointer);
 var
 var
   i : Integer;
   i : Integer;
+  ListItemPtr : Pointer;
 begin
 begin
-  Result := nil;
   i := IndexOf(Item);
   i := IndexOf(Item);
   if i >= 0 then
   if i >= 0 then
   begin
   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);
     Delete(i);
-  end;
+  end else
+    System.FillByte(ResultPtr^, FItemSize, 0);
 end;
 end;
 
 
 class procedure TFPSList.Error(const Msg: string; Data: PtrInt);
 class procedure TFPSList.Error(const Msg: string; Data: PtrInt);
@@ -534,7 +558,7 @@ begin
   Result := Self;
   Result := Self;
 end;
 end;
 
 
-function TFPSList.First: Pointer;
+function TFPSList.GetFirst: Pointer;
 begin
 begin
   If FCount = 0 then
   If FCount = 0 then
     Result := Nil
     Result := Nil
@@ -542,6 +566,11 @@ begin
     Result := InternalItems[0];
     Result := InternalItems[0];
 end;
 end;
 
 
+procedure TFPSList.SetFirst(const Value: Pointer);
+begin
+  Put(0, Value);
+end;
+
 function TFPSList.IndexOf(Item: Pointer): Integer;
 function TFPSList.IndexOf(Item: Pointer): Integer;
 var
 var
   ListItem: Pointer;
   ListItem: Pointer;
@@ -576,7 +605,7 @@ begin
   CopyItem(Item, Insert(Index));
   CopyItem(Item, Insert(Index));
 end;
 end;
 
 
-function TFPSList.Last: Pointer;
+function TFPSList.GetLast: Pointer;
 begin
 begin
   if FCount = 0 then
   if FCount = 0 then
     Result := nil
     Result := nil
@@ -584,6 +613,11 @@ begin
     Result := InternalItems[FCount - 1];
     Result := InternalItems[FCount - 1];
 end;
 end;
 
 
+procedure TFPSList.SetLast(const Value: Pointer);
+begin
+  Put(FCount - 1, Value);
+end;
+
 procedure TFPSList.Move(CurIndex, NewIndex: Integer);
 procedure TFPSList.Move(CurIndex, NewIndex: Integer);
 var
 var
   CurItem, NewItem, TmpItem, Src, Dest: Pointer;
   CurItem, NewItem, TmpItem, Src, Dest: Pointer;
@@ -761,19 +795,18 @@ begin
 end;
 end;
 
 
 function TFPGList.Extract(const Item: T): T;
 function TFPGList.Extract(const Item: T): T;
-var
-  ResPtr: Pointer;
 begin
 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.GetFirst: T;
+begin
+  Result := T(inherited GetFirst^);
 end;
 end;
 
 
-function TFPGList.First: T;
+procedure TFPGList.SetFirst(const Value: T);
 begin
 begin
-  Result := T(inherited First^);
+  inherited SetFirst(@Value);
 end;
 end;
 
 
 function TFPGList.GetEnumerator: TFPGListEnumeratorSpec;
 function TFPGList.GetEnumerator: TFPGListEnumeratorSpec;
@@ -796,9 +829,14 @@ begin
   T(inherited Insert(Index)^) := Item;
   T(inherited Insert(Index)^) := Item;
 end;
 end;
 
 
-function TFPGList.Last: T;
+function TFPGList.GetLast: T;
+begin
+  Result := T(inherited GetLast^);
+end;
+
+procedure TFPGList.SetLast(const Value: T);
 begin
 begin
-  Result := T(inherited Last^);
+  inherited SetLast(@Value);
 end;
 end;
 
 
 {$ifndef VER2_4}
 {$ifndef VER2_4}
@@ -873,19 +911,18 @@ begin
 end;
 end;
 
 
 function TFPGObjectList.Extract(const Item: T): T;
 function TFPGObjectList.Extract(const Item: T): T;
-var
-  ResPtr: Pointer;
 begin
 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.GetFirst: T;
+begin
+  Result := T(inherited GetFirst^);
 end;
 end;
 
 
-function TFPGObjectList.First: T;
+procedure TFPGObjectList.SetFirst(const Value: T);
 begin
 begin
-  Result := T(inherited First^);
+  inherited SetFirst(@Value);
 end;
 end;
 
 
 function TFPGObjectList.GetEnumerator: TFPGListEnumeratorSpec;
 function TFPGObjectList.GetEnumerator: TFPGListEnumeratorSpec;
@@ -908,9 +945,14 @@ begin
   T(inherited Insert(Index)^) := Item;
   T(inherited Insert(Index)^) := Item;
 end;
 end;
 
 
-function TFPGObjectList.Last: T;
+function TFPGObjectList.GetLast: T;
 begin
 begin
-  Result := T(inherited Last^);
+  Result := T(inherited GetLast^);
+end;
+
+procedure TFPGObjectList.SetLast(const Value: T);
+begin
+  inherited SetLast(@Value);
 end;
 end;
 
 
 {$ifndef VER2_4}
 {$ifndef VER2_4}
@@ -988,19 +1030,18 @@ begin
 end;
 end;
 
 
 function TFPGInterfacedObjectList.Extract(const Item: T): T;
 function TFPGInterfacedObjectList.Extract(const Item: T): T;
-var
-  ResPtr: Pointer;
 begin
 begin
-  ResPtr := inherited Extract(@Item);
-  if ResPtr <> nil then
-    Result := T(ResPtr^)
-  else
-    FillByte(Result, sizeof(T), 0);
+  inherited Extract(@Item, @Result);
 end;
 end;
 
 
-function TFPGInterfacedObjectList.First: T;
+function TFPGInterfacedObjectList.GetFirst: T;
 begin
 begin
-  Result := T(inherited First^);
+  Result := T(inherited GetFirst^);
+end;
+
+procedure TFPGInterfacedObjectList.SetFirst(const Value: T);
+begin
+  inherited SetFirst(@Value);
 end;
 end;
 
 
 function TFPGInterfacedObjectList.GetEnumerator: TFPGListEnumeratorSpec;
 function TFPGInterfacedObjectList.GetEnumerator: TFPGListEnumeratorSpec;
@@ -1023,9 +1064,14 @@ begin
   T(inherited Insert(Index)^) := Item;
   T(inherited Insert(Index)^) := Item;
 end;
 end;
 
 
-function TFPGInterfacedObjectList.Last: T;
+function TFPGInterfacedObjectList.GetLast: T;
+begin
+  Result := T(inherited GetLast^);
+end;
+
+procedure TFPGInterfacedObjectList.SetLast(const Value: T);
 begin
 begin
-  Result := T(inherited Last^);
+  inherited SetLast(@Value);
 end;
 end;
 
 
 {$ifndef VER2_4}
 {$ifndef VER2_4}

+ 72 - 0
tests/webtbs/tw19874.pp

@@ -0,0 +1,72 @@
+{ -*- compile-command: "fpc -Sa test_fgl_first_last_set.pas" -*- }
+{$mode objfpc}{$H+}
+
+uses FGL;
+type
+  TInteger = class
+    I: Integer;
+    constructor Create(AI: Integer);
+  end;
+
+  TIntSimpleList = specialize TFPGList<Integer>;
+  TIntObjectList = specialize TFPGObjectList<TInteger>;
+
+constructor TInteger.Create(AI: Integer);
+begin
+  inherited Create;
+  I := AI;
+end;
+
+var
+  SL: TIntSimpleList;
+  OL: TIntObjectList;
+  Temp: TInteger;
+begin
+  SL := TIntSimpleList.Create;
+  try
+    try
+      SL.First := 1;
+      Assert(false, 'Assigning First on empty list should fail');
+    except on E: EListError do ; end;
+    try
+      SL.Last := 1;
+      Assert(false, 'Assigning Last on empty list should fail');
+    except on E: EListError do ; end;
+    SL.Add(1);
+    SL.Add(2);
+    SL.Add(3);
+    Assert(SL.First = 1);
+    Assert(SL.Last = 3);
+    SL.First := 111;
+    SL.Last := 333;
+    Assert(SL.First = 111);
+    Assert(SL.Last = 333);
+    Assert(SL[0] = 111);
+    Assert(SL[2] = 333);
+  finally SL.Free end;
+
+  OL := TIntObjectList.Create(true);
+  try
+    try
+      Temp := TInteger.Create(1);
+      OL.First := Temp;
+      Assert(false, 'Assigning First on empty list should fail');
+    except on E: EListError do Temp.Free; end;
+    try
+      Temp := TInteger.Create(1);
+      OL.Last := TInteger.Create(1);
+      Assert(false, 'Assigning Last on empty list should fail');
+    except on E: EListError do Temp.Free; end;
+    OL.Add(TInteger.Create(1));
+    OL.Add(TInteger.Create(2));
+    OL.Add(TInteger.Create(3));
+    Assert(OL.First.I = 1);
+    Assert(OL.Last.I = 3);
+    OL.First := TInteger.Create(111);
+    OL.Last := TInteger.Create(333);
+    Assert(OL.First.I = 111);
+    Assert(OL.Last.I = 333);
+    Assert(OL[0].I = 111);
+    Assert(OL[2].I = 333);
+  finally OL.Free end;
+end.

+ 52 - 0
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.
+

+ 41 - 0
tests/webtbs/tw20005.pp

@@ -0,0 +1,41 @@
+{ %OPT=-gl -gh }
+{$mode objfpc}{$H+}
+uses Classes, SysUtils, FGL;
+
+type
+  TMessages = specialize TFPGList<string>;
+
+var
+  Messages: TMessages;
+
+procedure WritelnMessages(const S: string);
+var
+  I: Integer;
+begin
+  Writeln('Messages ', S, ' : ', Messages.Count);
+  for i := 0 to Messages.Count - 1 do
+    Writeln('  Messages[', I, ']: ', PtrUInt(Pointer(Messages[I])), ' ', Length(Messages[I]), ' ', Messages[I]);
+end;
+
+procedure Show(S: string);
+var
+  NewS: string;
+begin
+  WritelnMessages('before Add');
+  NewS := Copy(S, 1, 10) + Copy(S, 11, MaxInt);
+  Messages.Add(NewS);
+  WritelnMessages('after Add');
+end;
+
+begin
+  Messages := TMessages.Create;
+
+  Show('Loaded level "Castle Hall"');
+  Show('You pick "Sword"');
+  Show('You''re using weapon "Sword" now');
+  Show('Hint: press "Escape" for game menu');
+  Messages.Delete(0);
+  Show('You pick "Potion Of Life"');
+
+  FreeAndNil(Messages);
+end.