codetools: added h2ptree, converted some consistencychecks to exceptions

git-svn-id: trunk@14517 -

components/codetools/codetoolmanager.pas

@@ -4732,10 +4732,7 @@ begin
   try
     Result:=0;
     if FCurCodeTool<>nil then begin
-      Result:=FCurCodeTool.ConsistencyCheck;
-      if Result<>0 then begin
-        dec(Result,10000);  exit;
-      end;
+      FCurCodeTool.ConsistencyCheck;
     end;
     Result:=DefinePool.ConsistencyCheck;
     if Result<>0 then begin
@@ -4778,9 +4775,7 @@ begin
   DebugLn('[TCodeToolManager.WriteDebugReport] Consistency=',dbgs(ConsistencyCheck));
   if FCurCodeTool<>nil then begin
     if WriteTool then
-      FCurCodeTool.WriteDebugTreeReport
-    else
-      DebugLn('  FCurCodeTool.ConsistencyCheck=',dbgs(FCurCodeTool.ConsistencyCheck));
+      FCurCodeTool.WriteDebugTreeReport;
   end;
   if WriteDefPool then
     DefinePool.WriteDebugReport

components/codetools/codetree.pas

@@ -237,7 +237,7 @@ type
     function FindOwner: TObject;
     procedure Clear;
     constructor Create;
-    function ConsistencyCheck: integer; // 0 = ok
+    procedure ConsistencyCheck;
     procedure WriteDebugReport(const Prefix: string; WithChilds: boolean);
   end;
 
@@ -257,7 +257,7 @@ type
     procedure Clear;
     constructor Create;
     destructor Destroy; override;
-    function ConsistencyCheck: integer; // 0 = ok
+    procedure ConsistencyCheck;
     procedure WriteDebugReport(WithChilds: boolean);
   end;
 
@@ -616,35 +616,32 @@ begin
     Result:=Parent;
 end;
 
-function TCodeTreeNode.ConsistencyCheck: integer;
-// 0 = ok
+procedure TCodeTreeNode.ConsistencyCheck;
 begin
-  if (EndPos>0) and (StartPos>EndPos) then begin
-    Result:=-1;  exit;
-  end;
+  if (EndPos>0) and (StartPos>EndPos) then
+    raise Exception.Create('');
   if (Parent<>nil) then begin
-    if (PriorBrother=nil) and (Parent.FirstChild<>Self) then begin
-      Result:=-2;  exit;
-    end;
-    if (NextBrother=nil) and (Parent.LastChild<>Self) then begin
-      Result:=-3;  exit;
-    end;
+    if (PriorBrother=nil) and (Parent.FirstChild<>Self) then
+      raise Exception.Create('');
+    if (NextBrother=nil) and (Parent.LastChild<>Self) then
+      raise Exception.Create('');
   end;
