diff --git a/components/codetools/codecache.pas b/components/codetools/codecache.pas index 5d051b472c..de68b8e606 100644 --- a/components/codetools/codecache.pas +++ b/components/codetools/codecache.pas @@ -1169,14 +1169,21 @@ end; procedure TCodeCache.ConsistencyCheck; // 0 = ok var ANode: TAVLTreeNode; + {$IF FPC_FULLVERSION<30101} CurResult: LongInt; + {$ENDIF} begin + {$IF FPC_FULLVERSION<30101} CurResult:=FItems.ConsistencyCheck; if CurResult<>0 then RaiseCatchableException(IntToStr(CurResult)); CurResult:=FIncludeLinks.ConsistencyCheck; if CurResult<>0 then RaiseCatchableException(IntToStr(CurResult)); + {$ELSE} + FItems.ConsistencyCheck; + FIncludeLinks.ConsistencyCheck; + {$ENDIF} ANode:=FItems.FindLowest; while ANode<>nil do begin if ANode.Data=nil then diff --git a/components/codetools/codegraph.pas b/components/codetools/codegraph.pas index d3452c5dec..953e76a414 100644 --- a/components/codetools/codegraph.pas +++ b/components/codetools/codegraph.pas @@ -921,10 +921,15 @@ begin e(''); if Edges=nil then e(''); + {$IF FPC_FULLVERSION<30101} if Nodes.ConsistencyCheck<>0 then e(''); if Edges.ConsistencyCheck<>0 then e(''); + {$ELSE} + Nodes.ConsistencyCheck; + Edges.ConsistencyCheck; + {$ENDIF} if AVLTreeHasDoubles(Nodes)<>nil then e(''); if AVLTreeHasDoubles(Edges)<>nil then @@ -934,8 +939,12 @@ begin while AVLNode<>nil do begin GraphNode:=TCodeGraphNode(AVLNode.Data); if GraphNode.InTree<>nil then begin + {$IF FPC_FULLVERSION<30101} if GraphNode.InTree.ConsistencyCheck<>0 then e(''); + {$ELSE} + GraphNode.InTree.ConsistencyCheck; + {$ENDIF} if AVLTreeHasDoubles(GraphNode.InTree)<>nil then e(''); EdgeAVLNode:=GraphNode.InTree.FindLowest; @@ -949,8 +958,12 @@ begin end; end; if GraphNode.OutTree<>nil then begin - if GraphNode.OutTree.ConsistencyCheck<>0 then + {$IF FPC_FULLVERSION<30101} + if GraphNode.InTree.ConsistencyCheck<>0 then e(''); + {$ELSE} + GraphNode.InTree.ConsistencyCheck; + {$ENDIF} if AVLTreeHasDoubles(GraphNode.OutTree)<>nil then e(''); EdgeAVLNode:=GraphNode.OutTree.FindLowest; diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 64761c6a0b..5e8d3770c1 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -6294,8 +6294,10 @@ begin end; procedure TCodeToolManager.ConsistencyCheck; +{$IF FPC_FULLVERSION<30101} var CurResult: LongInt; +{$ENDIF} begin if FCurCodeTool<>nil then begin FCurCodeTool.ConsistencyCheck; @@ -6305,12 +6307,17 @@ begin SourceCache.ConsistencyCheck; GlobalValues.ConsistencyCheck; SourceChangeCache.ConsistencyCheck; + {$IF FPC_FULLVERSION<30101} CurResult:=FPascalTools.ConsistencyCheck; if CurResult<>0 then RaiseCatchableException(IntToStr(CurResult)); CurResult:=FDirectivesTools.ConsistencyCheck; if CurResult<>0 then RaiseCatchableException(IntToStr(CurResult)); + {$ELSE} + FPascalTools.ConsistencyCheck; + FDirectivesTools.ConsistencyCheck; + {$ENDIF} end; procedure TCodeToolManager.WriteDebugReport(WriteTool, diff --git a/components/codetools/ctunitgraph.pas b/components/codetools/ctunitgraph.pas index 7e73def498..115342add2 100644 --- a/components/codetools/ctunitgraph.pas +++ b/components/codetools/ctunitgraph.pas @@ -267,10 +267,15 @@ var AVLNode: TAVLTreeNode; AnUnit: TUGUnit; begin + {$IF FPC_FULLVERSION<30101} if FFiles.ConsistencyCheck<>0 then raise Exception.Create('FFiles.ConsistencyCheck'); if FQueuedFiles.ConsistencyCheck<>0 then raise Exception.Create('FStartFiles.ConsistencyCheck'); + {$ELSE} + FFiles.ConsistencyCheck; + FQueuedFiles.ConsistencyCheck; + {$ENDIF} AVLNode:=FQueuedFiles.FindLowest; while AVLNode<>nil do begin diff --git a/components/codetools/definetemplates.pas b/components/codetools/definetemplates.pas index 41ada32b62..1ae5c55ba4 100644 --- a/components/codetools/definetemplates.pas +++ b/components/codetools/definetemplates.pas @@ -5571,14 +5571,20 @@ begin end; procedure TDefineTree.ConsistencyCheck; +{$IF FPC_FULLVERSION<30101} var CurResult: LongInt; +{$ENDIF} begin if FFirstDefineTemplate<>nil then FFirstDefineTemplate.ConsistencyCheck; + {$IF FPC_FULLVERSION<30101} CurResult:=FCache.ConsistencyCheck; if CurResult<>0 then RaiseCatchableException(IntToStr(CurResult)); + {$ELSE} + FCache.ConsistencyCheck; + {$ENDIF} end; procedure TDefineTree.CalcMemSize(Stats: TCTMemStats); diff --git a/components/codetools/finddeclarationcache.pas b/components/codetools/finddeclarationcache.pas index 4f43c8801a..9ecc272356 100644 --- a/components/codetools/finddeclarationcache.pas +++ b/components/codetools/finddeclarationcache.pas @@ -489,8 +489,12 @@ var Entry: PInterfaceIdentCacheEntry; begin if FItems<>nil then begin + {$IF FPC_FULLVERSION<30101} if FItems.ConsistencyCheck<>0 then RaiseCatchableException(''); + {$ELSE} + FItems.ConsistencyCheck; + {$ENDIF} Node:=FItems.FindLowest; while Node<>nil do begin Entry:=PInterfaceIdentCacheEntry(Node.Data); @@ -1051,8 +1055,12 @@ end; procedure TCodeTreeNodeCache.ConsistencyCheck; begin if (FItems<>nil) then begin + {$IF FPC_FULLVERSION<30101} if FItems.ConsistencyCheck<>0 then raise Exception.Create(''); + {$ELSE} + FItems.ConsistencyCheck; + {$ENDIF} end; if Owner<>nil then begin if Owner.Cache<>Self then diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 6a6918c334..30ac0ed29b 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -11670,12 +11670,20 @@ begin ANodeCache:=ANodeCache.Next; end; if FDependentCodeTools<>nil then begin + {$IF FPC_FULLVERSION<30101} if FDependentCodeTools.ConsistencyCheck<>0 then raise Exception.Create(''); + {$ELSE} + FDependentCodeTools.ConsistencyCheck; + {$ENDIF} end; if FDependsOnCodeTools<>nil then begin + {$IF FPC_FULLVERSION<30101} if FDependsOnCodeTools.ConsistencyCheck<>0 then raise Exception.Create(''); + {$ELSE} + FDependsOnCodeTools.ConsistencyCheck; + {$ENDIF} end; end; diff --git a/components/codetools/sourcechanger.pas b/components/codetools/sourcechanger.pas index d9a4d4f80f..fc018c3897 100644 --- a/components/codetools/sourcechanger.pas +++ b/components/codetools/sourcechanger.pas @@ -906,12 +906,18 @@ begin end; procedure TSourceChangeCache.ConsistencyCheck; +{$IF FPC_FULLVERSION<30101} var CurResult: LongInt; +{$ENDIF} begin + {$IF FPC_FULLVERSION<30101} CurResult:=FEntries.ConsistencyCheck; if CurResult<>0 then RaiseCatchableException(IntToStr(CurResult)); + {$ELSE} + FEntries.ConsistencyCheck; + {$ENDIF} BeautifyCodeOptions.ConsistencyCheck; end; diff --git a/components/codetools/unitdictionary.pas b/components/codetools/unitdictionary.pas index 7203564542..15fee6b8d2 100644 --- a/components/codetools/unitdictionary.pas +++ b/components/codetools/unitdictionary.pas @@ -396,6 +396,7 @@ begin if UnitsByFilename.Count<>UnitsByName.Count then e('UnitsByFilename.Count<>UnitsByName.Count'); + {$IF FPC_FULLVERSION<30101} if UnitGroupsByFilename.ConsistencyCheck<>0 then e('UnitGroupsByFilename.ConsistencyCheck<>0'); if UnitGroupsByName.ConsistencyCheck<>0 then @@ -404,6 +405,12 @@ begin e('UnitsByName.ConsistencyCheck<>0'); if UnitsByFilename.ConsistencyCheck<>0 then e('UnitsByFilename.ConsistencyCheck<>0'); + {$ELSE} + UnitGroupsByFilename.ConsistencyCheck; + UnitGroupsByName.ConsistencyCheck; + UnitsByName.ConsistencyCheck; + UnitsByFilename.ConsistencyCheck; + {$ENDIF} IdentifiersCount:=0; // check UnitsByName @@ -419,8 +426,12 @@ begin e('unit '+CurUnit.Name+' in FUnitsByName not in FUnitsByFilename'); if CurUnit.Groups.Count=0 then e('unit '+CurUnit.Name+' has not group'); + {$IF FPC_FULLVERSION<30101} if CurUnit.Groups.ConsistencyCheck<>0 then e('unit '+CurUnit.Name+' UnitGroups.ConsistencyCheck<>0'); + {$ELSE} + CurUnit.Groups.ConsistencyCheck; + {$ENDIF} if (LastUnit<>nil) and (CompareFilenames(LastUnit.Filename,CurUnit.Filename)=0) then e('unit '+CurUnit.Name+' exists twice: '+CurUnit.Filename); @@ -480,8 +491,12 @@ begin e('group '+Group.Name+' without filename'); if AVLFindPointer(FUnitGroupsByFilename,Group)=nil then e('group '+Group.Name+' in FUnitGroupsByName not in FUnitGroupsByFilename'); + {$IF FPC_FULLVERSION<30101} if Group.Units.ConsistencyCheck<>0 then e('group '+Group.Name+' Group.Units.ConsistencyCheck<>0'); + {$ELSE} + Group.Units.ConsistencyCheck; + {$ENDIF} if (LastGroup<>nil) and (CompareFilenames(LastGroup.Filename,Group.Filename)=0) then e('group '+Group.Name+' exists twice: '+Group.Filename); diff --git a/test/lazutils/testavglvltree.pas b/test/lazutils/testavglvltree.pas index 987ff40889..74f03ccc0d 100644 --- a/test/lazutils/testavglvltree.pas +++ b/test/lazutils/testavglvltree.pas @@ -1,10 +1,12 @@ { Test all with: ./runtests --format=plain --suite=TTestAvgLvlTree + ./runtests --format=plain --suite=TTestAVLTree Test specific with: - ./runtests --format=plain --suite=TestAVLTreeAddsDeletes + ./runtests --format=plain --suite=TestAvgLvlTreeAddsDeletes ./runtests --format=plain --suite=TestIndexedAVLTreeAddsDeletes + ./runtests --format=plain --suite=TestAVLTreeAddsDeletes } unit TestAvgLvlTree; @@ -15,7 +17,7 @@ unit TestAvgLvlTree; interface uses - Classes, SysUtils, fpcunit, testglobals, AvgLvlTree, LazLogger; + Classes, SysUtils, AVL_Tree, fpcunit, testglobals, AvgLvlTree, LazLogger; type { TTestAvgLvlTree } @@ -23,26 +25,40 @@ type TTestAvgLvlTree = class(TTestCase) private fTreeClass: TAvgLvlTreeClass; + function CreateTree(Args: array of const): TAvgLvlTree; procedure TestSequence(Args: array of const); + procedure TestAscendingSequence(InitArgs: array of const; AscSeq: array of const); + procedure TestAvgLvlTree; + published + procedure TestAvgLvlTreeAddsDeletes; + procedure TestIndexedAVLTreeAddsDeletes; + end; + + { TTestAVLTree } + + TTestAVLTree = class(TTestCase) + private + fTreeClass: TAVLTreeClass; + function CreateTree(Args: array of const): TAVLTree; + procedure TestSequence(Args: array of const); + procedure TestAscendingSequence(InitArgs: array of const; AscSeq: array of const); procedure TestAVLTree; published procedure TestAVLTreeAddsDeletes; - procedure TestIndexedAVLTreeAddsDeletes; end; implementation -{ TTestAvgLvlTree } +{ TTestAVLTree } -procedure TTestAvgLvlTree.TestSequence(Args: array of const); +function TTestAVLTree.CreateTree(Args: array of const): TAVLTree; var - Tree: TAvgLvlTree; i: Integer; Value: LongInt; begin - Tree:=fTreeClass.Create; - //DebugLn(Tree.ReportAsString); - Tree.ConsistencyCheck; + Result:=fTreeClass.Create; + //DebugLn(Result.ReportAsString); + Result.ConsistencyCheck; for i:=Low(Args) to high(Args) do begin if Args[i].VType<>vtInteger then continue; @@ -51,15 +67,52 @@ begin {$IFDEF VerboseTestSequence} DebugLn([' add value ',Value]); {$ENDIF} - Tree.Add({%H-}Pointer(Value)); + Result.Add({%H-}Pointer(Value)); end else begin Value:=-Value; {$IFDEF VerboseTestSequence} debugln([' remove value ',Value]); {$ENDIF} - Tree.Remove({%H-}Pointer(Value)); + Result.Remove({%H-}Pointer(Value)); end; {$IFDEF VerboseTestSequence} + DebugLn(Result.ReportAsString); + {$ENDIF} + Result.ConsistencyCheck; + end; +end; + +procedure TTestAVLTree.TestSequence(Args: array of const); +var + Tree: TAVLTree; +begin + Tree:=CreateTree(Args); + Tree.Clear; + //DebugLn(Tree.ReportAsString); + Tree.ConsistencyCheck; + Tree.Free; +end; + +procedure TTestAVLTree.TestAscendingSequence(InitArgs: array of const; + AscSeq: array of const); +var + Tree: TAVLTree; + LastAdded, Succesor: TAVLTreeNode; + i: Integer; + Value: LongInt; +begin + Tree:=CreateTree(InitArgs); + + LastAdded:=nil; + Succesor:=nil; + for i:=Low(AscSeq) to high(AscSeq) do begin + if AscSeq[i].VType<>vtInteger then continue; + Value:=AscSeq[i].vinteger; + {$IFDEF VerboseTestSequence} + DebugLn([' add ascending value ',Value]); + {$ENDIF} + LastAdded:=Tree.AddAscendingSequence({%H-}Pointer(Value),LastAdded,Succesor); + {$IFDEF VerboseTestSequence} DebugLn(Tree.ReportAsString); {$ENDIF} Tree.ConsistencyCheck; @@ -68,11 +121,10 @@ begin Tree.Clear; //DebugLn(Tree.ReportAsString); Tree.ConsistencyCheck; - Tree.Free; end; -procedure TTestAvgLvlTree.TestAVLTree; +procedure TTestAVLTree.TestAVLTree; begin // rotate left TestSequence([]); @@ -100,22 +152,156 @@ begin TestSequence([1,2,3,-2,-3,-1]); TestSequence([1,2,3,-3,-1,-2]); TestSequence([1,2,3,-3,-2,-1]); + + // test AddAscendingSequence + TestAscendingSequence([],[1]); + TestAscendingSequence([],[1,2]); + TestAscendingSequence([],[1,2,3]); + TestAscendingSequence([],[2,1]); + TestAscendingSequence([],[3,2,1]); + TestAscendingSequence([1],[2,3,4,5]); + TestAscendingSequence([2],[1,3,4,5]); + TestAscendingSequence([3],[1,2,4,5,6]); + TestAscendingSequence([3,4],[1,2,5,6,7]); end; -procedure TTestAvgLvlTree.TestAVLTreeAddsDeletes; +procedure TTestAVLTree.TestAVLTreeAddsDeletes; +begin + fTreeClass:=TAVLTree; + TestAVLTree; +end; + +{ TTestAvgLvlTree } + +function TTestAvgLvlTree.CreateTree(Args: array of const): TAvgLvlTree; +var + i: Integer; + Value: LongInt; +begin + Result:=fTreeClass.Create; + //DebugLn(Result.ReportAsString); + Result.ConsistencyCheck; + + for i:=Low(Args) to high(Args) do begin + if Args[i].VType<>vtInteger then continue; + Value:=Args[i].vinteger; + if Value>0 then begin + {$IFDEF VerboseTestSequence} + DebugLn([' add value ',Value]); + {$ENDIF} + Result.Add({%H-}Pointer(Value)); + end else begin + Value:=-Value; + {$IFDEF VerboseTestSequence} + debugln([' remove value ',Value]); + {$ENDIF} + Result.Remove({%H-}Pointer(Value)); + end; + {$IFDEF VerboseTestSequence} + DebugLn(Result.ReportAsString); + {$ENDIF} + Result.ConsistencyCheck; + end; +end; + +procedure TTestAvgLvlTree.TestSequence(Args: array of const); +var + Tree: TAvgLvlTree; +begin + Tree:=CreateTree(Args); + Tree.Clear; + //DebugLn(Tree.ReportAsString); + Tree.ConsistencyCheck; + Tree.Free; +end; + +procedure TTestAvgLvlTree.TestAscendingSequence(InitArgs: array of const; + AscSeq: array of const); +var + Tree: TAvgLvlTree; + LastAdded, Succesor: TAvgLvlTreeNode; + i: Integer; + Value: LongInt; +begin + Tree:=CreateTree(InitArgs); + + LastAdded:=nil; + Succesor:=nil; + for i:=Low(AscSeq) to high(AscSeq) do begin + if AscSeq[i].VType<>vtInteger then continue; + Value:=AscSeq[i].vinteger; + {$IFDEF VerboseTestSequence} + DebugLn([' add ascending value ',Value]); + {$ENDIF} + LastAdded:=Tree.AddAscendingSequence({%H-}Pointer(Value),LastAdded,Succesor); + {$IFDEF VerboseTestSequence} + DebugLn(Tree.ReportAsString); + {$ENDIF} + Tree.ConsistencyCheck; + end; + + Tree.Clear; + //DebugLn(Tree.ReportAsString); + Tree.ConsistencyCheck; + Tree.Free; +end; + +procedure TTestAvgLvlTree.TestAvgLvlTree; +begin + // rotate left + TestSequence([]); + TestSequence([1]); + TestSequence([1,2]); + TestSequence([1,2,3]); + TestSequence([1,2,3,4]); + TestSequence([1,2,3,4,5]); + TestSequence([1,2,3,4,5,6]); + TestSequence([1,2,3,4,5,6,7,8,9,10]); + + // rotate right + TestSequence([10,9,8,7,6,5,4,3,2,1]); + + // double rotate right, left + TestSequence([5,7,6]); + + // double rotate left, right + TestSequence([5,3,4]); + + // test deletes + TestSequence([1,2,3,-1,-2,-3]); + TestSequence([1,2,3,-1,-3,-2]); + TestSequence([1,2,3,-2,-1,-3]); + TestSequence([1,2,3,-2,-3,-1]); + TestSequence([1,2,3,-3,-1,-2]); + TestSequence([1,2,3,-3,-2,-1]); + + // test AddAscendingSequence + TestAscendingSequence([],[1]); + TestAscendingSequence([],[1,2]); + TestAscendingSequence([],[1,2,3]); + TestAscendingSequence([],[2,1]); + TestAscendingSequence([],[3,2,1]); + TestAscendingSequence([1],[2,3,4,5]); + TestAscendingSequence([2],[1,3,4,5]); + TestAscendingSequence([3],[1,2,4,5,6]); + TestAscendingSequence([3,4],[1,2,5,6,7]); +end; + +procedure TTestAvgLvlTree.TestAvgLvlTreeAddsDeletes; begin fTreeClass:=TAvgLvlTree; - TestAVLTree; + TestAvgLvlTree; end; procedure TTestAvgLvlTree.TestIndexedAVLTreeAddsDeletes; begin fTreeClass:=TIndexedAVLTree; - TestAVLTree; + TestAvgLvlTree; end; initialization AddToLazUtilsTestSuite(TTestAvgLvlTree); + AddToLazUtilsTestSuite(TTestAVLTree); end.