paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 16:09:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: bugfixes, finddeclaration cache dependencies

Browse Source 
git-svn-id: trunk@1579 -
This commit is contained in:
lazarus 2002-04-02 16:44:41 +00:00
parent 47e3ef52e6
commit 0e2a403556
6 changed files with 262 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
components/codetools/avl_tree.pas
View File

@ -45,6 +45,7 @@ type
procedure Add(ANode: TAVLTreeNode);
function Add(Data: Pointer): TAVLTreeNode;
procedure Delete(ANode: TAVLTreeNode);
procedure Remove(Data: Pointer);
procedure MoveDataLeftMost(var ANode: TAVLTreeNode);
procedure MoveDataRightMost(var ANode: TAVLTreeNode);
property OnCompare: TListSortCompare read FOnCompare write SetOnCompare;
@ -56,6 +57,7 @@ type
procedure WriteReportToStream(s: TStream; var StreamSize: integer);
function ReportAsString: string;
constructor Create(OnCompareMethod: TListSortCompare);
constructor Create;
destructor Destroy; override;
end;
@ -81,11 +83,20 @@ type
destructor Destroy; override;
end;
implementation
var NodeMemManager: TAVLTreeNodeMemManager;
function ComparePointer(Data1, Data2: Pointer): integer;
begin
if Data1>Data2 then Result:=-1
else if Data1<Data2 then Result:=1
else Result:=0;
end;
{ TAVLTree }
function TAVLTree.Add(Data: Pointer): TAVLTreeNode;
@ -446,6 +457,11 @@ begin
FCount:=0;
end;
constructor TAVLTree.Create;
begin
Create(@ComparePointer);
end;
procedure TAVLTree.Delete(ANode: TAVLTreeNode);
var OldParent, OldLeft, OldRight, Successor, OldSuccParent, OldSuccLeft,
OldSuccRight: TAVLTreeNode;
@ -568,6 +584,14 @@ begin
Delete(ANode);
end;
procedure TAVLTree.Remove(Data: Pointer);
var ANode: TAVLTreeNode;
begin
ANode:=Find(Data);
if ANode<>nil then
Delete(ANode);
end;
destructor TAVLTree.Destroy;
begin
Clear;
@ -709,6 +733,7 @@ var RealCount: integer;
Result:=-2; exit;
end;
if OnCompare(ANode.Left.Data,ANode.Data)>0 then begin
writeln('CCC-3 ',HexStr(Cardinal(ANode.Data),8),' ',HexStr(Cardinal(ANode.Left.Data),8));
Result:=-3; exit;
end;
Result:=CheckNode(ANode.Left);
@ -720,6 +745,7 @@ var RealCount: integer;
Result:=-4; exit;
end;
if OnCompare(ANode.Data,ANode.Right.Data)>0 then begin
writeln('CCC-5 ',HexStr(Cardinal(ANode.Data),8),' ',HexStr(Cardinal(ANode.Right.Data),8));
Result:=-5; exit;
end;
Result:=CheckNode(ANode.Right);

11
components/codetools/finddeclarationcache.pas
View File

@ -168,6 +168,17 @@ type
destructor Destroy; override;
end;
{
4. CodeTool Cache Dependencies
Node- and BaseTypeCache depends on their codetool and the
node- and basetypecaches of other codetools (=used codetools). The used
codetools dependencies are saved in the TCodeToolDependencies, which is
simple an TAVLTree of codetools. This allows to decide, wether the cache of
a codetools must be rebuild.
}
//----------------------------------------------------------------------------
type

123
components/codetools/finddeclarationtool.pas
View File

