Resending, seems like my last mail did not reach the list. :|
Hi,
I am playing around with generics. I have implemented two simple Lists. A
array based TList and a double linked TLinkedList. I have also written a test
program to test these.
Here comes the interesting part. The test program runs flawlessy, but compiled
with -gh for heaptrace or -gv for valgrind, the test program crashes always
at a certain point.
I thought that it was possible that I did some horrendous things with my
memory, but running "valgrind --tool=memcheck" on a clean (read no -gh
or -gv) executable results in absolutely no problems reported by valgrind.
Could be FPC at fault? Both files are attached, "DataContainers.pp" being the
two lists and "DataContainers_Test.pp" the test program.
FPC 2.2.0 on Linux 2.6.23
valgrind-3.2.3
thanks in advance
bartek
{$mode objfpc}{$h+}
unit DataContainers;
interface
type
{ TList }
generic TList<T> = class
private
FMemory: pointer;
FTypeSize: integer;
FCapacity,
FCount: integer;
FDontShrink: boolean;
protected
function GetElement(const Index: Integer): T;
procedure SetElement(const Index: Integer; const AElement: T);
procedure SetCapacity(const ACapacity: Integer);
procedure SetCount(const AValue: Integer);
public
constructor Create;
destructor Destroy; override;
function InsertBefore(const Index: Integer; const AElement: T): T;
function Append(const AElement: T): Integer;
function Append: T; // saves a move and a temporary variable
function Extract(const Index: Integer): T;
function Top: T;
function Bottom: T;
property Element[Index: Integer]: T read GetElement write SetElement;
property Capacity: Integer read FCapacity;
property DontShrink: boolean read FDontShrink write FDontShrink;
property Count: Integer read FCount write SetCount;
end;
{ TLinkedList }
generic TLinkedList<T> = class
type
public
PNode = ^TNode;
TNode = record
Previous,
Next: PNode;
Element: T;
end;
var
private
FHead,
FTail: PNode;
public
constructor Create;
destructor Destroy; override;
function InsertBefore(const ANode: PNode; const AElement: T): T;
function InsertAfter(const ANode: PNode; const AElement: T): T;
function ExtractNode(const ANode: PNode): T;
function Append(const AElement: T): T;
property Head: PNode read FHead;
property Tail: PNode read FTail;
end;
implementation
{ TList }
constructor TList.Create;
begin
FTypeSize:=SizeOf(T);
FCapacity:=1;
FCount:=0;
FDontShrink := False;
GetMem(FMemory, FTypeSize*FCapacity);
end;
destructor TList.Destroy;
begin
inherited Destroy;
FreeMem(FMemory);
end;
procedure TList.SetCount(const AValue: Integer);
begin
if AValue = FCount then exit;
FCount := AValue;
if FCount >= FCapacity then SetCapacity(FCount * 2);
if (not DontShrink) and (FCount * 3 < FCapacity) then SetCapacity(FCount + 1);
end;
procedure TList.SetCapacity(const ACapacity: Integer);
begin
if ACapacity = FCapacity then Exit;
FCapacity := ACapacity;
ReallocMem(FMemory, FTypeSize*FCapacity);
if FCount > FCapacity then FCount := FCapacity - 1;
end;
function TList.GetElement(const Index: Integer): T;
begin
Result:=T((FMemory+Index*FTypesize)^);
end;
procedure TList.SetElement(const Index: Integer; const AElement: T);
begin
Move(AElement, (FMemory+Index*FTypeSize)^, FTypeSize);
end;
function TList.InsertBefore(const Index: Integer; const AElement: T): T;
begin
Move((FMemory+Index*FTypesize)^, (FMemory+(Index+1)*FTypesize)^, FTypeSize*(FCount - Index));
SetElement(Index, AElement);
SetCount(FCount + 1);
Result:=AElement;
end;
function TList.Append(const AElement: T): Integer;
begin
SetElement(FCount, AElement);
Result := FCount;
SetCount(FCount + 1);
end;
function TList.Append: T;
begin
SetCount(FCount + 1);
Result := Element[FCount-1];
end;
function TList.Extract(const Index: Integer): T;
begin
Result := Element[Index];
Move((FMemory+(Index+1)*FTypeSize)^, (FMemory+Index*FTypeSize)^, FTypeSize*(FCount - Index));
SetCount(FCount - 1);
end;
function TList.Top: T;
begin
Result:=Element[FCount-1]; // FCount is a buffer, therefore FCount - 1 is topmost element
end;
function TList.Bottom: T;
begin
Result:=Element[0];
end;
{ TLinkedList }
constructor TLinkedList.Create;
begin
end;
destructor TLinkedList.Destroy;
var
c, n: PNode;
begin
c := Head;
while c <> nil do
begin
n := c^.Next;
dispose(c);
c := n;
end;
end;
function TLinkedList.InsertBefore(const ANode: PNode; const AElement: T): T;
var
NewNode: PNode;
begin
new(NewNode);
NewNode^.Element := AElement;
NewNode^.Previous := ANode^.Previous;
NewNode^.Next := ANode;
if ANode = Head then FHead := NewNode else ANode^.Previous^.Next := NewNode;
ANode^.Previous := NewNode;
result := AElement;
end;
function TLinkedList.InsertAfter(const ANode: PNode; const AElement: T): T;
var
NewNode: PNode;
begin
new(NewNode);
NewNode^.Element := AElement;
NewNode^.Previous := ANode;
NewNode^.Next := ANode^.Next;
if ANode = Tail then FTail := NewNode else ANode^.Next^.Previous := NewNode;
ANode^.Next := NewNode;
result := AElement;
end;
function TLinkedList.ExtractNode(const ANode: PNode): T;
begin
if ANode = Head then FHead := Head^.Next else ANode^.Previous^.Next := ANode^.Next;
if ANode = Tail then FTail := Tail^.Previous else ANode^.Next^.Previous := ANode^.Previous;
result := ANode^.Element;
dispose(ANode);
end;
function TLinkedList.Append(const AElement: T): T;
var
NewNode: PNode;
begin
if Head = nil then
begin
new(NewNode);
FHead := NewNode;
FTail := NewNode;
NewNode^.Element := AElement;
end
else
begin
InsertAfter(Tail, AElement);
end;
result := AElement;
end;
end.{$mode objfpc}{$H+}
program DataContainers_Test;
uses Classes, Sysutils, DataContainers;
type
TSingleList = specialize TList<Single>;
TSingleLinkedList = specialize TLinkedList<Single>;
function Dump(AList: TSingleList): string;
var
i: integer;
begin
result := format('ASingleList: Count %d Capacity %d', [AList.Count, AList.Capacity]);
for i := 0 to AList.Count - 1 do
result += ' e' + format('%.2f',[AList.Element[i]]);
end;
function Dump(AList: TSingleLinkedList): string;
var
n: TSingleLinkedList.PNode;
begin
result := 'ASingleLinkedList: ';
n := AList.Head;
while n <> nil do
begin
result += ' e' + format('%.2f',[n^.Element]);
n := n^.Next;
end;
end;
var
ASingleList: TSingleList;
ASingleLinkedList: TSingleLinkedList;
i: integer;
begin
ASingleList := TSingleList.Create;
ASingleLinkedList := TSingleLinkedList.Create;
for i := 1 to 10 do
begin
writeln(format('ASingleList.Append(%d)',[i]));
ASingleList.Append(i);
writeln(format('ASingleLinkedList.Append(%d)',[i]));
ASingleLinkedList.Append(i);
end;
writeln(Dump(ASingleList));
writeln(Dump(ASingleLinkedList));
for i := 1 to 5 do
begin
writeln('ASingleList.Extract(0)');
writeln(ASingleList.Extract(0));
writeln('ASingleLinkedList.Extract(Head)');
writeln(ASingleLinkedList.ExtractNode(ASingleLinkedList.Head));
end;
writeln(Dump(ASingleList));
writeln(Dump(ASingleLinkedList));
for i := 1 to 10 do
begin
writeln(format('ASingleList.Insert(0,%d)',[i]));
ASingleList.InsertBefore(0, i);
writeln(format('ASingleLinkedList.InsertBefore(Head,%d)',[i]));
ASingleLinkedList.InsertBefore(ASingleLinkedList.Head, i);
end;
writeln(Dump(ASingleList));
writeln(Dump(ASingleLinkedList));
writeln('Done.');
FreeAndNil(ASingleList);
FreeAndNil(ASingleLinkedList);
end.
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