-  if (NextBrother<>nil) and (NextBrother.PriorBrother<>Self) then begin
-    Result:=-4;  exit;
-  end;
-  if (PriorBrother<>nil) and (PriorBrother.NextBrother<>Self) then begin
-    Result:=-5;  exit;
-  end;
-  if (FirstChild<>nil) then begin
-    Result:=FirstChild.ConsistencyCheck;
-    if Result<>0 then exit;
-  end;
-  if NextBrother<>nil then begin
-    Result:=NextBrother.ConsistencyCheck;
-    if Result<>0 then exit;
-  end;
-  Result:=0;
+  if (NextBrother<>nil) and (NextBrother.Parent<>Parent) then;
+    raise Exception.Create('');
+  if (PriorBrother<>nil) and (PriorBrother.Parent<>Parent) then;
+    raise Exception.Create('');
+  if (FirstChild<>nil) and (FirstChild.Parent<>Self) then
+    raise Exception.Create('');
+  if (FirstChild=nil) <> (LastChild=nil) then
+    raise Exception.Create('');
+  if (NextBrother<>nil) and (NextBrother.PriorBrother<>Self) then
+    raise Exception.Create('');
+  if (PriorBrother<>nil) and (PriorBrother.NextBrother<>Self) then
+    raise Exception.Create('');
+  if (FirstChild<>nil) then
+    FirstChild.ConsistencyCheck;
+  if NextBrother<>nil then
+    NextBrother.ConsistencyCheck;
 end;
 
 procedure TCodeTreeNode.WriteDebugReport(const Prefix: string;
@@ -854,8 +851,7 @@ begin
   Result:=ANode=Root;
 end;
 
-function TCodeTree.ConsistencyCheck: integer;
-// 0 = ok
+procedure TCodeTree.ConsistencyCheck;
 var RealNodeCount: integer;
 
   procedure CountNodes(ANode: TCodeTreeNode);
@@ -868,26 +864,19 @@ var RealNodeCount: integer;
 
 begin
   if Root<>nil then begin
-    Result:=Root.ConsistencyCheck;
-    if Result<>0 then begin
-      dec(Result,100);  exit;
-    end;
-    if Root.Parent<>nil then begin
-      Result:=-1;  exit;
-    end;
+    if Root.Parent<>nil then
+      raise Exception.Create('');
+    Root.ConsistencyCheck;
   end;
   RealNodeCount:=0;
   CountNodes(Root);
-  if RealNodeCount<>FNodeCount then begin
-    Result:=-2;  exit;
-  end;
-  Result:=0;
+  if RealNodeCount<>FNodeCount then
+    raise Exception.Create('');
 end;
 
 procedure TCodeTree.WriteDebugReport(WithChilds: boolean);
 begin
-  DebugLn('[TCodeTree.WriteDebugReport] Consistency=',dbgs(ConsistencyCheck),
-    ' Root=',dbgs(Root<>nil));
+  DebugLn('[TCodeTree.WriteDebugReport] Root=',dbgs(Root<>nil));
   if Root<>nil then
     Root.WriteDebugReport(' ',true);
 end;

components/codetools/customcodetool.pas

@@ -326,7 +326,7 @@ type
     procedure Clear; virtual;
     function NodeDescToStr(Desc: integer): string;
     function NodeSubDescToStr(Desc, SubDesc: integer): string;
-    function ConsistencyCheck: integer; virtual; // 0 = ok
+    procedure ConsistencyCheck; virtual;
     procedure WriteDebugTreeReport;
     procedure CheckNodeTool(Node: TCodeTreeNode);
     constructor Create;
@@ -2045,14 +2045,9 @@ begin
   Result:=true;
 end;
 
-function TCustomCodeTool.ConsistencyCheck: integer;
-// 0 = ok
+procedure TCustomCodeTool.ConsistencyCheck;
 begin
-  Result:=Tree.ConsistencyCheck;
-  if Result<>0 then begin
-    dec(Result,100);  exit;
-  end;
-  Result:=0;
+  Tree.ConsistencyCheck;
 end;
 
 procedure TCustomCodeTool.WriteDebugTreeReport;
@@ -2094,9 +2089,9 @@ procedure TCustomCodeTool.WriteDebugTreeReport;
   end;
 
 begin
-  DebugLn('[TCustomCodeTool.WriteDebugTreeReport] Consistency=',
-     dbgs(ConsistencyCheck));
+  DebugLn('[TCustomCodeTool.WriteDebugTreeReport]');
   WriteSubTree(Tree.Root,'  ');
+  ConsistencyCheck;
 end;
 
 procedure TCustomCodeTool.CheckNodeTool(Node: TCodeTreeNode);

components/codetools/finddeclarationcache.pas

@@ -144,7 +144,7 @@ type
     constructor Create(AnOwner: TCodeTreeNode);
     destructor Destroy; override;
     procedure WriteDebugReport(const Prefix: string);
-    function ConsistencyCheck: integer;
+    procedure ConsistencyCheck;
   end;
   
   {
@@ -881,30 +881,23 @@ begin
   end;
 end;
 
-function TCodeTreeNodeCache.ConsistencyCheck: integer;
+procedure TCodeTreeNodeCache.ConsistencyCheck;
 begin
   if (FItems<>nil) then begin
-    Result:=FItems.ConsistencyCheck;
-    if Result<>0 then begin
-      dec(Result,100);
-      exit;
-    end;
+    if FItems.ConsistencyCheck<>0 then
+      raise Exception.Create('');
   end;
   if Owner<>nil then begin
-    if Owner.Cache<>Self then begin
-      Result:=-1;
-      exit;
-    end;
+    if Owner.Cache<>Self then
+      raise Exception.Create('');
   end;
-  Result:=0;
 end;
 
 procedure TCodeTreeNodeCache.WriteDebugReport(const Prefix: string);
 var Node: TAVLTreeNode;
   Entry: PCodeTreeNodeCacheEntry;
 begin
-  DebugLn(Prefix+'[TCodeTreeNodeCache.WriteDebugReport] Self='+
-    DbgS(Self)+' Consistency=',dbgs(ConsistencyCheck));
+  DebugLn(Prefix+'[TCodeTreeNodeCache.WriteDebugReport] Self='+DbgS(Self));
   if FItems<>nil then begin
     Node:=FItems.FindLowest;
     while Node<>nil do begin
@@ -916,6 +909,7 @@ begin
       Node:=FItems.FindSuccessor(Node);
     end;
   end;
+  ConsistencyCheck;
 end;
 
 procedure TCodeTreeNodeCache.UnbindFromOwner;

components/codetools/finddeclarationtool.pas

@@ -693,7 +693,7 @@ type
   public
     procedure BuildTree(OnlyInterfaceNeeded: boolean); override;
     destructor Destroy; override;
-    function ConsistencyCheck: integer; override;
+    procedure ConsistencyCheck; override;
 
     function FindDeclaration(const CursorPos: TCodeXYPosition;
       out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
@@ -7574,36 +7574,25 @@ begin
     FDependsOnCodeTools.Add(DependOnTool);
 end;
 
-function TFindDeclarationTool.ConsistencyCheck: integer;
+procedure TFindDeclarationTool.ConsistencyCheck;
 var ANodeCache: TCodeTreeNodeCache;
 begin
-  Result:=inherited ConsistencyCheck;
-  if Result<>0 then exit;
+  inherited ConsistencyCheck;
   if FInterfaceIdentifierCache<>nil then begin
 
   end;
   ANodeCache:=FFirstNodeCache;
   while ANodeCache<>nil do begin
-    Result:=ANodeCache.ConsistencyCheck;
-    if Result<>0 then begin
-      dec(Result,100);
-      exit;
-    end;
+    ANodeCache.ConsistencyCheck;
     ANodeCache:=ANodeCache.Next;
   end;
   if FDependentCodeTools<>nil then begin
-    Result:=FDependentCodeTools.ConsistencyCheck;
-    if Result<>0 then begin
-      dec(Result,200);
-      exit;
-    end;
+    if FDependentCodeTools.ConsistencyCheck<>0 then
+      raise Exception.Create('');
   end;
   if FDependsOnCodeTools<>nil then begin
-    Result:=FDependsOnCodeTools.ConsistencyCheck;
-    if Result<>0 then begin
-      dec(Result,300);
-      exit;
-    end;
+    if FDependsOnCodeTools.ConsistencyCheck<>0 then
+      raise Exception.Create('');
   end;
 end;
 

components/codetools/h2pastool.pas

@@ -22,6 +22,16 @@
 
   Abstract:
     A tool to help converting C header files to pascal bindings.
+    
+    enum     ->  enum
+    int i;   ->  var i: integer;
+    const char a; -> const a: char;
+    struct   ->  var plus record
+    union    ->  var plus record case
+    typedef  ->  type
+    void func()  -> procedure
+    int func()   -> function
+    #define name value  ->  alias  (const, var, type, proc)
 }
 unit H2PasTool;
 
@@ -31,17 +41,61 @@ interface
 
 uses
   Classes, SysUtils, FileProcs,CCodeParserTool, NonPascalCodeTools,
-  CodeCache;
+  CodeCache, CodeTree, CodeAtom;
   
 type
 
+  { TH2PNode }
+
+  TH2PNode = class
+  public
+    Name: string;
+    CNode: TCodeTreeNode;
+    PascalDesc: TCodeTreeNodeDesc;
+    Code: string;
+    NormalizedCode: string;
+    Parent, FirstChild, LastChild, NextBrother, PriorBrother: TH2PNode;
+    function Next: TH2PNode;
+    function NextSkipChilds: TH2PNode;
+    function Prior: TH2PNode;
+    function HasAsParent(Node: TH2PNode): boolean;
+    function HasAsChild(Node: TH2PNode): boolean;
+    function GetLevel: integer;
+    function DescAsString: string;
+    procedure ConsistencyCheck;
+    procedure WriteDebugReport(const Prefix: string; WithChilds: boolean);
+  end;
+  
+  { TH2PTree }
+
+  TH2PTree = class
+  private
+    FNodeCount: integer;
+  public
+    Root: TH2PNode;
+    constructor Create;
+    destructor Destroy; override;
+    procedure Clear;
+    property NodeCount: integer read FNodeCount;
+    procedure DeleteNode(ANode: TH2PNode);
+    procedure AddNodeAsLastChild(ParentNode, ANode: TH2PNode);
+    procedure AddNodeInFrontOf(NextBrotherNode, ANode: TH2PNode);
+    function ContainsNode(ANode: TH2PNode): boolean;
+    procedure ConsistencyCheck;
+    procedure WriteDebugReport(WithChilds: boolean);
+  end;
+  
   { TH2PasTool }
 
   TH2PasTool = class
   public
+    Tree: TH2PTree;
     CTool: TCCodeParserTool;
     function Convert(CCode, PascalCode: TCodeBuffer): boolean;
     procedure WriteDebugReport;
+    constructor Create;
+    destructor Destroy; override;
+    procedure Clear;
   end;
 
 implementation
@@ -72,5 +126,254 @@ begin
     CTool.WriteDebugReport;
 end;
 
+constructor TH2PasTool.Create;
+begin
+  Tree:=TH2PTree.Create;
+end;
+
+destructor TH2PasTool.Destroy;
+begin
+  Clear;
+  inherited Destroy;
+end;
+
+procedure TH2PasTool.Clear;
+begin
+  Tree.Clear;
+end;
+
+{ TH2PNode }
+
+function TH2PNode.Next: TH2PNode;
+begin
+  if FirstChild<>nil then begin
+    Result:=FirstChild;
+  end else begin
+    Result:=Self;
+    while (Result<>nil) and (Result.NextBrother=nil) do
+      Result:=Result.Parent;
+    if Result<>nil then Result:=Result.NextBrother;
+  end;
+end;
+
+function TH2PNode.NextSkipChilds: TH2PNode;
+begin
+  Result:=Self;
+  while (Result<>nil) and (Result.NextBrother=nil) do
+    Result:=Result.Parent;
+  if Result<>nil then Result:=Result.NextBrother;
+end;
+
+function TH2PNode.Prior: TH2PNode;
+begin
+  if PriorBrother<>nil then begin
+    Result:=PriorBrother;
+    while Result.LastChild<>nil do
+      Result:=Result.LastChild;
+  end else
+    Result:=Parent;
+end;
+
+function TH2PNode.HasAsParent(Node: TH2PNode): boolean;
+var CurNode: TH2PNode;
+begin
+  Result:=false;
+  if Node=nil then exit;
+  CurNode:=Parent;
+  while (CurNode<>nil) do begin
+    if CurNode=Node then begin
+      Result:=true;
+      exit;
+    end;
+    CurNode:=CurNode.Parent;
+  end;
+end;
+
+function TH2PNode.HasAsChild(Node: TH2PNode): boolean;
+begin
+  Result:=false;
+  if Node=nil then exit;
+  Result:=Node.HasAsParent(Self);
+end;
+
+function TH2PNode.GetLevel: integer;
+var ANode: TH2PNode;
+begin
+  Result:=0;
+  ANode:=Parent;
+  while ANode<>nil do begin
+    inc(Result);
+    ANode:=ANode.Parent;
+  end;
+end;
+
+function TH2PNode.DescAsString: string;
+begin
+  Result:='Name="'+Name+'"';
+  Result:=Result+' PascalDesc='+NodeDescriptionAsString(PascalDesc);
+  if CNode<>nil then begin
+    Result:=Result+' CNode='+CNode.DescAsString;
+  end else begin
+    Result:=Result+' CNode=nil';
+  end;
+end;
+
+procedure TH2PNode.ConsistencyCheck;
+begin
+  if (Parent<>nil) then begin
+    if (PriorBrother=nil) and (Parent.FirstChild<>Self) then
+      raise Exception.Create('');
+    if (NextBrother=nil) and (Parent.LastChild<>Self) then
+      raise Exception.Create('');
+  end;
+  if (NextBrother<>nil) and (NextBrother.PriorBrother<>Self) then
+    raise Exception.Create('');
+  if (PriorBrother<>nil) and (PriorBrother.NextBrother<>Self) then
+    raise Exception.Create('');
+  if (FirstChild<>nil) then
+    FirstChild.ConsistencyCheck;
+  if NextBrother<>nil then
+    NextBrother.ConsistencyCheck;
+end;
+
+procedure TH2PNode.WriteDebugReport(const Prefix: string; WithChilds: boolean);
+var
+  Node: TH2PNode;
+begin
+  DebugLn([Prefix,DescAsString]);
+  if WithChilds then begin
+    Node:=FirstChild;
+    while Node<>nil do begin
+      Node.WriteDebugReport(Prefix+'  ',true);
+      Node:=Node.NextBrother;
+    end;
+  end;
+end;
+
+{ TH2PTree }
+
+constructor TH2PTree.Create;
+begin
+  Root:=nil;
+  FNodeCount:=0;
+end;
+
+destructor TH2PTree.Destroy;
+begin
+  Clear;
+  inherited Destroy;
+end;
+
+procedure TH2PTree.Clear;
+var ANode: TH2PNode;
+begin
+  while Root<>nil do begin
+    ANode:=Root;
+    Root:=ANode.NextBrother;
+    DeleteNode(ANode);
+  end;
+end;
+
+procedure TH2PTree.DeleteNode(ANode: TH2PNode);
+begin
+  if ANode=nil then exit;
+  while (ANode.FirstChild<>nil) do DeleteNode(ANode.FirstChild);
+  with ANode do begin
+    if (Parent<>nil) then begin
+      if (Parent.FirstChild=ANode) then
+        Parent.FirstChild:=NextBrother;
+      if (Parent.LastChild=ANode) then
+        Parent.LastChild:=PriorBrother;
+      Parent:=nil;
+    end;
+    if NextBrother<>nil then NextBrother.PriorBrother:=PriorBrother;
+    if PriorBrother<>nil then PriorBrother.NextBrother:=NextBrother;
+    NextBrother:=nil;
+    PriorBrother:=nil;
+  end;
+  if ANode=Root then Root:=nil;
+  dec(FNodeCount);
+  ANode.Free;
+end;
+
+procedure TH2PTree.AddNodeAsLastChild(ParentNode, ANode: TH2PNode);
+var TopNode: TH2PNode;
+begin
+  ANode.Parent:=ParentNode;
+  if Root=nil then begin
+    // set as root
+    Root:=ANode;
+    while Root.Parent<>nil do Root:=Root.Parent;
+  end else if ParentNode<>nil then begin
+    if ParentNode.FirstChild=nil then begin
+      // add as first child
+      ParentNode.FirstChild:=ANode;
+      ParentNode.LastChild:=ANode;
+    end else begin
+      // add as last child
+      ANode.PriorBrother:=ParentNode.LastChild;
+      ParentNode.LastChild:=ANode;
+      if ANode.PriorBrother<>nil then ANode.PriorBrother.NextBrother:=ANode;
+    end;
+  end else begin
+    // add as last brother of top nodes
+    TopNode:=Root;
+    while (TopNode.NextBrother<>nil) do TopNode:=TopNode.NextBrother;
+    ANode.PriorBrother:=TopNode;
+    ANode.PriorBrother.NextBrother:=ANode;
+  end;
+  inc(FNodeCount);
+end;
+
+procedure TH2PTree.AddNodeInFrontOf(NextBrotherNode, ANode: TH2PNode);
+begin
+  ANode.Parent:=NextBrotherNode.Parent;
+  ANode.NextBrother:=NextBrotherNode;
+  ANode.PriorBrother:=NextBrotherNode.PriorBrother;
+  NextBrotherNode.PriorBrother:=ANode;
+  if ANode.PriorBrother<>nil then
+    ANode.PriorBrother.NextBrother:=ANode;
+end;
+
+function TH2PTree.ContainsNode(ANode: TH2PNode): boolean;
+begin
+  if ANode=nil then exit(false);
+  while ANode.Parent<>nil do ANode:=ANode.Parent;
+  while ANode.PriorBrother<>nil do ANode:=ANode.PriorBrother;
+  Result:=ANode=Root;
+end;
+
+procedure TH2PTree.ConsistencyCheck;
+// 0 = ok
+var RealNodeCount: integer;
+
+  procedure CountNodes(ANode: TH2PNode);
+  begin
+    if ANode=nil then exit;
+    inc(RealNodeCount);
+    CountNodes(ANode.FirstChild);
+    CountNodes(ANode.NextBrother);
+  end;
+
+begin
+  if Root<>nil then begin
+    Root.ConsistencyCheck;
+    if Root.Parent<>nil then
+      raise Exception.Create('Root.Parent<>nil');
+  end;
+  RealNodeCount:=0;
+  CountNodes(Root);
+  if RealNodeCount<>FNodeCount then
+    raise Exception.Create('RealNodeCount<>FNodeCount');
+end;
+
+procedure TH2PTree.WriteDebugReport(WithChilds: boolean);
+begin
+  DebugLn('[TH2PTree.WriteDebugReport] Root=',dbgs(Root<>nil));
+  if Root<>nil then
+    Root.WriteDebugReport(' ',true);
+  ConsistencyCheck;
+end;
+
 end.