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

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

Browse Source 
git-svn-id: trunk@18223 -
This commit is contained in:
florian 2011-08-16 17:11:48 +00:00
parent 99393e6a5d
commit 6cb6d9ffaf
3 changed files with 151 additions and 22 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/tw19548.pp svneol=native#text/pascal
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/tw19874.pp svneol=native#text/pascal
tests/webtbs/tw19910.pp svneol=native#text/pascal
tests/webtbs/tw1996.pp svneol=native#text/plain
tests/webtbs/tw19960.pp svneol=native#text/pascal

100
rtl/objpas/fgl.pp
View File

@ -57,6 +57,10 @@ type
procedure SetCount(NewCount: Integer);
procedure RaiseIndexError(Index : Integer);
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
constructor Create(AItemSize: Integer = sizeof(Pointer));
destructor Destroy; override;
@ -67,11 +71,9 @@ type
procedure Exchange(Index1, Index2: Integer);
function Expand: TFPSList;
procedure Extract(Item: Pointer; ResultPtr: Pointer);
function First: Pointer;
function IndexOf(Item: Pointer): Integer;
procedure Insert(Index: Integer; Item: Pointer);
function Insert(Index: Integer): Pointer;
function Last: Pointer;
procedure Move(CurIndex, NewIndex: Integer);
procedure Assign(Obj: TFPSList);
function Remove(Item: Pointer): Integer;
@ -82,6 +84,8 @@ type
property Items[Index: Integer]: Pointer read Get write Put; default;
property ItemSize: Integer read FItemSize;
property List: PByte read FList;
property First: Pointer read GetFirst write SetFirst;
property Last: Pointer read GetLast write SetLast;
end;
const
@ -115,15 +119,19 @@ type
function GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif}
function ItemPtrCompare(Item1, Item2: Pointer): Integer;
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
constructor Create;
function Add(const Item: T): Integer; {$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 IndexOf(const Item: T): Integer;
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}
procedure Assign(Source: TFPGList);
{$endif VER2_4}
@ -150,15 +158,19 @@ type
function GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif}
function ItemPtrCompare(Item1, Item2: Pointer): Integer;
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
constructor Create(FreeObjects: Boolean = True);
function Add(const Item: T): Integer; {$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 IndexOf(const Item: T): Integer;
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}
procedure Assign(Source: TFPGObjectList);
{$endif VER2_4}
@ -185,15 +197,19 @@ type
function GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif}
function ItemPtrCompare(Item1, Item2: Pointer): Integer;
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
constructor Create;
function Add(const Item: T): Integer; {$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 IndexOf(const Item: T): Integer;
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}
procedure Assign(Source: TFPGInterfacedObjectList);
{$endif VER2_4}
@ -537,7 +553,7 @@ begin
Result := Self;
end;
function TFPSList.First: Pointer;
function TFPSList.GetFirst: Pointer;
begin
If FCount = 0 then
Result := Nil
@ -545,6 +561,11 @@ begin
Result := InternalItems[0];
end;
procedure TFPSList.SetFirst(const Value: Pointer);
begin
Put(0, Value);
end;
function TFPSList.IndexOf(Item: Pointer): Integer;
var
ListItem: Pointer;
@ -579,7 +600,7 @@ begin
CopyItem(Item, Insert(Index));
end;
function TFPSList.Last: Pointer;
function TFPSList.GetLast: Pointer;
begin
if FCount = 0 then
Result := nil
@ -587,6 +608,11 @@ begin
Result := InternalItems[FCount - 1];
end;
procedure TFPSList.SetLast(const Value: Pointer);
begin
Put(FCount - 1, Value);
end;
procedure TFPSList.Move(CurIndex, NewIndex: Integer);
var
CurItem, NewItem, TmpItem, Src, Dest: Pointer;
@ -768,9 +794,14 @@ begin
inherited Extract(@Item, @Result);
end;
function TFPGList.First: T;
function TFPGList.GetFirst: T;
begin
Result := T(inherited First^);
Result := T(inherited GetFirst^);
end;
procedure TFPGList.SetFirst(const Value: T);
begin
inherited SetFirst(@Value);
end;
function TFPGList.GetEnumerator: TFPGListEnumeratorSpec;
@ -793,9 +824,14 @@ begin
T(inherited Insert(Index)^) := Item;
end;
function TFPGList.Last: T;
function TFPGList.GetLast: T;
begin
Result := T(inherited Last^);
Result := T(inherited GetLast^);
end;
procedure TFPGList.SetLast(const Value: T);
begin
inherited SetLast(@Value);
end;
{$ifndef VER2_4}
@ -874,9 +910,14 @@ begin
inherited Extract(@Item, @Result);
end;
function TFPGObjectList.First: T;
function TFPGObjectList.GetFirst: T;
begin
Result := T(inherited First^);
Result := T(inherited GetFirst^);
end;
procedure TFPGObjectList.SetFirst(const Value: T);
begin
inherited SetFirst(@Value);
end;
function TFPGObjectList.GetEnumerator: TFPGListEnumeratorSpec;
@ -899,9 +940,14 @@ begin
T(inherited Insert(Index)^) := Item;
end;
function TFPGObjectList.Last: T;
function TFPGObjectList.GetLast: T;
begin
Result := T(inherited Last^);
Result := T(inherited GetLast^);
end;
procedure TFPGObjectList.SetLast(const Value: T);
begin
inherited SetLast(@Value);
end;
{$ifndef VER2_4}
@ -983,9 +1029,14 @@ begin
inherited Extract(@Item, @Result);
end;
function TFPGInterfacedObjectList.First: T;
function TFPGInterfacedObjectList.GetFirst: T;
begin
Result := T(inherited First^);
Result := T(inherited GetFirst^);
end;
procedure TFPGInterfacedObjectList.SetFirst(const Value: T);
begin
inherited SetFirst(@Value);
end;
function TFPGInterfacedObjectList.GetEnumerator: TFPGListEnumeratorSpec;
@ -1008,9 +1059,14 @@ begin
T(inherited Insert(Index)^) := Item;
end;
function TFPGInterfacedObjectList.Last: T;
function TFPGInterfacedObjectList.GetLast: T;
begin
Result := T(inherited Last^);
Result := T(inherited GetLast^);
end;
procedure TFPGInterfacedObjectList.SetLast(const Value: T);
begin
inherited SetLast(@Value);
end;
{$ifndef VER2_4}

72
tests/webtbs/tw19874.pp Normal file
View File

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