@ -258,6 +258,9 @@ type
FLastNodeCachesGlobalWriteLockStep: integer;
FRootNodeCache: TCodeTreeNodeCache;
FFirstBaseTypeCache: TBaseTypeCache;
FDependentCodeTools: TAVLTree;// the codetools, that depend on this codetool
FDependsOnCodeTools: TAVLTree;// the codetools, that this codetool depends on
FClearingDependentNodeCaches: boolean;
{$IFDEF CTDEBUG}
DebugPrefix: string;
procedure IncPrefix;
@ -295,6 +298,9 @@ type
protected
procedure DoDeleteNodes; override;
procedure ClearNodeCaches(Force: boolean);
procedure ClearDependentNodeCaches;
procedure ClearDependsOnToolRelationships;
procedure AddToolDependency(DependOnTool: TFindDeclarationTool);
function CreateNewNodeCache(Node: TCodeTreeNode): TCodeTreeNodeCache;
function CreateNewBaseTypeCache(Node: TCodeTreeNode): TBaseTypeCache;
procedure CreateBaseTypeCaches(NodeStack: PCodeTreeNodeStack;
@ -370,7 +376,6 @@ type
read FOnGetCodeToolForBuffer write FOnGetCodeToolForBuffer;
property OnGetUnitSourceSearchPath: TOnGetSearchPath
read FOnGetUnitSourceSearchPath write FOnGetUnitSourceSearchPath;
procedure ActivateGlobalWriteLock; override;
function ConsistencyCheck: integer; override;
end;
@ -2875,9 +2880,8 @@ begin
// ToDo: build codetree for ppu, ppw, dcu files
// build tree for pascal source
ClearNodeCaches(false);
BuildTree(true);
// search identifier in cache
if FInterfaceIdentifierCache<>nil then begin
CacheEntry:=FInterfaceIdentifierCache.FindIdentifier(Params.Identifier);
@ -2936,7 +2940,7 @@ begin
FInterfaceIdentifierCache.Add(OldInput.Identifier,Params.NewNode,
Params.NewCleanPos);
end else begin
// do not save proc identifiers.
// do not save proc identifiers
end;
end else
// identifier does not exist in interface
@ -3017,6 +3021,7 @@ begin
Params.Flags:=[fdfIgnoreUsedUnits]+(fdfGlobalsSameIdent*Params.Flags)
-[fdfExceptionOnNotFound];
Result:=NewCodeTool.FindIdentifierInInterface(Self,Params);
AddToolDependency(NewCodeTool);
if Result then
// do not reload param input, so that find next is possible
exit
@ -3990,6 +3995,10 @@ destructor TFindDeclarationTool.Destroy;
begin
FInterfaceIdentifierCache.Free;
FInterfaceIdentifierCache:=nil;
FDependsOnCodeTools.Free;
FDependsOnCodeTools:=nil;
FDependentCodeTools.Free;
FDependentCodeTools:=nil;
inherited Destroy;
end;
@ -4000,21 +4009,26 @@ var
GlobalWriteLockStep: integer;
BaseTypeCache: TBaseTypeCache;
begin
if not Force then begin
// check if node cache must be cleared
if Assigned(OnGetGlobalWriteLockInfo) then begin
OnGetGlobalWriteLockInfo(GlobalWriteLockIsSet,GlobalWriteLockStep);
if GlobalWriteLockIsSet then begin
// The global write lock is set. That means, input variables and code
// are frozen
if (FLastNodeCachesGlobalWriteLockStep=GlobalWriteLockStep) then begin
// source and values did not change since last UpdateNeeded check
exit;
end else begin
// this is the first check in this GlobalWriteLockStep
FLastNodeCachesGlobalWriteLockStep:=GlobalWriteLockStep;
// proceed normally ...
end;
// clear dependent codetools
ClearDependentNodeCaches;
ClearDependsOnToolRelationships;
// check if there is something cached
if (FFirstNodeCache=nil) and (FFirstBaseTypeCache=nil)
and (FRootNodeCache=nil) then
exit;
// quick check: check if in the same GlobalWriteLockStep
if (not Force) and Assigned(OnGetGlobalWriteLockInfo) then begin
OnGetGlobalWriteLockInfo(GlobalWriteLockIsSet,GlobalWriteLockStep);
if GlobalWriteLockIsSet then begin
// The global write lock is set. That means, input variables and code
// are frozen
if (FLastNodeCachesGlobalWriteLockStep=GlobalWriteLockStep) then begin
// source and values did not change since last UpdateNeeded check
exit;
end else begin
// this is the first check in this GlobalWriteLockStep
FLastNodeCachesGlobalWriteLockStep:=GlobalWriteLockStep;
// proceed normally ...
end;
end;
end;
@ -4035,6 +4049,57 @@ begin
end;
end;
procedure TFindDeclarationTool.ClearDependentNodeCaches;
var
ANode: TAVLTreeNode;
ATool: TFindDeclarationTool;
begin
if (FDependentCodeTools=nil) or FClearingDependentNodeCaches then exit;
FClearingDependentNodeCaches:=true;
try
ANode:=FDependentCodeTools.FindLowest;
while ANode<>nil do begin
ATool:=TFindDeclarationTool(ANode.Data);
ATool.ClearNodeCaches(true);
ANode:=FDependentCodeTools.FindSuccessor(ANode);
end;
FDependentCodeTools.Clear;
finally
FClearingDependentNodeCaches:=false;
end;
end;
procedure TFindDeclarationTool.ClearDependsOnToolRelationships;
var
ANode: TAVLTreeNode;
ATool: TFindDeclarationTool;
begin
if FDependsOnCodeTools=nil then exit;
ANode:=FDependsOnCodeTools.FindLowest;
while ANode<>nil do begin
ATool:=TFindDeclarationTool(ANode.Data);
if not ATool.FClearingDependentNodeCaches then
ATool.FDependentCodeTools.Remove(Self);
ANode:=FDependsOnCodeTools.FindSuccessor(ANode);
end;
FDependsOnCodeTools.Clear;
end;
procedure TFindDeclarationTool.AddToolDependency(
DependOnTool: TFindDeclarationTool);
// this tool depends on DependOnTool
begin
if DependOnTool.FDependentCodeTools=nil then
DependOnTool.FDependentCodeTools:=TAVLTree.Create;
if DependOnTool.FDependentCodeTools.Find(Self)=nil then
DependOnTool.FDependentCodeTools.Add(Self);
if FDependsOnCodeTools=nil then
FDependsOnCodeTools:=TAVLTree.Create;
if FDependsOnCodeTools.Find(DependOnTool)=nil then begin
FDependsOnCodeTools.Add(DependOnTool);
end;
end;
function TFindDeclarationTool.ConsistencyCheck: integer;
var ANodeCache: TCodeTreeNodeCache;
begin
@ -4052,12 +4117,20 @@ begin
end;
ANodeCache:=ANodeCache.Next;
end;
end;
procedure TFindDeclarationTool.ActivateGlobalWriteLock;
begin
inherited;
ClearNodeCaches(false);
if FDependentCodeTools<>nil then begin
Result:=FDependentCodeTools.ConsistencyCheck;
if Result<>0 then begin
dec(Result,200);
exit;
end;
end;
if FDependsOnCodeTools<>nil then begin
Result:=FDependsOnCodeTools.ConsistencyCheck;
if Result<>0 then begin
dec(Result,300);
exit;
end;
end;
end;
function TFindDeclarationTool.GetNodeCache(Node: TCodeTreeNode;

118
ide/findreplacedialog.pp
View File

@ -1,4 +1,11 @@
{ $Id$ }
{
/***************************************************************************
findreplacedialog.pp
--------------------
***************************************************************************/
Author: Mattias Gaertner
Abstract:
@ -73,6 +80,7 @@ type
procedure OkButtonClick(Sender:TObject);
procedure ReplaceAllButtonClick(Sender:TObject);
procedure CancelButtonClick(Sender:TObject);
procedure FormResize(Sender: TObject);
property Options:TSynSearchOptions read GetOptions write SetOptions;
property FindText:AnsiString read GetFindText write SetFindText;
property ReplaceText:AnsiString read GetReplaceText write SetReplaceText;
@ -96,9 +104,9 @@ begin
inherited Create(TheOwner);
if LazarusResources.Find(ClassName)=nil then begin
Caption:='';
Width:=317;
Width:=400;
Height:=285;
{$IFDEF DeleteMeWhenComboBoxFocusIsFixed}
TextToFindComboBox:=TEdit.Create(Self);
{$ELSE}
@ -316,8 +324,11 @@ begin
OnClick:=@CancelButtonClick;
Visible:=true;
end;
OnResize:=@FormResize;
end;
fReplaceAllClickedLast:=false;
FormResize(Self);
TextToFindComboBox.SetFocus;
end;
@ -363,6 +374,109 @@ begin
ModalResult:=mrCancel;
end;
procedure TLazFindReplaceDialog.FormResize(Sender: TObject);
var MaxX, TxtLabelWidth, OptionsWidth, ButtonWidth: integer;
begin
TxtLabelWidth:=100;
MaxX:=ClientWidth;
OptionsWidth:=(MaxX-3*4) div 2;
ButtonWidth:=90;
with TextToFindLabel do begin
Left:=8;
Top:=8;
Width:=TxtLabelWidth;
end;
with TextToFindComboBox do begin
Left:=TextToFindLabel.Left+TextToFindLabel.Width+2;
Top:=TextToFindLabel.Top-4;
Width:=MaxX-Left-4;
end;
with ReplaceWithLabel do begin
Left:=TextToFindLabel.Left;
Top:=TextToFindLabel.Top+TextToFindLabel.Height+8;
Width:=TextToFindLabel.Width;
end;
with ReplaceTextComboBox do begin
Left:=TextToFindComboBox.Left;
Top:=ReplaceWithLabel.Top-4;
Width:=MaxX-Left-4;
end;
with OptionsGroupBox do begin
Left:=4;
Top:=ReplaceWithLabel.Top+ReplaceWithLabel.Height+3;
Width:=OptionsWidth;
Height:=110;
end;
with CaseSensitiveCheckBox do begin
Left:=8;
Top:=3;
Width:=Parent.ClientWidth-Left;
end;
with WholeWordsOnlyCheckBox do begin
Left:=8;
Top:=CaseSensitiveCheckBox.Top+CaseSensitiveCheckBox.Height+5;
Width:=Parent.ClientWidth-Left;
end;
with RegularExpressionsCheckBox do begin
Left:=8;
Top:=WholeWordsOnlyCheckBox.Top+WholeWordsOnlyCheckBox.Height+5;
Width:=Parent.ClientWidth-Left;
end;
with PromptOnReplaceCheckBox do begin
Left:=8;
Top:=RegularExpressionsCheckBox.Top+RegularExpressionsCheckBox.Height+5;
Width:=Parent.ClientWidth-Left;
end;
with OriginRadioGroup do begin
Left:=OptionsGroupBox.Left+OptionsGroupBox.Width+4;
Top:=OptionsGroupBox.Top;
Width:=OptionsWidth;
Height:=OptionsGroupBox.Height;
end;
with ScopeRadioGroup do begin
Left:=OptionsGroupBox.Left;
Top:=OptionsGroupBox.Top+OptionsGroupBox.Height+5;
Width:=OptionsWidth;
Height:=65;
end;
with DirectionRadioGroup do begin
Left:=OriginRadioGroup.Left;
Top:=OriginRadioGroup.Top+OriginRadioGroup.Height+5;
Width:=OptionsWidth;
Height:=65;
end;
with OkButton do begin
Left:=MaxX-10-3*(ButtonWidth+7);
Top:=245;
Width:=75;
end;
with ReplaceAllButton do begin
Left:=MaxX-10-2*(ButtonWidth+7);
Top:=245;
Width:=75;
end;
with CancelButton do begin
Left:=MaxX-10-1*(ButtonWidth+7);
Top:=245;
Width:=75;
end;
end;
function TLazFindReplaceDialog.GetComponentText(c: TFindDlgComponent): string;
begin
case c of

9
lcl/include/buttoncontrol.inc
View File

@ -1,9 +1,9 @@
// included by stdctrls.pp
function TButtonControl.GetChecked: Boolean;
begin
GetChecked := False;
GetChecked := False;
end;
procedure TButtonControl.SetChecked(Value: Boolean);
@ -14,8 +14,9 @@ end;
constructor TButtonControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
inherited Create(AOwner);
end;
{------------------------------------------------------------------------------}
// included by stdctrls.pp

6
lcl/include/customcheckbox.inc
View File

@ -1,3 +1,5 @@
// included by stdctrls.pp
{******************************************************************************
TCustomCheckbox
******************************************************************************}
@ -153,6 +155,9 @@ end;
{
$Log$
Revision 1.3 2002/04/02 16:44:41 lazarus
MG: bugfixes, finddeclaration cache dependencies
Revision 1.2 2002/02/08 16:45:09 lazarus
MG: added codetools options
@ -190,4 +195,5 @@ end;
stoppok
}
// included by stdctrls.pp