internal error 200511173 in sub procedure in generic function
Original Reporter info from Mantis: PascalR @PascalRiekenberg
-
Reporter name: Pascal Riekenberg
Original Reporter info from Mantis: PascalR @PascalRiekenberg
- Reporter name: Pascal Riekenberg
Description:
internal error 200511173 is raised in the following unit:
unit prGenericAvgLvlTree;
{$mode objfpc}{$H+}
interface
uses
Classes,
SysUtils;
type
{ TprAvgLvlTreeNodeBase }
TprAvgLvlTreeNodeBase = class
private
protected
public
end;
{ TprAvgLvlTreeBase }
TprAvgLvlTreeBase = class
private
protected
public
end;
{ GprAvgLvlTreeNode }
generic GprAvgLvlTreeNode<T> = class(TprAvgLvlTreeNodeBase)
public
Parent, Left, Right: specialize GprAvgLvlTreeNode<T>;
Balance: integer; // = RightDepth-LeftDepth -2..+2, after balancing: -1,0,+1
Data: T;
function Successor: specialize GprAvgLvlTreeNode<T>; // next right
function Precessor: specialize GprAvgLvlTreeNode<T>; // next left
procedure Clear;
function TreeDepth: integer; // longest WAY down. e.g. only one node => 0 !
procedure ConsistencyCheck(Tree: TprAvgLvlTreeNodeBase); virtual;
function GetCount: SizeInt;
end;
{ TBaseAvgLvlTreeNodeManager }
TBaseAvgLvlTreeNodeManager = class
public
procedure DisposeNode(pNode: TprAvgLvlTreeNodeBase); virtual; abstract;
function NewNode: TprAvgLvlTreeNodeBase; virtual; abstract;
end;
{ TprAvgLvlTreeNodeEnumerator }
TprAvgLvlTreeNodeEnumerator = class
protected
FCurrent: TprAvgLvlTreeNodeBase;
FLowToHigh: boolean;
FTree: TprAvgLvlTreeBase;
public
constructor Create(Tree: TprAvgLvlTreeBase; aLowToHigh: boolean = true);
function GetEnumerator: TprAvgLvlTreeNodeEnumerator; inline;
function MoveNext: Boolean;
property Current: TprAvgLvlTreeNodeBase read FCurrent;
property LowToHigh: boolean read FLowToHigh;
end;
{ GprAvgLvlTree }
generic GprAvgLvlTree<T> = class
public type
TSortCompareFunc = function(const Data1, Data2: T): Integer;
TObjectSortCompareFunc = function(const Data1, Data2: T): Integer of object;
private
FOnSortCompare: TSortCompareFunc;
FOnObjectSortCompare: TObjectSortCompareFunc;
protected
function Compare(Data1, Data2: T): integer; virtual;
public
constructor Create; overload;
constructor Create(pCompareMeathod: TSortCompareFunc); overload;
constructor Create(pCompareMeathod: TObjectSortCompareFunc); overload;
end;
implementation
{ GprAvgLvlTree }
function GprAvgLvlTree.Compare(Data1, Data2: T): integer;
begin
end;
constructor GprAvgLvlTree.Create;
begin
end;
constructor GprAvgLvlTree.Create(pCompareMeathod: TSortCompareFunc);
begin
end;
constructor GprAvgLvlTree.Create(pCompareMeathod: TObjectSortCompareFunc);
begin
end;
{ GprAvgLvlTreeNode }
function GprAvgLvlTreeNode.Successor: specialize GprAvgLvlTreeNode<T>;
begin
Result:=Right;
if Result<>nil then begin
while (Result.Left<>nil) do Result:=Result.Left;
end else begin
Result:=Self;
while (Result.Parent<>nil) and (Result.Parent.Right=Result) do
Result:=Result.Parent;
Result:=Result.Parent;
end;
end;
function GprAvgLvlTreeNode.Precessor: specialize GprAvgLvlTreeNode<T>;
begin
Result:=Left;
if Result<>nil then begin
while (Result.Right<>nil) do Result:=Result.Right;
end else begin
Result:=Self;
while (Result.Parent<>nil) and (Result.Parent.Left=Result) do
Result:=Result.Parent;
Result:=Result.Parent;
end;
end;
procedure GprAvgLvlTreeNode.Clear;
begin
Parent:=nil;
Left:=nil;
Right:=nil;
Balance:=0;
Data:=nil;
end;
function GprAvgLvlTreeNode.TreeDepth: integer;
// longest WAY down. e.g. only one node => 0 !
var LeftDepth, RightDepth: integer;
begin
if Left<>nil then
LeftDepth:=Left.TreeDepth+1
else
LeftDepth:=0;
if Right<>nil then
RightDepth:=Right.TreeDepth+1
else
RightDepth:=0;
if LeftDepth>RightDepth then
Result:=LeftDepth
else
Result:=RightDepth;
end;
procedure GprAvgLvlTreeNode.ConsistencyCheck(Tree: TprAvgLvlTreeNodeBase);
procedure E(Msg: string);
begin <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< internal error 200511173
raise Exception.Create('GprAvgLvlTreeNode.ConsistencyCheck: '+Msg);
end;
var
LeftDepth: SizeInt;
RightDepth: SizeInt;
begin
// test left child
if Left<>nil then begin
if Left.Parent<>Self then
E('Left.Parent<>Self');
if Tree.Compare(Left.Data,Data)>0 then
E('Compare(Left.Data,Data)>0');
Left.ConsistencyCheck(Tree);
end;
// test right child
if Right<>nil then begin
if Right.Parent<>Self then
E('Right.Parent<>Self');
if Tree.Compare(Data,Right.Data)>0 then
E('Compare(Data,Right.Data)>0');
Right.ConsistencyCheck(Tree);
end;
// test balance
if Left<>nil then
LeftDepth:=Left.TreeDepth+1
else
LeftDepth:=0;
if Right<>nil then
RightDepth:=Right.TreeDepth+1
else
RightDepth:=0;
if Balance<>(RightDepth-LeftDepth) then
E('Balance['+IntToStr(Balance)+']<>(RightDepth['+IntToStr(RightDepth)+']-LeftDepth['+IntToStr(LeftDepth)+'])');
end;
function GprAvgLvlTreeNode.GetCount: SizeInt;
begin
Result:=1;
if Left<>nil then inc(Result,Left.GetCount);
if Right<>nil then inc(Result,Right.GetCount);
end;
{ TprAvgLvlTreeNodeEnumerator }
constructor TprAvgLvlTreeNodeEnumerator.Create(Tree: TprAvgLvlTreeBase;
aLowToHigh: boolean);
begin
end;
function TprAvgLvlTreeNodeEnumerator.GetEnumerator: TprAvgLvlTreeNodeEnumerator;
begin
end;
function TprAvgLvlTreeNodeEnumerator.MoveNext: Boolean;
begin
end;
end.
Mantis conversion info:
- Mantis ID: 31945
- OS: Windows
- OS Build: 10 Pro x64
- Build: 36382
- Platform: i386
- Version: 3.1.1
- Fixed in version: 3.1.1
- Fixed in revision: 36469 (#dffe423b)