paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-13 17:59:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: implemented scanning units in smaller chunks and successive scanning without deleting nodes

Browse Source 
git-svn-id: trunk@29769 -
This commit is contained in:
mattias 2011-03-09 20:52:44 +00:00
parent 3c8976718d
commit 77566ccf65
17 changed files with 914 additions and 432 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
components/codetools/codecompletiontool.pas
View File

@ -223,7 +223,7 @@ type
var NewPos: TCodeXYPosition; var NewTopLine: integer;
SourceChangeCache: TSourceChangeCache): boolean;
protected
procedure DoDeleteNodes; override;
procedure DoDeleteNodes(StartNode: TCodeTreeNode); override;
property CodeCompleteClassNode: TCodeTreeNode
read FCodeCompleteClassNode write SetCodeCompleteClassNode;
property CodeCompleteSrcChgCache: TSourceChangeCache
@ -455,13 +455,13 @@ var
Pos2: Integer;
begin
//DebugLn(['TCodeCompletionCodeTool.CheckWholeUnitParsed ',EndOfSourceFound,' LastErrorMessage="',LastErrorMessage,'" LastErrorCurPos=',dbgs(LastErrorCurPos)]);
if EndOfSourceFound and (not LastErrorValid) then exit;
if (ScannedRange=lsrEnd) and (not LastErrorValid) then exit;
Pos1:=0;
Pos2:=0;
if Node1<>nil then Pos1:=Node1.StartPos;
if Node2<>nil then Pos2:=Node2.StartPos;
ClearIgnoreErrorAfter;
BuildTree(false); // parse whole unit
BuildTree(lsrEnd); // parse whole unit
if Node1<>nil then Node1:=FindDeepestNodeAtPos(Pos1,true);
if Node2<>nil then Node2:=FindDeepestNodeAtPos(Pos2,true);
end;
@ -2243,7 +2243,7 @@ const
begin
Result:=false;
// reparse code and find jump point into new proc
BuildTree(false);
BuildTree(lsrEnd);
NewProcNode:=FindSubProcPath(SubProcPath,ShortProcFormat,true);
{$IFDEF CTDebug}
DebugLn('TCodeCompletionCodeTool.CompleteProcByCall A found=',dbgs(NewProcNode<>nil));
@ -2347,9 +2347,9 @@ begin
end;
end;
procedure TCodeCompletionCodeTool.DoDeleteNodes;
procedure TCodeCompletionCodeTool.DoDeleteNodes(StartNode: TCodeTreeNode);
begin
inherited DoDeleteNodes;
inherited DoDeleteNodes(StartNode);
FreeClassInsertionList;
end;
@ -2360,8 +2360,7 @@ begin
if (UpperClassName='') or (VarName='') or (VarType='')
or (SourceChangeCache=nil) or (Scanner=nil) then exit;
// find classnode
BuildTree(false);
if not EndOfSourceFound then exit;
BuildTree(lsrImplementationStart);
// initialize class for code completion
CodeCompleteClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
CodeCompleteSrcChgCache:=SourceChangeCache;
@ -2430,7 +2429,7 @@ var
begin
Result:=false;
TreeOfCodeTreeNodeExt:=nil;
BuildTree(true);
BuildTree(lsrImplementationStart);
AllNodes:=TAVLTree.Create(@CompareCodeTreeNodeExt);
try
@ -2831,7 +2830,7 @@ var
begin
Result:=false;
TreeOfCodeTreeNodeExt:=nil;
BuildTree(true);
BuildTree(lsrImplementationStart);
AllNodes:=TAVLTree.Create(@CompareCodeTreeNodeExt);
try
@ -3184,7 +3183,7 @@ begin
TreeOfCodeTreeNodeExt:=nil;
try
BuildTree(false);
BuildTree(lsrImplementationStart);
// first step: find all unit identifiers (excluding implementation section)
if not GatherUnitDefinitions(Definitions,true,true) then exit;
@ -3434,7 +3433,7 @@ begin
Result:=false;
TreeOfCodeTreeNodeExt:=nil;
try
BuildTree(false);
BuildTree(lsrImplementationStart);
// first step: find all unit identifiers (excluding implementation section)
if not GatherUnitDefinitions(Definitions,true,true) then exit;
@ -4502,7 +4501,10 @@ var
begin
Result:=false;
TreeOfCodeTreeNodeExt:=nil;
BuildTree(OnlyInterface);
if OnlyInterface then
BuildTree(lsrImplementationStart)
else
BuildTree(lsrEnd);
// find all unit identifiers (excluding sub types)
TreeOfCodeTreeNodeExt:=TAVLTree.Create(@CompareCodeTreeNodeExt);
@ -4804,11 +4806,11 @@ begin
Result:=false;
AllEmpty:=false;
if (AClassName<>'') and (CursorPos.Y<1) then begin
BuildTree(false);
BuildTree(lsrEnd);
CursorNode:=FindClassNodeInInterface(AClassName,true,false,true);
CodeCompleteClassNode:=CursorNode;
end else begin
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
CodeCompleteClassNode:=FindClassNode(CursorNode);
end;
@ -5012,8 +5014,8 @@ var
ClassNode: TCodeTreeNode;
begin
Result:=false;
BuildTree(false);
if not EndOfSourceFound then exit;
BuildTree(lsrEnd);
if ScannedRange<>lsrEnd then exit;
if (SourceChangeCache=nil) or (Scanner=nil) then exit;
ClassNode:=FindClassNodeInUnit(UpperClassName,true,false,false,true);
if (ClassNode=nil) then exit;
@ -6936,7 +6938,7 @@ begin
// -> find it and jump to
// reparse code
BuildTreeAndGetCleanPos(trAll,OldCodeXYPos,CleanPos,[]);
BuildTreeAndGetCleanPos(OldCodeXYPos,CleanPos);
// find CodeTreeNode at cursor
CursorNode:=FindDeepestNodeAtPos(CleanPos,true);
// due to insertions in front of the class, the cursor position could
@ -6978,7 +6980,7 @@ begin
Result:=false;
if (SourceChangeCache=nil) then
RaiseException('need a SourceChangeCache');
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos]);
OldCleanCursorPos:=CleanCursorPos;
NewPos:=CleanCodeXYPosition;
@ -7079,7 +7081,7 @@ begin
NewTopLine:=0;
if (SourceChangeCache=nil) then
RaiseException('need a SourceChangeCache');
BuildTreeAndGetCleanPos(trAll,CursorPos, CleanCursorPos,[]);
BuildTreeAndGetCleanPos(CursorPos, CleanCursorPos);
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
CodeCompleteSrcChgCache:=SourceChangeCache;
@ -7150,7 +7152,7 @@ begin
exit;
end;
// parse unit
NewCodeTool.BuildTreeAndGetCleanPos(trAll,CodeXYPos,CleanCursorPos,[]);
NewCodeTool.BuildTreeAndGetCleanPos(CodeXYPos,CleanCursorPos);
// find node at position
ProcNode:=NewCodeTool.BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos,true);
if (ProcNode.Desc<>ctnProcedure)
@ -7206,7 +7208,7 @@ begin
DeactivateGlobalWriteLock;
end;
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
// find node at position
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);

2
components/codetools/codetemplatestool.pas
View File

@ -261,7 +261,7 @@ var
begin
Result:=false;
ProcHead:='';
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,[]);
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,[]);
ANode:=FindDeepestNodeAtPos(CleanCursorPos,True);
while (ANode<>nil) and (ANode.Desc<>ctnProcedure) do
ANode:=ANode.Parent;

14
components/codetools/codetree.pas
View File

@ -231,6 +231,8 @@ type
function Next: TCodeTreeNode;
function NextSkipChilds: TCodeTreeNode;
function Prior: TCodeTreeNode;
function GetRoot: TCodeTreeNode;
function ChildCount: integer;
function HasAsParent(Node: TCodeTreeNode): boolean;
function HasAsChild(Node: TCodeTreeNode): boolean;
function HasParentOfType(ParentDesc: TCodeTreeNodeDesc): boolean;
@ -241,8 +243,6 @@ type
function GetFindContextParent: TCodeTreeNode;
function GetLevel: integer;
function DescAsString: string;
function GetRoot: TCodeTreeNode;
function ChildCount: integer;
function FindOwner: TObject;
procedure Clear;
constructor Create;
@ -817,18 +817,15 @@ begin
end;
procedure TCodeTree.Clear;
var ANode: TCodeTreeNode;
begin
while Root<>nil do begin
ANode:=Root;
Root:=ANode.NextBrother;
DeleteNode(ANode);
end;
while Root<>nil do
DeleteNode(Root);
end;
procedure TCodeTree.DeleteNode(ANode: TCodeTreeNode);
begin
if ANode=nil then exit;
if ANode=Root then Root:=ANode.NextBrother;
while (ANode.FirstChild<>nil) do DeleteNode(ANode.FirstChild);
with ANode do begin
if (Parent<>nil) then begin
@ -843,7 +840,6 @@ begin
NextBrother:=nil;
PriorBrother:=nil;
end;
if ANode=Root then Root:=nil;
dec(FNodeCount);
ANode.Clear; // clear to spot dangling pointers early
ANode.Free;

234
components/codetools/customcodetool.pas
View File

@ -56,7 +56,6 @@ type
ctpTool
);
type
TCustomCodeTool = class;
@ -135,7 +134,6 @@ type
TCustomCodeTool = class(TObject)
private
FLastProgressPos: integer;
FLastScannerChangeStep: integer;
FNodesDeletedChangeStep: integer;
FOnGetGlobalWriteLockInfo: TOnGetWriteLockInfo;
FOnParserProgress: TOnParserProgress;
@ -145,14 +143,16 @@ type
FTreeChangeStep: integer;
FNodeParseErrors: TAVLTree; // tree of TCodeTreeNodeParseError
protected
FLastScannerChangeStep: integer;
FIgnoreErrorAfter: TCodePosition;
KeyWordFuncList: TKeyWordFunctionList;
WordIsKeyWordFuncList: TKeyWordFunctionList;
FForceUpdateNeeded: boolean;
FRangeValidTill: TLinkScannerRange;
function DefaultKeyWordFunc: boolean;
procedure BuildDefaultKeyWordFunctions; virtual;
procedure SetScanner(NewScanner: TLinkScanner); virtual;
procedure DoDeleteNodes; virtual;
procedure DoDeleteNodes(StartNode: TCodeTreeNode); virtual;
procedure CloseUnfinishedNodes;
procedure RaiseIdentExpectedButAtomFound;
procedure RaiseBracketOpenExpectedButAtomFound;
procedure RaiseBracketCloseExpectedButAtomFound;
@ -162,18 +162,17 @@ type
protected
LastErrorMessage: string;
LastErrorCurPos: TAtomPosition;
LastErrorPhase: TCodeToolPhase;
LastErrorValid: boolean;
LastErrorBehindIgnorePosition: boolean;
LastErrorCheckedForIgnored: boolean;
LastErrorNicePosition: TCodeXYPosition;
CurrentPhase: TCodeToolPhase;
procedure ClearLastError;
procedure RaiseLastError;
procedure DoProgress; inline;
procedure NotifyAboutProgress;
// dirty/dead source
procedure LoadDirtySource(const CursorPos: TCodeXYPosition);
procedure FetchScannerSource(Range: TLinkScannerRange); virtual;
public
Tree: TCodeTree;
@ -235,9 +234,13 @@ type
function FindLineEndOrCodeInFrontOfPosition(StartPos: integer;
StopAtDirectives: boolean = true; SkipEmptyLines: boolean = false): integer;
function UpdateNeeded(OnlyInterfaceNeeded: boolean): boolean;
procedure BeginParsing(DeleteNodes, OnlyInterfaceNeeded: boolean); virtual;
procedure BeginParsingAndGetCleanPos(DeleteNodes,
function UpdateNeeded(Range: TLinkScannerRange): boolean;
function UpdateNeeded(OnlyInterfaceNeeded: boolean): boolean; deprecated;
procedure BeginParsing(Range: TLinkScannerRange); virtual;
procedure BeginParsingAndGetCleanPos(
Range: TLinkScannerRange; CursorPos: TCodeXYPosition;
out CleanCursorPos: integer);
procedure BeginParsingAndGetCleanPosOLD(
OnlyInterfaceNeeded: boolean; CursorPos: TCodeXYPosition;
out CleanCursorPos: integer);
function IsDirtySrcValid: boolean;
@ -395,7 +398,6 @@ begin
IndentSize:=2;
VisibleEditorLines:=20;
CursorBeyondEOL:=true;
FForceUpdateNeeded:=false;
Clear;
end;
@ -411,7 +413,7 @@ end;
procedure TCustomCodeTool.Clear;
begin
if Tree<>nil then DoDeleteNodes;
if Tree<>nil then DoDeleteNodes(Tree.Root);
CurPos:=StartAtomPosition;
LastAtoms.Clear;
NextPos.StartPos:=-1;
@ -435,7 +437,6 @@ procedure TCustomCodeTool.SaveRaiseException(const AMessage: string;
begin
LastErrorMessage:=AMessage;
LastErrorCurPos:=CurPos;
LastErrorPhase:=CurrentPhase;
LastErrorValid:=true;
if ClearNicePos then begin
LastErrorNicePosition.Code:=nil;
@ -472,7 +473,6 @@ end;
procedure TCustomCodeTool.ClearLastError;
begin
LastErrorPhase:=ctpNone;
LastErrorValid:=false;
LastErrorCheckedForIgnored:=false;
LastErrorNicePosition.Code:=nil;
@ -483,7 +483,6 @@ procedure TCustomCodeTool.RaiseLastError;
begin
MoveCursorToCleanPos(LastErrorCurPos.StartPos);
CurPos:=LastErrorCurPos;
CurrentPhase:=LastErrorPhase;
ErrorNicePosition:=LastErrorNicePosition;
SaveRaiseException(LastErrorMessage,false);
end;
@ -501,9 +500,6 @@ begin
if Assigned(OnParserProgress) then begin
if OnParserProgress(Self) then exit;
// abort the parsing process
// mark parsing results as invalid
FForceUpdateNeeded:=true;
// raise the abort exception to stop the parsing
RaiseExceptionClass('Abort',EParserAbort,true);
end;
@ -543,6 +539,31 @@ begin
DirtySrc.SetGap(CursorPos,NewDirtyStartPos,NewDirtyGapStart,NewDirtyGapEnd);
end;
procedure TCustomCodeTool.FetchScannerSource(Range: TLinkScannerRange);
begin
// update scanned code
if FLastScannerChangeStep=Scanner.ChangeStep then begin
if LastErrorValid then
RaiseLastError;
end else begin
// code has changed
FLastScannerChangeStep:=Scanner.ChangeStep;
ClearLastError;
Src:=Scanner.CleanedSrc;
SrcLen:=length(Src);
{$IFDEF VerboseUpdateNeeded}
DebugLn(['TCustomCodeTool.BeginParsing ',MainFilename]);
{$ENDIF}
FRangeValidTill:=lsrInit;
DirtySrc.Free;
DirtySrc:=nil;
end;
// delete nodes
if Tree<>nil then
DoDeleteNodes(Tree.Root);
end;
procedure TCustomCodeTool.RaiseUndoImpossible;
begin
RaiseException('TCustomCodeTool.UndoReadNextAtom impossible',true);
@ -559,9 +580,9 @@ begin
Scanner.SetIgnoreErrorAfter(IgnoreErrorAfter.P,IgnoreErrorAfter.Code);
end;
{$IFDEF VerboseUpdateNeeded}
DebugLn(['TCustomCodeTool.SetScanner FForceUpdateNeeded:=true ',MainFilename]);
DebugLn(['TCustomCodeTool.SetScanner ',MainFilename]);
{$ENDIF}
FForceUpdateNeeded:=true;
FRangeValidTill:=lsrNone;
end;
function TCustomCodeTool.NodeDescToStr(Desc: integer): string;
@ -1799,58 +1820,26 @@ begin
{$IFDEF RangeChecking}{$R+}{$UNDEF RangeChecking}{$ENDIF}
end;
procedure TCustomCodeTool.BeginParsing(DeleteNodes,
OnlyInterfaceNeeded: boolean);
var
LinkScanRange: TLinkScannerRange;
procedure TCustomCodeTool.BeginParsing(Range: TLinkScannerRange);
begin
// scan
FLastProgressPos:=0;
CurrentPhase:=ctpScan;
try
if OnlyInterfaceNeeded then
LinkScanRange:=lsrImplementationStart
else
LinkScanRange:=lsrEnd;
Scanner.Scan(LinkScanRange,CheckFilesOnDisk);
// update scanned code
if FLastScannerChangeStep<>Scanner.ChangeStep then begin
// code has changed
ClearLastError;
FLastScannerChangeStep:=Scanner.ChangeStep;
Src:=Scanner.CleanedSrc;
SrcLen:=length(Src);
{$IFDEF VerboseUpdateNeeded}
DebugLn(['TCustomCodeTool.BeginParsing FForceUpdateNeeded:=true ',MainFilename]);
{$ENDIF}
FForceUpdateNeeded:=true;
DirtySrc.Free;
DirtySrc:=nil;
end else begin
if LastErrorPhase=ctpScan then
RaiseLastError;
end;
// delete nodes
if DeleteNodes then DoDeleteNodes;
// init parsing values
CurPos:=StartAtomPosition;
LastAtoms.Clear;
NextPos.StartPos:=-1;
CurNode:=nil;
finally
CurrentPhase:=ctpNone;
end;
Scanner.Scan(Range,CheckFilesOnDisk);
FetchScannerSource(Range);
// init parsing values
CurPos:=StartAtomPosition;
LastAtoms.Clear;
NextPos.StartPos:=-1;
CurNode:=nil;
end;
procedure TCustomCodeTool.BeginParsingAndGetCleanPos(DeleteNodes,
OnlyInterfaceNeeded: boolean; CursorPos: TCodeXYPosition;
out CleanCursorPos: integer);
var Dummy: integer;
procedure TCustomCodeTool.BeginParsingAndGetCleanPos(Range: TLinkScannerRange;
CursorPos: TCodeXYPosition; out CleanCursorPos: integer);
var
Dummy: integer;
begin
if UpdateNeeded(OnlyInterfaceNeeded) then
BeginParsing(DeleteNodes,OnlyInterfaceNeeded);
if UpdateNeeded(Range) then
BeginParsing(Range);
// find the CursorPos in cleaned source
Dummy:=CaretToCleanPos(CursorPos, CleanCursorPos);
if (Dummy<>0) and (Dummy<>-1) then begin
@ -1859,6 +1848,19 @@ begin
end;
end;
procedure TCustomCodeTool.BeginParsingAndGetCleanPosOLD(
OnlyInterfaceNeeded: boolean; CursorPos: TCodeXYPosition;
out CleanCursorPos: integer);
var
Range: TLinkScannerRange;
begin
if OnlyInterfaceNeeded then
Range:=lsrImplementationStart
else
Range:=lsrEnd;
BeginParsingAndGetCleanPos(Range,CursorPos,CleanCursorPos);
end;
function TCustomCodeTool.IsDirtySrcValid: boolean;
begin
Result:=(DirtySrc<>nil) and (DirtySrc.Code<>nil);
@ -1878,7 +1880,7 @@ begin
IgnoreErrorAfterCleanPos:=Scanner.IgnoreErrorAfterCleanedPos;
//DebugLn([' IgnoreErrorAfterCleanPos=',IgnoreErrorAfterCleanPos,' "',copy(Src,IgnoreErrorAfterCleanPos-6,6),'"',
// ' LastErrorCurPos.StartPos=',LastErrorCurPos.StartPos,' "',copy(Src,LastErrorCurPos.StartPos-6,6),'"',
// ' LastErrorPhase>CodeToolPhaseParse=',LastErrorPhase>CodeToolPhaseParse]);
// ' ']);
if IgnoreErrorAfterCleanPos>0 then begin
// ignore position in scanned code
// -> check if last error is behind or equal ignore position
@ -1929,7 +1931,7 @@ begin
if (Scanner<>nil) and Scanner.LastErrorIsInFrontOfCleanedPos(ACleanedPos)
then
Result:=true
else if (LastErrorValid)
else if LastErrorValid
and (LastErrorCurPos.StartPos<ACleanedPos) then
Result:=true
else
@ -1946,7 +1948,7 @@ begin
DebugLn('TCustomCodeTool.RaiseLastErrorIfInFrontOfCleanedPos A ACleanedPos=',dbgs(ACleanedPos));
{$ENDIF}
if Scanner<>nil then Scanner.RaiseLastErrorIfInFrontOfCleanedPos(ACleanedPos);
//DebugLn('TCustomCodeTool.RaiseLastErrorIfInFrontOfCleanedPos B ',LastErrorPhase<CodeToolPhaseTool,' ',LastErrorCurPos.EndPos);
//DebugLn('TCustomCodeTool.RaiseLastErrorIfInFrontOfCleanedPos B ',LastErrorCurPos.EndPos);
if LastErrorValid
and (LastErrorCurPos.StartPos<ACleanedPos) then
RaiseLastError;
@ -2204,11 +2206,11 @@ begin
if (ctnsNeedJITParsing and Node.SubDesc)>0 then begin
SetNodeParserError(Node,TheException.Message,CurPos.StartPos,
ErrorNicePosition);
break;
end;
if (Node.StartPos>=Node.EndPos) then
Node.EndPos:=CursorPos;
Node:=Node.Parent;
end;
CloseUnfinishedNodes;
// convert cursor pos to caret pos, which is more human readable
if (CursorPos>SrcLen) and (SrcLen>0) then CursorPos:=SrcLen;
if (CleanPosToCaret(CursorPos,CaretXY))
@ -2219,7 +2221,6 @@ begin
ErrorPosition.Y:=-1;
end;
// raise the exception
CurrentPhase:=ctpNone;
if not RaiseUnhandableExceptions then
raise TheException
else
@ -2633,14 +2634,16 @@ begin
IgnoreErrorAfter:=CodePosition(0,nil);
end;
function TCustomCodeTool.UpdateNeeded(OnlyInterfaceNeeded: boolean): boolean;
var
LinkScanRange: TLinkScannerRange;
function TCustomCodeTool.UpdateNeeded(Range: TLinkScannerRange): boolean;
begin
{$IFDEF CTDEBUG}
DebugLn('TCustomCodeTool.UpdateNeeded A ',dbgs(Scanner<>nil),' FForceUpdateNeeded=',dbgs(FForceUpdateNeeded));
{$ENDIF}
if FForceUpdateNeeded then begin
if Range=lsrNone then exit(false);
if ord(FRangeValidTill)<ord(Range) then begin
{$IFDEF VerboseUpdateNeeded}
DebugLn(['TCustomCodeTool.UpdateNeeded because range increased from ',dbgs(FRangeValidTill),' to ',dbgs(Range),' ',MainFilename]);
{$ENDIF}
Result:=true;
exit;
end;
@ -2648,24 +2651,31 @@ begin
{$IFDEF VerboseUpdateNeeded}
DebugLn(['TCustomCodeTool.UpdateNeeded because FLastScannerChangeStep<>Scanner.ChangeStep ',MainFilename]);
{$ENDIF}
FRangeValidTill:=lsrNone;
Result:=true;
end else begin
if OnlyInterfaceNeeded then
LinkScanRange:=lsrImplementationStart
else
LinkScanRange:=lsrEnd;
Result:=Scanner.UpdateNeeded(LinkScanRange, CheckFilesOnDisk);
{$IFDEF VerboseUpdateNeeded}
if Result then
Result:=Scanner.UpdateNeeded(Range, CheckFilesOnDisk);
if Result then begin
{$IFDEF VerboseUpdateNeeded}
DebugLn(['TCustomCodeTool.UpdateNeeded because Scanner.UpdateNeeded ',MainFilename]);
{$ENDIF}
{$ENDIF}
// decrease valid range
FRangeValidTill:=Pred(Range);
end;
end;
FForceUpdateNeeded:=Result;
{$IFDEF CTDEBUG}
DebugLn('TCustomCodeTool.UpdateNeeded END Result=',dbgs(Result));
{$ENDIF}
end;
function TCustomCodeTool.UpdateNeeded(OnlyInterfaceNeeded: boolean): boolean;
begin
if OnlyInterfaceNeeded then
Result:=UpdateNeeded(lsrImplementationStart)
else
Result:=UpdateNeeded(lsrEnd);
end;
function TCustomCodeTool.CompareSrcIdentifiers(Identifier1, Identifier2: PChar
): boolean;
begin
@ -2722,15 +2732,61 @@ begin
Result:='';
end;
procedure TCustomCodeTool.DoDeleteNodes;
procedure TCustomCodeTool.DoDeleteNodes(StartNode: TCodeTreeNode);
// delete Node and all following nodes
var
AVLNode: TAVLTreeNode;
NextAVLNode: TAVLTreeNode;
Node: TCodeTreeNode;
begin
if Tree.Root<>nil then begin
if StartNode<>nil then begin
//debugln(['TCustomCodeTool.DoDeleteNodes Node=',StartNode.DescAsString,' ',MainFilename]);
//DebugLn(['TCustomCodeTool.DoDeleteNodes ',MainFilename]);
// first notify, so that references could be deleted clean
IncreaseTreeChangeStep(true);
// then change
Tree.Clear;
DisposeAVLTree(FNodeParseErrors);
// free errors and nodes
if StartNode=Tree.Root then begin
DisposeAVLTree(FNodeParseErrors);
Tree.Clear;
end else begin
if (FNodeParseErrors<>nil) then begin
AVLNode:=FNodeParseErrors.FindLowest;
while AVLNode<>nil do begin
NextAVLNode:=FNodeParseErrors.FindSuccessor(AVLNode);
if TCodeTreeNodeParseError(AVLNode.Data).Node.StartPos>=StartNode.StartPos
then
FNodeParseErrors.FreeAndDelete(AVLNode);
AVLNode:=NextAVLNode;
end;
end;
Node:=StartNode;
repeat
while Node.NextBrother<>nil do
Tree.DeleteNode(Node.NextBrother);
if Node.Parent=nil then break;
Node:=Node.Parent;
until false;
Tree.DeleteNode(StartNode);
end;
end;
end;
procedure TCustomCodeTool.CloseUnfinishedNodes;
begin
// close all unfinished nodes
while CurNode<>nil do begin
if CurNode.EndPos<1 then begin
if CurNode.LastChild<>nil then
CurNode.EndPos:=CurNode.LastChild.EndPos;
if (CurNode.EndPos<1) then begin
if CurNode.StartPos<CurPos.StartPos then
CurNode.EndPos:=CurPos.StartPos
else
CurNode.EndPos:=CurPos.EndPos;
end;
end;
CurNode:=CurNode.Parent;
end;
end;

18
components/codetools/eventcodetool.pas
View File

@ -261,8 +261,7 @@ begin
DebugLn('[TEventsCodeTool.GetCompatiblePublishedMethods] A UpperClassName=',
UpperClassName);
{$ENDIF}
BuildTree(true);
if not InterfaceSectionFound then exit;
BuildTree(lsrImplementationStart);
ClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
{$IFDEF CTDEBUG}
DebugLn('[TEventsCodeTool.GetCompatiblePublishedMethods] B ',dbgs(ClassNode<>nil));
@ -381,7 +380,7 @@ var SectionNode, ANode: TCodeTreeNode;
begin
Result:=nil;
if (UpperMethodName='') or (UpperClassName='') then exit;
if BuildTreeBefore then BuildTree(false);
if BuildTreeBefore then BuildTree(lsrEnd);
// find implementation node
SectionNode:=FindImplementationNode;
if SectionNode=nil then exit;
@ -430,7 +429,7 @@ begin
Tool:=FindCodeToolForUsedUnit(AStartUnitName,'',true);
if not (Tool is TEventsCodeTool) then
RaiseTypeNotFound;
TEventsCodeTool(Tool).BuildTree(true);
TEventsCodeTool(Tool).BuildTree(lsrImplementationStart);
Result:=TEventsCodeTool(Tool).FindMethodTypeInfo(ATypeInfo,'');
exit;
end;
@ -483,8 +482,7 @@ begin
{$IFDEF CTDEBUG}
DebugLn('[TEventsCodeTool.PublishedMethodExists] A UpperClassName=',UpperClassName);
{$ENDIF}
BuildTree(true);
if not InterfaceSectionFound then exit;
BuildTree(lsrImplementationStart);
ClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
{$IFDEF CTDEBUG}
DebugLn('[TEventsCodeTool.PublishedMethodExists] B ',dbgs(ClassNode<>nil));
@ -581,7 +579,7 @@ begin
Result:=false;
ActivateGlobalWriteLock;
try
BuildTree(false);
BuildTree(lsrEnd);
ClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
AFindContext:=FindPublishedMethodNodeInClass(ClassNode,UpperMethodName,true);
if AFindContext.Node=nil then begin
@ -612,7 +610,7 @@ function TEventsCodeTool.RenamePublishedMethod(const UpperClassName,
SourceChangeCache: TSourceChangeCache): boolean;
var ClassNode: TCodeTreeNode;
begin
BuildTree(false);
BuildTree(lsrEnd);
ClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
Result:=RenamePublishedMethod(ClassNode,UpperOldMethodName,NewMethodName,
SourceChangeCache);
@ -692,7 +690,7 @@ function TEventsCodeTool.CreateMethod(const UpperClassName,
var AClassNode: TCodeTreeNode;
begin
Result:=false;
BuildTree(false);
BuildTree(lsrEnd);
AClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
Result:=CreateMethod(AClassNode,AMethodName,ATypeInfo,
APropertyUnitName,APropertyPath,
@ -1037,7 +1035,7 @@ begin
try
Result:=false;
ClearIgnoreErrorAfter;
BuildTree(true);
BuildTree(lsrImplementationStart);
UpperClassName:=UpperCaseStr(AComponent.ClassName);
{$IFDEF CTDEBUG}
DebugLn('[TEventsCodeTool.CompleteComponent] A Component="',AComponent.Name,':',AComponent.ClassName);

4
components/codetools/extractproctool.pas
View File

@ -194,7 +194,7 @@ begin
DebugLn('TExtractProcTool.InitExtractProc syntax and cursor check ..');
{$ENDIF}
// check syntax
BuildTreeAndGetCleanPos(trAll,StartPos,CleanStartPos,[]);
BuildTreeAndGetCleanPos(StartPos,CleanStartPos);
if CaretToCleanPos(EndPos,CleanEndPos)<>0 then exit;
if CleanStartPos>=CleanEndPos then exit;
{$IFDEF CTDebug}
@ -1048,7 +1048,7 @@ var
begin
Result:=false;
// reparse code and find jump point into new proc
BuildTree(false);
BuildTree(lsrEnd);
NewProcNode:=FindSubProcPath(SubProcPath,ShortProcFormat,true);
{$IFDEF CTDebug}
DebugLn('FindJumpPointToNewProc A found=',dbgs(NewProcNode<>nil));

46
components/codetools/finddeclarationtool.pas
View File

@ -618,7 +618,7 @@ type
procedure RaiseStrConstExpected;
protected
// node caches
procedure DoDeleteNodes; override;
procedure DoDeleteNodes(StartNode: TCodeTreeNode); override;
function NodeCacheGlobalWriteLockStepDidNotChange: boolean;
function CheckDependsOnNodeCaches(CheckedTools: TAVLTree = nil): boolean;
procedure ClearNodeCaches(Force: boolean);
@ -750,7 +750,7 @@ type
procedure ConsistencyCheck; override;
procedure CalcMemSize(Stats: TCTMemStats); override;
procedure BeginParsing(DeleteNodes, OnlyInterfaceNeeded: boolean); override;
procedure BeginParsing(Range: TLinkScannerRange); override;
procedure ValidateToolDependencies; override;
function BuildInterfaceIdentifierCache(ExceptionOnNotUnit: boolean): boolean;
function FindDeclaration(const CursorPos: TCodeXYPosition;
@ -1223,8 +1223,8 @@ begin
DebugLn('TFindDeclarationTool.FindDeclarationOfIdentifier A CursorPos=X',dbgs(CursorPos.X),',Y',dbgs(CursorPos.Y));
{$ENDIF}
if DirtySrc<>nil then DirtySrc.Clear;
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos]);
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos]);
{$IFDEF CTDEBUG}
DebugLn('TFindDeclarationTool.FindDeclarationOfIdentifier B CleanCursorPos=',dbgs(CleanCursorPos));
{$ENDIF}
@ -1380,7 +1380,7 @@ var CleanCursorPos: integer;
if Assigned(FOnGetCodeToolForBuffer) then
NewTool:=FOnGetCodeToolForBuffer(Self,ACode,false);
if NewTool=nil then exit;
NewTool.BuildTree(true);
NewTool.BuildTree(lsrSourceName);
if not NewTool.GetSourceNamePos(NamePos) then exit;
NewNode:=NewTool.Tree.Root;
if not NewTool.JumpToCleanPos(NamePos.StartPos,NamePos.StartPos,
@ -1412,7 +1412,7 @@ begin
DebugLn('TFindDeclarationTool.FindDeclaration A CursorPos=X',dbgs(CursorPos.X),',Y',dbgs(CursorPos.Y));
{$ENDIF}
if DirtySrc<>nil then DirtySrc.Clear;
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos,btLoadDirtySource,btCursorPosOutAllowed]);
{$IFDEF CTDEBUG}
DebugLn('TFindDeclarationTool.FindDeclaration C CleanCursorPos=',dbgs(CleanCursorPos));
@ -1571,7 +1571,7 @@ var
begin
Result:=false;
if Identifier='' then exit;
BuildTree(false);
BuildTree(lsrMainUsesSectionEnd);
UsesNode:=FindMainUsesSection;
if UsesNode=nil then exit;
@ -1628,7 +1628,7 @@ begin
ActivateGlobalWriteLock;
Params:=TFindDeclarationParams.Create;
try
BuildTree(false);
BuildTree(lsrEnd);
//DebugLn(['TFindDeclarationTool.FindDeclarationOfPropertyPath ',Src]);
@ -1766,7 +1766,7 @@ var
begin
Result:=nil;
if Identifier='' then exit;
if BuildTheTree then BuildTree(true);
if BuildTheTree then BuildTree(lsrImplementationStart);
if Tree.Root=nil then exit;
if Tree.Root.Desc=ctnUnit then
StartNode:=FindInterfaceNode
@ -1894,7 +1894,7 @@ begin
DebugLn(['TFindDeclarationTool.FindUnitInAllUsesSections invalid AnUnitName']);
exit;
end;
BuildTree(false);
BuildTree(lsrImplementationUsesSectionEnd);
SectionNode:=Tree.Root;
while (SectionNode<>nil) and (SectionNode.Desc in [ctnProgram, ctnUnit,
ctnPackage,ctnLibrary,ctnInterface,ctnImplementation])
@ -3539,7 +3539,7 @@ begin
Params.NewNode:=nil;
Params.NewCodeTool:=FindCodeToolForUnitIdentifier(
NameNode,GetIdentifier(Params.Identifier),true);
Params.NewCodeTool.BuildTree(true);
Params.NewCodeTool.BuildTree(lsrImplementationStart);
Params.NewNode:=Params.NewCodeTool.Tree.Root;
end;
if TypeFound and (Params.NewNode.Desc in [ctnUnit,ctnLibrary,ctnPackage])
@ -3854,7 +3854,7 @@ begin
ActivateGlobalWriteLock;
try
BuildTreeAndGetCleanPos(trTillCursorSection,CursorPos,CleanPos,[]);
BuildTreeAndGetCleanPos(trTillCursorSection,lsrEnd,CursorPos,CleanPos,[]);
NodeList:=TFPList.Create;
NewTool:=Self;
@ -3977,7 +3977,7 @@ begin
ActivateGlobalWriteLock;
try
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos]);
// find class node
@ -4374,8 +4374,7 @@ var
debugln('WARNING: TFindDeclarationTool.FindReferences DeclarationTool=nil');
exit;
end;
DeclarationTool.BuildTreeAndGetCleanPos(trAll,CursorPos,CleanDeclCursorPos,
[]);
DeclarationTool.BuildTreeAndGetCleanPos(CursorPos,CleanDeclCursorPos);
DeclarationNode:=DeclarationTool.BuildSubTreeAndFindDeepestNodeAtPos(
CleanDeclCursorPos,true);
Identifier:=DeclarationTool.ExtractIdentifier(CleanDeclCursorPos);
@ -4515,7 +4514,7 @@ begin
ActivateGlobalWriteLock;
try
BuildTree(false);
BuildTree(lsrEnd);
// find declaration nodes and identifier
if not FindDeclarationNode then exit;
@ -4622,7 +4621,7 @@ begin
ListOfPCodeXYPosition:=nil;
ActivateGlobalWriteLock;
try
BuildTree(false);
BuildTree(lsrEnd);
InterfaceUsesNode:=FindMainUsesSection;
if not CheckUsesSection(InterfaceUsesNode,Found) then exit;
@ -5884,7 +5883,7 @@ var
begin
// build tree for pascal source
//debugln(['TFindDeclarationTool.BuildInterfaceIdentifierCache BEFORE ',MainFilename]);
BuildTree(true);
BuildTree(lsrImplementationStart);
//debugln(['TFindDeclarationTool.BuildInterfaceIdentifierCache AFTER ',MainFilename]);
if Tree.Root=nil then exit;
@ -6101,11 +6100,10 @@ begin
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsStringConstant,GetAtom]);
end;
procedure TFindDeclarationTool.BeginParsing(DeleteNodes,
OnlyInterfaceNeeded: boolean);
procedure TFindDeclarationTool.BeginParsing(Range: TLinkScannerRange);
begin
// scan code and init parser
inherited BeginParsing(DeleteNodes,OnlyInterfaceNeeded);
inherited BeginParsing(Range);
// now the scanner knows, which compiler mode is needed
// -> setup compiler dependent tables
@ -8799,14 +8797,14 @@ begin
Result:=FDirectoryCache<>nil;
end;
procedure TFindDeclarationTool.DoDeleteNodes;
procedure TFindDeclarationTool.DoDeleteNodes(StartNode: TCodeTreeNode);
begin
ClearNodeCaches(true);
if FInterfaceIdentifierCache<>nil then begin
FInterfaceIdentifierCache.Clear;
FInterfaceIdentifierCache.Complete:=false;
end;
inherited DoDeleteNodes;
inherited DoDeleteNodes(StartNode);
end;
function TFindDeclarationTool.NodeCacheGlobalWriteLockStepDidNotChange: boolean;
@ -8868,7 +8866,7 @@ begin
ANode:=FDependsOnCodeTools.FindLowest;
while ANode<>nil do begin
ATool:=TFindDeclarationTool(ANode.Data);
Result:=ATool.UpdateNeeded(true)
Result:=ATool.UpdateNeeded(lsrImplementationStart)
or ATool.CheckDependsOnNodeCaches(CheckedTools);
if Result then exit;
ANode:=FDependsOnCodeTools.FindSuccessor(ANode);

11
components/codetools/identcompletiontool.pas
View File

@ -1719,7 +1719,8 @@ begin
{$IFDEF CTDEBUG}
DebugLn('TIdentCompletionTool.ParseSourceTillCollectionStart A CursorPos=',dbgs(CursorPos.X),',',dbgs(CursorPos.Y),' ',DbgsCXY(IdentStartXYPos));
{$ENDIF}
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,[btSetIgnoreErrorPos]);
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos]);
// find node at position
CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos,true);
@ -2408,8 +2409,8 @@ begin
ActivateGlobalWriteLock;
Params:=nil;
try
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos]);
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos]);
// find node at position
CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos,true);
@ -2482,8 +2483,8 @@ begin
ActivateGlobalWriteLock;
Params:=nil;
try
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos]);
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos]);
// find node at position
CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos,true);

6
components/codetools/methodjumptool.pas
View File

@ -333,7 +333,7 @@ begin
{$IFDEF CTDEBUG}
DebugLn('TMethodJumpingCodeTool.FindJumpPoint A CursorPos=',dbgs(CursorPos.X),',',dbgs(CursorPos.Y));
{$ENDIF}
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
GetLineInfo(CleanCursorPos,LineStart,LineEnd,FirstAtomStart,LastAtomEnd);
if CleanCursorPos<FirstAtomStart then CleanCursorPos:=FirstAtomStart;
if CleanCursorPos>=LastAtomEnd then CleanCursorPos:=LastAtomEnd-1;
@ -1053,7 +1053,7 @@ var
StartPos, EndPos: integer;
begin
Result:=false;
BuildTree(false);
BuildTree(lsrEnd);
DebugLn(['TMethodJumpingCodeTool.FindJumpPointForLinkerPos ']);
BestPos:=0;
@ -1181,7 +1181,7 @@ var SectionNode, CurProcNode: TCodeTreeNode;
CurProcHead: string;
begin
Result:=false;
BuildTree(false);
BuildTree(lsrEnd);
SectionNode:=Tree.Root;
while (SectionNode<>nil) do begin
if SectionNode.Desc in [ctnProgram,ctnImplementation] then begin

725
components/codetools/pascalparsertool.pas
View File

@ -96,9 +96,9 @@ type
sbcStopOnSemicolon
);
TSkipBracketChecks = set of TSkipBracketCheck;
TTreeRange = (trInterface, trAll, trTillCursor, trTillCursorSection);
TTreeRange = (trTillRange, trTillCursor, trTillCursorSection);
TBuildTreeFlag = (
btSetIgnoreErrorPos,
btKeepIgnoreErrorPos,
@ -112,10 +112,7 @@ type
TPascalParserTool = class(TMultiKeyWordListCodeTool)
private
protected
ExtractMemStream: TMemoryStream;
ExtractSearchPos: integer;
ExtractFoundPos: integer;
ExtractProcHeadPos: TProcHeadExtractPos;
// often used errors
procedure RaiseCharExpectedButAtomFound(c: char);
procedure RaiseStringExpectedButAtomFound(const s: string);
procedure RaiseUnexpectedKeyWord;
@ -123,10 +120,19 @@ type
procedure RaiseEndOfSourceExpected;
protected
// code extraction
ExtractMemStream: TMemoryStream;
ExtractSearchPos: integer;
ExtractFoundPos: integer;
ExtractProcHeadPos: TProcHeadExtractPos;
procedure InitExtraction;
function GetExtraction(InUpperCase: boolean): string;
function ExtractStreamEndIsIdentChar: boolean;
procedure ExtractNextAtom(AddAtom: boolean; Attr: TProcHeadAttributes);
protected
// parsing
FLastCompilerMode: TCompilerMode;
FLastCompilerModeSwitch: TCompilerModeSwitch;
procedure FetchScannerSource(Range: TLinkScannerRange); override;
// sections
function KeyWordFuncSection: boolean;
function KeyWordFuncEndPoint: boolean;
@ -207,15 +213,18 @@ type
public
CurSection: TCodeTreeNodeDesc;
InterfaceSectionFound: boolean;
ImplementationSectionFound: boolean;
EndOfSourceFound: boolean;
ScannedRange: TLinkScannerRange;
ScanTill: TLinkScannerRange;
procedure ValidateToolDependencies; virtual;
procedure BuildTree(OnlyInterfaceNeeded: boolean);
procedure BuildTree(Range: TLinkScannerRange);
procedure BuildTree(OnlyInterface: boolean); deprecated;
procedure BuildTreeAndGetCleanPos(TreeRange: TTreeRange;
ScanRange: TLinkScannerRange;
const CursorPos: TCodeXYPosition; out CleanCursorPos: integer;
BuildTreeFlags: TBuildTreeFlags);
procedure BuildTreeAndGetCleanPos(const CursorPos: TCodeXYPosition;
out CleanCursorPos: integer; BuildTreeFlags: TBuildTreeFlags = []);
procedure BuildSubTreeForBeginBlock(BeginNode: TCodeTreeNode); virtual;
procedure BuildSubTreeForProcHead(ProcNode: TCodeTreeNode); virtual;
procedure BuildSubTreeForProcHead(ProcNode: TCodeTreeNode;
@ -234,7 +243,7 @@ type
function FindNextNodeOnSameLvl(StartNode: TCodeTreeNode): TCodeTreeNode;
function FindPrevNodeOnSameLvl(StartNode: TCodeTreeNode): TCodeTreeNode;
// sections
// sections / scan range
function FindRootNode(Desc: TCodeTreeNodeDesc): TCodeTreeNode;
function FindInterfaceNode: TCodeTreeNode;
function FindImplementationNode: TCodeTreeNode;
@ -242,6 +251,9 @@ type
function FindFinalizationNode: TCodeTreeNode;
function FindMainBeginEndNode: TCodeTreeNode;
function FindFirstSectionChild: TCodeTreeNode;
function FindSectionNodeAtPos(P: integer): TCodeTreeNode;
function FindScanRangeNode(Range: TLinkScannerRange): TCodeTreeNode;
function FindScanRangeNodeAtPos(P: integer): TCodeTreeNode;
function NodeHasParentOfType(ANode: TCodeTreeNode;
NodeDesc: TCodeTreeNodeDesc): boolean;
@ -500,21 +512,20 @@ begin
RaiseEndOfSourceExpected;
end;
procedure TPascalParserTool.BuildTree(OnlyInterfaceNeeded: boolean);
procedure TPascalParserTool.BuildTree(Range: TLinkScannerRange);
var
SourceType: TCodeTreeNodeDesc;
Node: TCodeTreeNode;
begin
{$IFDEF MEM_CHECK}CheckHeap('TBasicCodeTool.BuildTree A '+IntToStr(MemCheck_GetMem_Cnt));{$ENDIF}
{$IFDEF MEM_CHECK}CheckHeap('TPascalParserTool.BuildTree A '+IntToStr(MemCheck_GetMem_Cnt));{$ENDIF}
{$IFDEF CTDEBUG}
DebugLn('TPascalParserTool.BuildTree A ',MainFilename);
DebugLn('TPascalParserTool.BuildTree START ',MainFilename,' Range=',dbgs(Range),' ScannedRange=',dbgs(ScannedRange));
{$ENDIF}
ValidateToolDependencies;
if not UpdateNeeded(OnlyInterfaceNeeded) then begin
if not UpdateNeeded(Range) then begin
// input is the same as last time -> output is the same
// => if there was an error, raise it again
//debugln(['TPascalParserTool.BuildTree ',ord(LastErrorPhase),' ',IgnoreErrorAfterValid]);
if (LastErrorPhase in [ctpScan,ctpParse]) then begin
//debugln(['TPascalParserTool.BuildTree ',IgnoreErrorAfterValid]);
if LastErrorValid then begin
// last time a parsing error occurred
if IgnoreErrorAfterValid
and IgnoreErrorAfterPositionIsInFrontOfLastErrMessage
@ -523,106 +534,211 @@ begin
// => ignore
exit;
end;
//debugln(['TPascalParserTool.BuildTree ',MainFilename,' OnlyInterfaceNeeded=',OnlyInterfaceNeeded,' ImplementationSectionFound=',ImplementationSectionFound]);
if OnlyInterfaceNeeded and ImplementationSectionFound then begin
Node:=FindImplementationNode;
if (Node<>nil) and not LastErrorIsInFrontOfCleanedPos(Node.StartPos)
then begin
// last error was after interface section and only interface is needed
// => ignore
exit;
end;
Node:=FindScanRangeNode(Range);
if (Node<>nil) and not LastErrorIsInFrontOfCleanedPos(Node.StartPos)
then begin
// last error was after needed range
// => ignore
exit;
end;
// last error is in needed range => reraise
RaiseLastError;
end;
exit;
end;
// an update is needed. The last error was in the area to be update.
ClearLastError;
//DebugLn('TPascalParserTool.BuildTree B OnlyIntf=',dbgs(OnlyInterfaceNeeded),' ',TCodeBuffer(Scanner.MainCode).Filename);
//CheckHeap('TBasicCodeTool.BuildTree B '+IntToStr(MemCheck_GetMem_Cnt));
//DebugLn('TPascalParserTool.BuildTree LINKSCANNING ... ',MainFilename,' Range=',dbgs(Range));
//CheckHeap('TPascalParserTool.BuildTree B '+IntToStr(MemCheck_GetMem_Cnt));
// scan code
BeginParsing(true,OnlyInterfaceNeeded);
BeginParsing(Range);
{$IFDEF VerboseUpdateNeeded}
if FForceUpdateNeeded=true then
DebugLn(['TCustomCodeTool.BuildTree FForceUpdateNeeded:=false ',MainFilename]);
DebugLn(['TPascalParserTool.BuildTree PARSING ... Range=',dbgs(Range),' ',MainFilename]);
{$ENDIF}
FForceUpdateNeeded:=false;
//debugln(['TPascalParserTool.BuildTree "',Src,'"']);
// parse code and build codetree
CurrentPhase:=ctpParse;
if Scanner.CompilerMode=cmDELPHI then
WordIsKeyWordFuncList:=WordIsDelphiKeyWord
else if Scanner.CompilerMode=cmMacPas then
WordIsKeyWordFuncList:=WordIsMacPasKeyWord
else
WordIsKeyWordFuncList:=WordIsKeyWord;
InterfaceSectionFound:=false;
ImplementationSectionFound:=false;
EndOfSourceFound:=false;
try
ReadNextAtom;
if UpAtomIs('UNIT') then
CurSection:=ctnUnit
else if UpAtomIs('PROGRAM') then
CurSection:=ctnProgram
else if UpAtomIs('PACKAGE') then
CurSection:=ctnPackage
else if UpAtomIs('LIBRARY') then
CurSection:=ctnLibrary
else
SaveRaiseExceptionFmt(ctsNoPascalCodeFound,[GetAtom],true);
SourceType:=CurSection;
CreateChildNode;
CurNode.Desc:=CurSection;
ReadNextAtom; // read source name
AtomIsIdentifier(true);
ReadNextAtom; // read ';' (or 'platform;' or 'unimplemented;')
if UpAtomIs('PLATFORM') then
ReadNextAtom;
if UpAtomIs('UNIMPLEMENTED') then
ReadNextAtom;
if UpAtomIs('LIBRARY') then
ReadNextAtom;
if UpAtomIs('EXPERIMENTAL') then
ReadNextAtom;
if UpAtomIs('DEPRECATED') then
ReadNextAtom;
if (CurPos.Flag<>cafSemicolon) then
RaiseCharExpectedButAtomFound(';');
if CurSection=ctnUnit then begin
ReadNextAtom;
CurNode.EndPos:=CurPos.StartPos;
EndChildNode;
//DebugLn(['TPascalParserTool.BuildTree ',MainFilename,' ',Scanner.NestedComments]);
if not UpAtomIs('INTERFACE') then
RaiseStringExpectedButAtomFound('"interface"');
CreateChildNode;
CurSection:=ctnInterface;
CurNode.Desc:=CurSection;
end;
InterfaceSectionFound:=true;
ReadNextAtom;
if UpAtomIs('USES') then
ReadUsesSection(true);
if (SourceType=ctnPackage) then begin
if UpAtomIs('REQUIRES') then
ReadRequiresSection(true);
if UpAtomIs('CONTAINS') then
ReadContainsSection(true);
end;
repeat
//DebugLn('[TPascalParserTool.BuildTree] ALL ',GetAtom);
if not DoAtom then break;
if CurSection=ctnNone then begin
EndOfSourceFound:=true;
break;
try
ScanTill:=Range;
ScannedRange:=lsrInit;
if ord(Range)<=ord(ScannedRange) then exit;
// skip existing nodes
CurNode:=Tree.Root;
if CurNode<>nil then
while CurNode.NextBrother<>nil do CurNode:=CurNode.NextBrother;
//debugln(['TPascalParserTool.BuildTree CurNode=',CurNode.DescAsString]);
if (CurNode=nil)
or ((CurNode.Desc in AllSourceTypes) and (CurNode.FirstChild=nil)) then begin
// parse source from the beginning
// => read source type and name
ReadNextAtom;
if UpAtomIs('UNIT') then
CurSection:=ctnUnit
else if UpAtomIs('PROGRAM') then
CurSection:=ctnProgram
else if UpAtomIs('PACKAGE') then
CurSection:=ctnPackage
else if UpAtomIs('LIBRARY') then
CurSection:=ctnLibrary
else
SaveRaiseExceptionFmt(ctsNoPascalCodeFound,[GetAtom],true);
if CurNode=nil then
CreateChildNode;
CurNode.Desc:=CurSection;
ScannedRange:=lsrSourceType;
if ord(Range)<=ord(ScannedRange) then exit;
ReadNextAtom; // read source name
AtomIsIdentifier(true);
ReadNextAtom; // read ';' (or 'platform;' or 'unimplemented;')
ScannedRange:=lsrSourceName;
if ord(Range)<=ord(ScannedRange) then exit;
if UpAtomIs('PLATFORM') then
ReadNextAtom;
if UpAtomIs('UNIMPLEMENTED') then
ReadNextAtom;
if UpAtomIs('LIBRARY') then
ReadNextAtom;
if UpAtomIs('EXPERIMENTAL') then
ReadNextAtom;
if UpAtomIs('DEPRECATED') then begin
ReadNextAtom;
if CurPos.Flag<>cafSemicolon then
ReadConstant(true,false,[]);
end;
if (CurPos.Flag<>cafSemicolon) then
RaiseCharExpectedButAtomFound(';');
if CurSection=ctnUnit then begin
ReadNextAtom;
CurNode.EndPos:=CurPos.StartPos;
EndChildNode;
if not UpAtomIs('INTERFACE') then
RaiseStringExpectedButAtomFound('"interface"');
CreateChildNode;
CurSection:=ctnInterface;
CurNode.Desc:=CurSection;
end;
ScannedRange:=lsrInterfaceStart;
if ord(Range)<=ord(ScannedRange) then exit;
end else if CurNode.Desc=ctnEndPoint then begin
// all parts were already parsed
ScannedRange:=lsrEnd;
//debugln(['TPascalParserTool.BuildTree ALL nodes were already parsed. Change was behind pascal source.']);
exit;
end else begin
// some parts were already parsed
CurSection:=CurNode.Desc;
Node:=CurNode;
//debugln(['TPascalParserTool.BuildTree SOME parts were already parsed Node=',Node.DescAsString]);
Node.EndPos:=-1;
if (Node.LastChild=nil) then begin
// section was not parsed => reopen it
//debugln(['TPascalParserTool.BuildTree scan a section from start ...']);
MoveCursorToCleanPos(Node.StartPos);
// skip keyword starting the section
ReadNextAtom;
end else begin
// half parsed section
//debugln(['TPascalParserTool.BuildTree scan a section from middle ...']);
if (Node.LastChild.Desc=ctnUsesSection)
and (Node.LastChild.FirstChild=nil) then begin
// uses section was not parsed completely => reopen it
//debugln(['TPascalParserTool.BuildTree REOPEN uses section']);
Node:=CurNode.LastChild;
Node.EndPos:=-1;
MoveCursorToCleanPos(Node.StartPos);
end else begin
// place cursor behind last child node
while (Node.LastChild<>nil) and (Node.LastChild.EndPos<1) do
Node:=Node.LastChild;
if Node.LastChild<>nil then
MoveCursorToCleanPos(Node.LastChild.EndPos)
else if CurNode.EndPos>0 then
MoveCursorToCleanPos(Node.EndPos)
else begin
MoveCursorToCleanPos(Node.StartPos);
Node.EndPos:=-1;
end;
end;
end;
CurNode:=Node;
//debugln(['TPascalParserTool.BuildTree curnode=',CurNode.DescAsString,' cursor="',dbgstr(copy(Src,CurPos.StartPos,40)),'"']);
if not (CurNode.Desc in (AllCodeSections+[ctnUsesSection])) then
// FetchScannerSource failed
RaiseCatchableException('TPascalParserTool.BuildTree inconsistency');
end;
ReadNextAtom;
until (CurPos.StartPos>SrcLen);
FForceUpdateNeeded:=false;
//debugln(['TPascalParserTool.BuildTree first atom ',GetAtom]);
if (CurNode.Desc in (AllSourceTypes+[ctnInterface]))
or ((CurNode.Desc=ctnUsesSection) and (CurNode.Parent.Desc<>ctnImplementation))
then begin
// read main uses section
if UpAtomIs('USES') then
ReadUsesSection(true);
//debugln(['TPascalParserTool.BuildTree AFTER reading main uses section Atom="',GetAtom,'"']);
if ord(Range)<=ord(ScannedRange) then exit;
end;
ScannedRange:=lsrMainUsesSectionEnd;
if ord(Range)<=ord(ScannedRange) then exit;
if (CurNode.Desc=ctnPackage)
and ((CurNode.FirstChild=nil) or (CurNode.LastChild.Desc=ctnUsesSection))
then begin
// read package requires and contains section
if UpAtomIs('REQUIRES') then
ReadRequiresSection(true);
if UpAtomIs('CONTAINS') then
ReadContainsSection(true);
//debugln(['TPascalParserTool.BuildTree AFTER reading package requires+contains sections Atom="',GetAtom,'"']);
end;
if CurNode.GetNodeOfType(ctnImplementation)<>nil then begin
//debugln(['TPascalParserTool.BuildTree CONTINUE implementation ...']);
ScannedRange:=lsrImplementationStart;
if ord(Range)<=ord(ScannedRange) then exit;
if (CurNode.Desc=ctnUsesSection)
or ((CurNode.Desc=ctnImplementation) and (CurNode.FirstChild=nil)) then
begin
// read main uses section
if UpAtomIs('USES') then
ReadUsesSection(true);
//debugln(['TPascalParserTool.BuildTree AFTER reading implementation uses section Atom="',GetAtom,'"']);
if ord(Range)<=ord(ScannedRange) then exit;
end;
end;
repeat
//DebugLn('[TPascalParserTool.BuildTree] ALL ',GetAtom);
if not DoAtom then break;
if CurSection=ctnNone then
break;
ReadNextAtom;
until (CurPos.StartPos>SrcLen);
if (Range=lsrEnd) and (CurSection<>ctnNone) then
SaveRaiseException(ctsEndOfSourceNotFound);
finally
FRangeValidTill:=ScannedRange;
{$IFDEF VerboseUpdateNeeded}
debugln(['TPascalParserTool.BuildTree scanned till ',dbgs(FRangeValidTill)]);
{$ENDIF}
ScanTill:=lsrEnd;
CloseUnfinishedNodes;
end;
except
{$IFDEF ShowIgnoreErrorAfter}
DebugLn('TPascalParserTool.BuildTree ',MainFilename,' ERROR: ',LastErrorMessage);
@ -630,7 +746,6 @@ begin
if (not IgnoreErrorAfterValid)
or (not IgnoreErrorAfterPositionIsInFrontOfLastErrMessage) then
raise;
FForceUpdateNeeded:=false;
{$IFDEF ShowIgnoreErrorAfter}
DebugLn('TPascalParserTool.BuildTree ',MainFilename,' IGNORING ERROR: ',LastErrorMessage);
{$ENDIF}
@ -639,9 +754,16 @@ begin
DebugLn('[TPascalParserTool.BuildTree] END');
{$ENDIF}
{$IFDEF MEM_CHECK}
CheckHeap('TBasicCodeTool.BuildTree END '+IntToStr(MemCheck_GetMem_Cnt));
CheckHeap('TPascalParserTool.BuildTree END '+IntToStr(MemCheck_GetMem_Cnt));
{$ENDIF}
CurrentPhase:=ctpTool;
end;
procedure TPascalParserTool.BuildTree(OnlyInterface: boolean);
begin
if OnlyInterface then
BuildTree(lsrImplementationStart)
else
BuildTree(lsrEnd);
end;
procedure TPascalParserTool.BuildSubTreeForBeginBlock(BeginNode: TCodeTreeNode);
@ -657,7 +779,6 @@ procedure TPascalParserTool.BuildSubTreeForBeginBlock(BeginNode: TCodeTreeNode);
var
MaxPos: integer;
OldPhase: TCodeToolPhase;
begin
if BeginNode=nil then
RaiseException(
@ -673,8 +794,6 @@ begin
exit;
end;
OldPhase:=CurrentPhase;
CurrentPhase:=ctpParse;
try
BeginNode.SubDesc:=BeginNode.SubDesc and (not ctnsNeedJITParsing);
// set CursorPos on 'begin'
@ -695,9 +814,7 @@ begin
end else if UpAtomIs('WITH') then
ReadWithStatement(true,true);
until (CurPos.StartPos>=MaxPos);
CurrentPhase:=OldPhase;
except
CurrentPhase:=OldPhase;
{$IFDEF ShowIgnoreErrorAfter}
DebugLn('TPascalParserTool.BuildSubTreeForBeginBlock ',MainFilename,' ERROR: ',LastErrorMessage);
{$ENDIF}
@ -1643,8 +1760,15 @@ function TPascalParserTool.ReadUsesSection(
}
begin
CreateChildNode;
CurNode.Desc:=ctnUsesSection;
if CurNode.Desc<>ctnUsesSection then begin
CreateChildNode;
CurNode.Desc:=ctnUsesSection;
end;
if ord(ScannedRange)<ord(lsrMainUsesSectionStart) then
ScannedRange:=lsrMainUsesSectionStart
else if ord(ScannedRange)<ord(lsrImplementationUsesSectionStart) then
ScannedRange:=lsrImplementationUsesSectionStart;
if ord(ScanTill)<=ord(ScannedRange) then exit;
repeat
ReadNextAtom; // read name
if CurPos.Flag=cafSemicolon then break;
@ -2133,34 +2257,50 @@ function TPascalParserTool.KeyWordFuncSection: boolean;
end;
begin
Result:=false;
if UpAtomIs('IMPLEMENTATION') then begin
if not (CurSection in [ctnInterface,ctnUnit,ctnLibrary,ctnPackage]) then
RaiseUnexpectedSectionKeyWord;
// close section node
CurNode.EndPos:=CurPos.StartPos;
EndChildNode;
ImplementationSectionFound:=true;
// start implementation section node
CreateChildNode;
CurNode.Desc:=ctnImplementation;
CurNode.EndPos:=CurPos.EndPos;
CurSection:=ctnImplementation;
ScannedRange:=lsrImplementationStart;
if ord(ScanTill)<=ord(ScannedRange) then exit;
ReadNextAtom;
if UpAtomIs('USES') then
if UpAtomIs('USES') then begin
ReadUsesSection(true);
UndoReadNextAtom;
if CurPos.Flag<>cafSemicolon then
UndoReadNextAtom;
if ord(ScanTill)<=ord(ScannedRange) then exit;
CurNode.EndPos:=CurPos.EndPos;
end else
UndoReadNextAtom;
ScannedRange:=lsrImplementationUsesSectionEnd;
if ord(ScanTill)<=ord(ScannedRange) then exit;
Result:=true;
end else if (UpAtomIs('INITIALIZATION') or UpAtomIs('FINALIZATION')) then
begin
if UpAtomIs('INITIALIZATION')
and (not CurSection in [ctnInterface,ctnImplementation,
if UpAtomIs('INITIALIZATION') then begin
if (not CurSection in [ctnInterface,ctnImplementation,
ctnUnit,ctnLibrary,ctnPackage])
then
RaiseUnexpectedSectionKeyWord;
if UpAtomIs('FINALIZATION')
and (not CurSection in [ctnInterface,ctnImplementation,ctnInitialization,
then
RaiseUnexpectedSectionKeyWord;
end;
if UpAtomIs('FINALIZATION') then begin
if (not CurSection in [ctnInterface,ctnImplementation,ctnInitialization,
ctnUnit,ctnLibrary,ctnPackage])
then
RaiseUnexpectedSectionKeyWord;
then
RaiseUnexpectedSectionKeyWord;
end;
// close section node
CurNode.EndPos:=CurPos.StartPos;
EndChildNode;
@ -2168,9 +2308,15 @@ begin
CreateChildNode;
if UpAtomIs('INITIALIZATION') then begin
CurNode.Desc:=ctnInitialization;
end else
ScannedRange:=lsrInitializationStart;
end else begin
CurNode.Desc:=ctnFinalization;
ScannedRange:=lsrFinalizationStart;
end;
CurNode.EndPos:=CurPos.EndPos;
CurSection:=CurNode.Desc;
if ord(ScanTill)<=ord(ScannedRange) then exit;
repeat
ReadNextAtom;
if (CurSection=ctnInitialization) and UpAtomIs('FINALIZATION') then
@ -2179,7 +2325,10 @@ begin
EndChildNode;
CreateChildNode;
CurNode.Desc:=ctnFinalization;
CurNode.EndPos:=CurPos.EndPos;
CurSection:=CurNode.Desc;
ScannedRange:=lsrFinalizationStart;
if ord(ScanTill)<=ord(ScannedRange) then exit;
end else if EndKeyWordFuncList.DoItCaseInsensitive(Src,CurPos.StartPos,
CurPos.EndPos-CurPos.StartPos) then
begin
@ -2193,7 +2342,6 @@ begin
end else begin
RaiseUnexpectedSectionKeyWord;
end;
Result:=true;
end;
function TPascalParserTool.KeyWordFuncEndPoint: boolean;
@ -2228,6 +2376,7 @@ begin
else
CurNode.EndPos:=CurPos.StartPos;
LastNodeEnd:=CurNode.EndPos;
// end section (ctnBeginBlock, ctnInitialization, ...)
EndChildNode;
CreateChildNode;
CurNode.Desc:=ctnEndPoint;
@ -2238,6 +2387,7 @@ begin
CurNode.EndPos:=CurPos.EndPos;
EndChildNode;
CurSection:=ctnNone;
ScannedRange:=lsrEnd;
Result:=true;
end;
@ -4295,6 +4445,98 @@ begin
ReadNextAtom;
end;
procedure TPascalParserTool.FetchScannerSource(Range: TLinkScannerRange);
var
AllChanged: Boolean;
NewSrc: String;
NewSrcLen: Integer;
OldP: PChar;
NewP: PChar;
DiffPos: PtrInt;
Node: TCodeTreeNode;
DeleteNode: TCodeTreeNode;
begin
DirtySrc.Free;
DirtySrc:=nil;
// update scanned code
if FLastScannerChangeStep=Scanner.ChangeStep then begin
if LastErrorValid then
RaiseLastError;
// no change => keep all nodes
exit;
end else begin
// code has changed
//debugln(['TPascalParserTool.FetchScannerSource link scanner has changed ',MainFilename]);
FLastScannerChangeStep:=Scanner.ChangeStep;
AllChanged:=(FLastCompilerMode<>Scanner.CompilerMode)
or (FLastCompilerModeSwitch<>Scanner.CompilerModeSwitch);
FLastCompilerMode:=Scanner.CompilerMode;
FLastCompilerModeSwitch:=Scanner.CompilerModeSwitch;
NewSrc:=Scanner.CleanedSrc;
NewSrcLen:=length(NewSrc);
if not AllChanged then begin
// find the first difference in source
OldP:=PChar(Src);
NewP:=PChar(NewSrc);
if (OldP=nil) or (NewP=nil) then
AllChanged:=true
else begin
while (NewP^=OldP^) do begin
if (NewP^=#0) and (NewP-PChar(NewSrc)>=NewSrcLen) then break;
inc(NewP);
inc(OldP);
end;
DiffPos:=NewP-PChar(NewSrc)+1;
if DiffPos<=1 then begin
AllChanged:=true;
end else if DiffPos>NewSrcLen then begin
// no chance => keep all nodes
//debugln(['TPascalParserTool.FetchScannerSource cleansrc has not changed => keep all nodes ',MainFilename]);
exit;
end else begin
// some parts are the same
Node:=FindDeepestNodeAtPos(DiffPos,false);
if Node=nil then begin
if (Tree.Root=nil) or (DiffPos<=Tree.Root.StartPos) then
// difference is in front of first node => all changed
AllChanged:=true
else begin
// difference is behind nodes => keep all nodes
//debugln(['TPascalParserTool.FetchScannerSource cleansrc was changed after scanned nodes => keep all nodes ',MainFilename]);
exit;
end;
end else begin
// difference is in a node
// delete node and all following
// the section node is not deleted, but marked as unfinished
DeleteNode:=nil;
while Node<>nil do begin
if Node.Desc in AllCodeSections then
Node.EndPos:=-1 // mark as unfinished
else
DeleteNode:=Node;
Node:=Node.Parent;
end;
DoDeleteNodes(DeleteNode);
if LastErrorIsInFrontOfCleanedPos(DiffPos) then
ClearLastError;
end;
end;
end;
end;
if AllChanged then begin
DoDeleteNodes(Tree.Root);
ClearLastError;
end;
Src:=NewSrc;
SrcLen:=NewSrcLen;
{$IFDEF VerboseUpdateNeeded}
DebugLn(['TPascalParserTool.FetchScannerSource source changed ',MainFilename]);
{$ENDIF}
FRangeValidTill:=lsrInit;
end;
end;
function TPascalParserTool.FindFirstNodeOnSameLvl(
StartNode: TCodeTreeNode): TCodeTreeNode;
begin
@ -4366,8 +4608,8 @@ begin
Result:=(ANode<>nil);
end;
procedure TPascalParserTool.BuildTreeAndGetCleanPos(
TreeRange: TTreeRange; const CursorPos: TCodeXYPosition;
procedure TPascalParserTool.BuildTreeAndGetCleanPos(TreeRange: TTreeRange;
ScanRange: TLinkScannerRange; const CursorPos: TCodeXYPosition;
out CleanCursorPos: integer; BuildTreeFlags: TBuildTreeFlags);
var
CaretType: integer;
@ -4393,59 +4635,24 @@ begin
ClearIgnoreErrorAfter;
if (RealTreeRange in [trTillCursor,trTillCursorSection]) then begin
// find out, if interface is enough
ScanRange:=lsrEnd;
// check if cursor position is in scanned range
if (Tree<>nil) and (Tree.Root<>nil) then begin
Node:=Tree.Root;
while (Node<>nil) and (Node.Desc<>ctnImplementation) do
Node:=Node.NextBrother;
if Node<>nil then begin
// start of implementation section found
// => whole interface was read
CaretType:=CaretToCleanPos(CursorPos, CleanCursorPos);
if (CaretType=0) or (CaretType=-1) then begin
if (CleanCursorPos<=Node.StartPos)
and (not UpdateNeeded(true)) then begin
// interface section is already parsed, is still valid and
// cursor is in this section
ValidateToolDependencies;
exit;
end;
CaretType:=CaretToCleanPos(CursorPos, CleanCursorPos);
if (CaretType=0) or (CaretType=-1) then begin
Node:=FindScanRangeNodeAtPos(CleanCursorPos);
if Node<>nil then begin
// cursor in scanned range
ScanRange:=ScannedRange;
if (RealTreeRange=trTillCursorSection) and (ScanRange<>lsrEnd) then
inc(ScanRange);
end;
end;
end;
if RealTreeRange=trTillCursorSection then begin
// interface is no enough => parse whole unit
RealTreeRange:=trAll;
end;
end;
if (RealTreeRange=trTillCursor) and (not UpdateNeeded(false)) then begin
// tree is valid
// -> if there was an error, raise it again
if (LastErrorPhase in [ctpScan,ctpParse])
and ((not IgnoreErrorAfterValid)
or (not IgnoreErrorAfterPositionIsInFrontOfLastErrMessage))
then begin
DebugLn('TPascalParserTool.BuildTreeAndGetCleanPos RaiseLastError ',MainFilename);
RaiseLastError;
end;
// check if cursor is in interface
CaretType:=CaretToCleanPos(CursorPos, CleanCursorPos);
if (CaretType=0) or (CaretType=-1) then begin
BuildSubTree(CleanCursorPos);
if (CaretType=-1) and (btLoadDirtySource in BuildTreeFlags) then begin
// cursor position is in dead code (skipped code between IFDEF/ENDIF)
LoadDirtySource(CursorPos);
end;
exit;
end;
// cursor is not in partially parsed code -> parse complete code
end;
// parse code
BuildTree(RealTreeRange=trInterface);
if (not IgnoreErrorAfterValid) and (not EndOfSourceFound) then
SaveRaiseException(ctsEndOfSourceNotFound);
BuildTree(ScanRange);
// find the CursorPos in cleaned source
CaretType:=CaretToCleanPos(CursorPos, CleanCursorPos);
if (CaretType=0) or (CaretType=-1) then begin
@ -4455,13 +4662,21 @@ begin
LoadDirtySource(CursorPos);
end;
exit;
end;
if (CaretType=-2) or (not (btCursorPosOutAllowed in BuildTreeFlags)) then
end
else if (CaretType=-2) or (not (btCursorPosOutAllowed in BuildTreeFlags)) then
RaiseException(ctsCursorPosOutsideOfCode);
// cursor outside of clean code
CleanCursorPos:=-1;
end;
procedure TPascalParserTool.BuildTreeAndGetCleanPos(
const CursorPos: TCodeXYPosition; out CleanCursorPos: integer;
BuildTreeFlags: TBuildTreeFlags);
begin
BuildTreeAndGetCleanPos(trTillRange,lsrEnd,CursorPos,CleanCursorPos,
BuildTreeFlags);
end;
function TPascalParserTool.ReadTilTypeOfProperty(
PropertyNode: TCodeTreeNode): boolean;
begin
@ -4651,7 +4866,6 @@ end;
procedure TPascalParserTool.BuildSubTreeForProcHead(ProcNode: TCodeTreeNode);
var HasForwardModifier, IsFunction, IsOperator, IsMethod: boolean;
ParseAttr: TParseProcHeadAttributes;
OldPhase: TCodeToolPhase;
IsProcType: Boolean;
ProcHeadNode: TCodeTreeNode;
begin
@ -4680,8 +4894,6 @@ begin
RaiseNodeParserError(ProcHeadNode);
exit;
end;
OldPhase:=CurrentPhase;
CurrentPhase:=ctpParse;
try
IsMethod:=ProcNode.Parent.Desc in (AllClasses+AllClassSections);
MoveCursorToNodeStart(ProcNode);
@ -4719,9 +4931,7 @@ begin
if IsOperator then Include(ParseAttr,pphIsOperator);
if IsProcType then Include(ParseAttr,pphIsType);
ReadTilProcedureHeadEnd(ParseAttr,HasForwardModifier);
CurrentPhase:=OldPhase;
except
CurrentPhase:=OldPhase;
{$IFDEF ShowIgnoreErrorAfter}
DebugLn('TPascalParserTool.BuildSubTreeForProcHead ',MainFilename,' ERROR: ',LastErrorMessage);
{$ENDIF}
@ -4843,6 +5053,167 @@ begin
Result:=Result.FirstChild;
end;
function TPascalParserTool.FindSectionNodeAtPos(P: integer): TCodeTreeNode;
begin
Result:=Tree.Root;
if Result=nil then exit;
if Result.StartPos>P then exit(nil);
while (Result.NextBrother<>nil) and (Result.NextBrother.StartPos<=P) do
Result:=Result.NextBrother;
end;
function TPascalParserTool.FindScanRangeNode(Range: TLinkScannerRange
): TCodeTreeNode;
{ search a node of the Range or higher
lsrNone and lsrInit are always nil
lsrSourceType is the unit/program/library node if exists
Otherwise it is the next node (e.g. in a unit the interface)
}
begin
Result:=nil;
// lsrNone, lsrInit
if (ord(Range)<=ord(lsrInit)) then exit;
Result:=Tree.Root;
if Result=nil then exit;
// lsrSourceType;
if Range=lsrSourceType then exit;
// lsrSourceName;
if Range=lsrSourceName then begin
// the source name has no node of its own
exit;
end;
if ord(Range)<ord(lsrEnd) then begin
if Result.Desc=ctnUnit then begin
Result:=Result.NextBrother;
if Result=nil then exit;
if Result.Desc<>ctnInterface then
RaiseCatchableException('');
// lsrInterfaceStart in unit
if Range=lsrInterfaceStart then exit;
if ord(Range)<ord(lsrImplementationStart) then begin
if Result.FirstChild=nil then begin
Result:=Result.NextSkipChilds;
exit;
end;
Result:=Result.FirstChild;
// lsrMainUsesSectionStart in unit
if Range=lsrMainUsesSectionStart then exit;
if Result.Desc=ctnUsesSection then begin
Result:=Result.NextSkipChilds;
if Result=nil then exit;
end;
// lsrMainUsesSectionEnd in unit
exit;
end else if ord(Range)<ord(lsrEnd) then begin
// search for implementation, initialization or finalization
// skip interface
if Result.NextBrother=nil then begin
Result:=Result.NextSkipChilds;
exit;
end;
Result:=Result.NextBrother;
if ord(Range)<ord(lsrInitializationStart) then begin
if Result.Desc<>ctnImplementation then exit;
// lsrImplementationStart in unit
if Range=lsrImplementationStart then exit;
if Result.FirstChild=nil then begin
Result:=Result.NextSkipChilds;
exit;
end;
Result:=Result.FirstChild;
// lsrImplementationUsesSectionStart
if Range=lsrImplementationUsesSectionStart then exit;
if Result.Desc=ctnUsesSection then begin
Result:=Result.NextSkipChilds;
if Result=nil then exit;
end;
// lsrImplementationUsesSectionEnd
exit;
end;
// initialization or finalization
// skip implementation
if Result.Desc=ctnImplementation then begin
if Result.NextBrother=nil then begin
Result:=Result.NextSkipChilds;
exit;
end;
Result:=Result.NextBrother;
end;
// lsrInitializationStart in unit;
if Range=lsrInitializationStart then exit;
// lsrFinalizationStart
if (Result.Desc=ctnInitialization) or (Result.Desc=ctnBeginBlock) then begin
if Result.NextBrother=nil then begin
Result:=Result.NextSkipChilds;
exit;
end;
Result:=Result.NextBrother;
end;
exit;
end;
end else begin
// not unit, but program, library or package
if Range=lsrInterfaceStart then begin
Result:=Result.Next;
exit;
end;
if ord(Range)<ord(lsrImplementationStart) then begin
// lsrMainUsesSectionStart or lsrMainUsesSectionEnd
if Result.FirstChild=nil then begin
Result:=Result.Next;
exit;
end;
Result:=Result.FirstChild;
if Result.Desc<>ctnUsesSection then exit;
// lsrMainUsesSectionStart in program
if Range=lsrMainUsesSectionStart then exit;
// lsrMainUsesSectionEnd;
Result:=Result.NextSkipChilds;
exit;
end else if ord(Range)<ord(lsrInitializationStart) then begin
// lsrImplementationStart, lsrImplementationUsesSectionStart,
// lsrImplementationUsesSectionEnd
// skip uses section
if Result.FirstChild=nil then begin
Result:=Result.Next;
exit;
end;
Result:=Result.FirstChild;
if Result.Desc=ctnUsesSection then
Result:=Result.NextSkipChilds;
exit;
end else if Range=lsrInitializationStart then begin
// lsrInitializationStart in program
if (Result.LastChild<>nil)
and (Result.LastChild.Desc in [ctnBeginBlock,ctnAsmBlock]) then
Result:=Result.LastChild
else
Result:=Result.NextSkipChilds;
end else
// lsrFinalizationStart in program
Result:=Result.NextSkipChilds;
end;
end else begin
// lsrEnd
while (Result<>nil) and (Result.Desc<>ctnEndPoint) do
Result:=Result.NextBrother;
end;
end;
function TPascalParserTool.FindScanRangeNodeAtPos(P: integer): TCodeTreeNode;
var
UsesNode: TCodeTreeNode;
begin
Result:=FindSectionNodeAtPos(P);
if Result=nil then exit;
if (Result.FirstChild<>nil) and (Result.FirstChild.Desc=ctnUsesSection) then
begin
UsesNode:=Result.FirstChild;
if (UsesNode.StartPos<=P) and (UsesNode.EndPos>P) then
Result:=UsesNode;
end;
end;
end.

6
components/codetools/pascalreadertool.pas
View File

@ -2097,7 +2097,7 @@ var NamePos: TAtomPosition;
begin
Result:='';
if DoBuildTree then
BuildTree(true);
BuildTree(lsrSourceName);
if not GetSourceNamePos(NamePos) then exit;
CachedSourceName:=copy(Src,NamePos.StartPos,NamePos.EndPos-NamePos.StartPos);
Result:=CachedSourceName;
@ -2300,7 +2300,7 @@ begin
// parse source and find clean positions
if InvokeBuildTree then
BuildTreeAndGetCleanPos(trAll,StartPos,CleanCursorPos,[])
BuildTreeAndGetCleanPos(StartPos,CleanCursorPos,[])
else
if CaretToCleanPos(StartPos,CleanCursorPos)<>0 then
exit;
@ -2642,7 +2642,7 @@ begin
// parse source and find clean positions
if InvokeBuildTree then
BuildTreeAndGetCleanPos(trAll,StartPos,CleanCursorPos,[])
BuildTreeAndGetCleanPos(StartPos,CleanCursorPos)
else
if CaretToCleanPos(StartPos,CleanCursorPos)<>0 then
exit;

2
components/codetools/resourcecodetool.pas
View File

@ -73,7 +73,7 @@ begin
LastAtoms.Clear;
NextPos.StartPos:=-1;
CurNode:=nil;
DoDeleteNodes;
DoDeleteNodes(Tree.Root);
end;
function TResourceCodeTool.FindLazarusResourceHeaderComment(

159
components/codetools/stdcodetools.pas
View File

@ -72,8 +72,9 @@ type
function ReadBackwardTilAnyBracketClose: boolean;
public
// explore the code
function Explore(WithStatements: boolean; Range: TLinkScannerRange): boolean;
function Explore(WithStatements: boolean;
OnlyInterface: boolean = false): boolean;
OnlyInterface: boolean = false): boolean;
// source name e.g. 'unit UnitName;'
function GetCachedSourceName: string;
@ -388,7 +389,7 @@ function TStandardCodeTool.RenameSource(const NewName: string;
var NamePos: TAtomPosition;
begin
Result:=false;
BuildTree(true);
BuildTree(lsrSourceName);
if (not GetSourceNamePos(NamePos)) or (NamePos.StartPos<1) or (NewName='')
or (Length(NewName)>255) then exit;
SourceChangeCache.MainScanner:=Scanner;
@ -571,7 +572,7 @@ var
begin
Result:=false;
BuildTree(false);
BuildTree(lsrImplementationUsesSectionEnd);
SourceChangeCache.MainScanner:=Scanner;
ExistingUnits:=nil;
try
@ -930,7 +931,10 @@ var
begin
Result:=false;
if (NewUnitName='') or (length(NewUnitName)>255) then exit;
BuildTree(UsesSection=usMain);
if UsesSection=usMain then
BuildTree(lsrMainUsesSectionEnd)
else
BuildTree(lsrImplementationUsesSectionEnd);
SourceChangeCache.MainScanner:=Scanner;
case UsesSection Of
usMain: UsesNode:=FindMainUsesSection;
@ -1019,7 +1023,10 @@ begin
Result:=false;
if (UpperUnitName='') or (length(UpperUnitName)>255) then
exit;
BuildTree(UsesSection=usMain);
if UsesSection=usMain then
BuildTree(lsrMainUsesSectionEnd)
else
BuildTree(lsrImplementationUsesSectionEnd);
SourceChangeCache.MainScanner:=Scanner;
case UsesSection Of
usMain: UsesNode:=FindMainUsesSection;
@ -1123,7 +1130,7 @@ var SectionNode: TCodeTreeNode;
begin
Result:=false;
if (UpperUnitName='') or (SourceChangeCache=nil) then exit;
BuildTree(false);
BuildTree(lsrImplementationUsesSectionEnd);
SourceChangeCache.BeginUpdate;
try
@ -1151,7 +1158,7 @@ var
begin
debugln('TStandardCodeTool.FixUsedUnitCase ',MainFilename);
Result:=false;
BuildTree(false);
BuildTree(lsrImplementationUsesSectionEnd);
SectionNode:=Tree.Root;
while (SectionNode<>nil) do begin
if (SectionNode.FirstChild<>nil)
@ -1257,7 +1264,7 @@ begin
MainUsesSection:=nil;
ImplementationUsesSection:=nil;
// find the uses sections
BuildTree(false);
BuildTree(lsrImplementationUsesSectionEnd);
MainUsesNode:=FindMainUsesSection;
ImplementatioUsesNode:=FindImplementationUsesSection;
// create lists
@ -1306,7 +1313,7 @@ function TStandardCodeTool.FindUsedUnitNames(var List: TStringToStringTree
begin
// find the uses sections
List:=TStringToStringTree.Create(false);
BuildTree(false);
BuildTree(lsrImplementationUsesSectionEnd);
Collect(FindMainUsesSection,'Main');
Collect(FindImplementationUsesSection,'Implementation');
Result:=true;
@ -1319,7 +1326,7 @@ var
begin
MainUsesSection:=nil;
// find the uses sections
BuildTree(true);
BuildTree(lsrImplementationUsesSectionEnd);
MainUsesNode:=FindMainUsesSection;
// create lists
try
@ -1339,7 +1346,7 @@ begin
MainUsesSection:=nil;
ImplementationUsesSection:=nil;
// find the uses sections
BuildTree(false);
BuildTree(lsrImplementationUsesSectionEnd);
MainUsesNode:=FindMainUsesSection;
ImplementatioUsesNode:=FindImplementationUsesSection;
// create lists
@ -1382,7 +1389,7 @@ begin
NormalUnits:=nil;
DebugLn('TStandardCodeTool.FindDelphiProjectUnits UseContainsSection=',dbgs(UseContainsSection));
// find the uses sections
BuildTree(false);
BuildTree(lsrEnd);
UsesNode:=FindMainUsesSection(UseContainsSection);
if UsesNode=nil then exit;
MoveCursorToUsesStart(UsesNode);
@ -1560,7 +1567,7 @@ function TStandardCodeTool.FindMissingUnits(var MissingUnits: TStrings;
begin
Result:=false;
BuildTree(false);
BuildTree(lsrImplementationUsesSectionEnd);
if FixCase then
SourceChangeCache.MainScanner:=Scanner;
try
@ -1680,7 +1687,7 @@ begin
Result:=true;
exit;
end;
BuildTree(false);
BuildTree(lsrImplementationUsesSectionEnd);
SourceChangeCache.MainScanner:=Scanner;
if not CommentUnitsInUsesSection(FindMainUsesSection) then exit;
if not CommentUnitsInUsesSection(FindImplementationUsesSection) then exit;
@ -1827,7 +1834,7 @@ var
HasCode:=false;
UseInterface:=false;
// parse used unit
Tool.BuildTree(false);
Tool.BuildTree(lsrEnd);
Node:=Tool.Tree.Root;
while (Node<>nil) do begin
case Node.Desc of
@ -1918,7 +1925,7 @@ var
begin
Result:=false;
DebugLn(['TStandardCodeTool.FindUnusedUnits ']);
BuildTree(false);
BuildTree(lsrImplementationUsesSectionEnd);
Identifiers:=nil;
try
CheckUsesSection(FindMainUsesSection,false);
@ -1938,7 +1945,7 @@ var
begin
Result:=nil;
if LinkIndex<0 then begin
BuildTree(false);
BuildTree(lsrEnd);
InitializationNode:=FindInitializationNode;
if InitializationNode=nil then exit;
LinkIndex:=Scanner.LinkIndexAtCleanPos(InitializationNode.StartPos);
@ -2030,7 +2037,7 @@ begin
Result:=false;
if (ResourceCode=nil) or (ResourceName='') or (length(ResourceName)>255)
or (ResourceData='') or (SourceChangeCache=nil) then exit;
BuildTree(false);
BuildTree(lsrEnd);
SourceChangeCache.MainScanner:=Scanner;
OldPosition:=FindLazarusResourceInBuffer(ResourceCode,ResourceName);
if OldPosition.StartPos>0 then begin
@ -2072,7 +2079,7 @@ begin
Result:=false;
if (ResourceCode=nil) or (ResourceName='') or (length(ResourceName)>255)
or (SourceChangeCache=nil) then exit;
BuildTree(false);
BuildTree(lsrEnd);
SourceChangeCache.MainScanner:=Scanner;
OldPosition:=FindLazarusResourceInBuffer(ResourceCode,ResourceName);
if OldPosition.StartPos>0 then begin
@ -2702,7 +2709,7 @@ begin
if not LFMTree.ParseIfNeeded then exit;
// parse unit and find LookupRoot
//DebugLn('TStandardCodeTool.CheckLFM parsing unit ...');
BuildTree(true);
BuildTree(lsrImplementationUsesSectionEnd);
// find every identifier
//DebugLn('TStandardCodeTool.CheckLFM checking identifiers ...');
CurRootLFMNode:=LFMTree.Root;
@ -2729,7 +2736,7 @@ begin
if (UpperClassName='') or (UpperVarName='') or (length(UpperClassName)>255)
or (length(UpperVarName)>255) then exit;
if StartPos<1 then begin
BuildTree(false);
BuildTree(lsrEnd);
MainBeginNode:=FindMainBeginEndNode;
if MainBeginNode=nil then exit;
StartPos:=MainBeginNode.StartPos;
@ -2769,7 +2776,7 @@ begin
Result:=false;
if (AClassName='') or (length(AClassName)>255) or (AVarName='')
or (length(AVarName)>255) then exit;
BuildTree(false);
BuildTree(lsrEnd);
MainBeginNode:=FindMainBeginEndNode;
if MainBeginNode=nil then exit;
FromPos:=-1;
@ -2836,7 +2843,7 @@ begin
or (NewClassName='') or (length(NewClassName)>255)
or (NewVarName='') or (length(NewVarName)>255)
then exit;
BuildTree(false);
BuildTree(lsrEnd);
MainBeginNode:=FindMainBeginEndNode;
if MainBeginNode=nil then exit;
FromPos:=-1;
@ -2868,7 +2875,7 @@ var Position: integer;
s:string;
var MainBeginNode: TCodeTreeNode;
begin
BuildTree(false);
BuildTree(lsrEnd);
Result:=TStringList.Create;
MainBeginNode:=FindMainBeginEndNode;
if MainBeginNode=nil then exit;
@ -2905,7 +2912,7 @@ var Position, InsertPos, i, ColonPos, Indent: integer;
begin
Result:= false;
if (List = nil) or (SourceChangeCache = nil) then exit;
BuildTree(false);
BuildTree(lsrEnd);
{ first delete all CreateForm Statements }
SourceChangeCache.MainScanner:= Scanner;
@ -2981,7 +2988,7 @@ begin
StartPos:=-1;
StringConstStartPos:=-1;
EndPos:=-1;
BuildTree(false);
BuildTree(lsrEnd);
MainBeginNode:=FindMainBeginEndNode;
if MainBeginNode=nil then exit;
Position:=MainBeginNode.StartPos;
@ -3127,7 +3134,7 @@ begin
Result:=false;
AncestorClassName:='';
if UpperClassName='' then exit;
BuildTree(true);
BuildTree(lsrImplementationStart);
ClassNode:=FindClassNodeInInterface(UpperClassName,true,false,false);
if (ClassNode=nil) then exit;
// search the ancestor name
@ -3235,7 +3242,7 @@ begin
Result:=false;
if (IdentList=nil) or (IdentList.Count=0) or (SourceChangeCache=nil)
or (Odd(IdentList.Count)) then exit;
BuildTree(false);
BuildTree(lsrEnd);
if Scanner=nil then exit;
SourceChangeCache.MainScanner:=Scanner;
SourceList:=TFPList.Create;
@ -3261,7 +3268,7 @@ var
begin
Result:=nil;
if IdentTree=nil then exit;
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,[]);
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,[]);
BestDiff:=SrcLen+1;
MoveCursorToCleanPos(1);
repeat
@ -3359,7 +3366,7 @@ begin
StartPos:=CursorPos;
EndPos:=CursorPos;
Result:=true;
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
{$IFDEF VerboseGetStringConstBounds}
DebugLn('TStandardCodeTool.GetStringConstBounds A Start at ',CleanPosToStr(CleanCursorPos),' "',copy(Src,CleanCursorPos-5,5),'" | "',copy(Src,CleanCursorPos,5),'"');
{$ENDIF}
@ -3684,7 +3691,7 @@ begin
Result:=false;
Operand:='';
if CursorPos.Code.LineColIsSpace(CursorPos.Y,CursorPos.X) then exit;
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanPos,[]);
BuildTreeAndGetCleanPos(CursorPos,CleanPos);
Node:=FindDeepestNodeAtPos(CleanPos,true);
StartPos:=FindStartOfTerm(CleanPos,NodeTermInType(Node));
if StartPos<1 then exit;
@ -3728,7 +3735,7 @@ function TStandardCodeTool.GatherResourceStringSections(
MoveCursorToAtomPos(UnitNameAtom);
RaiseException(Format(ctsSourceOfUnitNotFound, [GetAtom]));
end;
NewCodeTool.BuildTree(true);
NewCodeTool.BuildTree(lsrImplementationStart);
// search all resource string sections in the interface
ANode:=NewCodeTool.FindInterfaceNode;
if (ANode<>nil) and (ANode.LastChild<>nil) then begin
@ -3759,7 +3766,7 @@ var
begin
Result:=false;
//DebugLn('TStandardCodeTool.GatherResourceStringSections A ');
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
PositionList.Clear;
ANode:=CursorNode;
@ -3799,7 +3806,7 @@ begin
Result:=false;
if ResStrIdentifier='' then exit;
// parse source and find clean positions
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
// find resource string section
ANode:=FindDeepestNodeAtPos(CleanCursorPos,true);
if (ANode=nil) then exit;
@ -3830,7 +3837,7 @@ begin
Result:=false;
if MaxLen<=0 then exit;
// parse source and find clean positions
BuildTreeAndGetCleanPos(trAll,StartCursorPos,StartPos,[]);
BuildTreeAndGetCleanPos(StartCursorPos,StartPos);
Dummy:=CaretToCleanPos(EndCursorPos, EndPos);
if (Dummy<>0) and (Dummy<>-1) then exit;
ANode:=FindDeepestNodeAtPos(StartPos,True);
@ -3864,7 +3871,7 @@ var
begin
Result:=false;
// parse source and find clean positions
BuildTreeAndGetCleanPos(trAll,StartCursorPos,StartPos,[]);
BuildTreeAndGetCleanPos(StartCursorPos,StartPos);
Dummy:=CaretToCleanPos(EndCursorPos, EndPos);
if (Dummy<>0) and (Dummy<>-1) then exit;
Result:=GetStringConstAsFormatString(StartPos,EndPos,FormatStringConstant,
@ -3879,7 +3886,7 @@ var
begin
Result:=false;
HasRegisterProc:=false;
BuildTree(true);
BuildTree(lsrImplementationStart);
InterfaceNode:=FindInterfaceNode;
if InterfaceNode=nil then exit;
ANode:=InterfaceNode.FirstChild;
@ -3908,7 +3915,7 @@ function TStandardCodeTool.ConvertDelphiToLazarusSource(AddLRSCode: boolean;
InsertPos: Integer;
begin
Result:=false;
BuildTree(true);
BuildTree(lsrInterfaceStart);
if not FindModeDirective(false,ModeDirectivePos) then begin
// add {$MODE Delphi} behind source type
if Tree.Root=nil then exit;
@ -3922,7 +3929,7 @@ function TStandardCodeTool.ConvertDelphiToLazarusSource(AddLRSCode: boolean;
if not SourceChangeCache.Apply then exit;
end;
// changing mode requires rescan
BuildTree(false);
BuildTree(lsrImplementationStart);
Result:=true;
end;
@ -4066,7 +4073,7 @@ var
begin
Result:=false;
DirectiveList.Clear;
BuildTree(true);
BuildTree(lsrImplementationStart);
EndPos:=1;
repeat
StartPos:=FindNextIDEDirective(Src,EndPos,Scanner.NestedComments);
@ -4091,7 +4098,7 @@ begin
Result:=false;
if SourceChangeCache=nil then exit;
SourceChangeCache.MainScanner:=Scanner;
BuildTree(false);
BuildTree(lsrEnd);
// find first old IDE directive
InsertPos:=FindNextIDEDirective(Src,1,Scanner.NestedComments);
@ -4183,7 +4190,7 @@ begin
Result:=false;
if PositionList=nil then exit;
// parse source and find clean positions
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
// find resource string section
ANode:=FindDeepestNodeAtPos(CleanCursorPos,true);
if (ANode=nil) then exit;
@ -4208,7 +4215,7 @@ begin
Result:=false;
IdentTree:=nil;
// parse source and find clean positions
BuildTreeAndGetCleanPos(trAll,SectionPos,CleanCursorPos,[]);
BuildTreeAndGetCleanPos(SectionPos,CleanCursorPos);
// find resource string section
ANode:=FindDeepestNodeAtPos(CleanCursorPos,true);
if (ANode=nil) then exit;
@ -4282,7 +4289,7 @@ begin
SourceChangeCache.MainScanner:=Scanner;
// parse source and find clean positions
//DebugLn('TStandardCodeTool.AddResourcestring B');
BuildTreeAndGetCleanPos(trAll,SectionPos,CleanSectionPos,[]);
BuildTreeAndGetCleanPos(SectionPos,CleanSectionPos);
//DebugLn('TStandardCodeTool.AddResourcestring C');
// find resource string section
SectionNode:=FindDeepestNodeAtPos(CleanSectionPos,true);
@ -4378,7 +4385,7 @@ begin
Result:=nil;
if (UpperClassName='') or (length(UpperClassName)>255) then
RaiseException(Format(ctsinvalidClassName, ['"', UpperClassName, '"']));
BuildTree(true);
BuildTree(lsrImplementationStart);
ClassNode:=FindClassNodeInInterface(UpperClassName,true,false,false);
if ClassNode=nil then begin
if ExceptionOnClassNotFound then
@ -4495,7 +4502,7 @@ var
ApplyNeeded: Boolean;
begin
Result:=false;
BuildTree(false);
BuildTree(lsrEnd);
VarNode:=FindPublishedVariable(UpperClassName,UpperOldVarName,
ExceptionOnClassNotFound);
if VarNode<>nil then begin
@ -4604,7 +4611,7 @@ begin
{$IFDEF VerboseDanglingComponentEvents}
DebugLn(['TStandardCodeTool.GatherPublishedClassElements BEFORE buildtree']);
{$ENDIF}
BuildTree(true);
BuildTree(lsrImplementationStart);
{$IFDEF VerboseDanglingComponentEvents}
DebugLn(['TStandardCodeTool.GatherPublishedClassElements after buildtree']);
{$ENDIF}
@ -4641,13 +4648,16 @@ var
HasChanged: Boolean;
begin
Result:=false;
BuildTree(not SearchImplementationToo);
if SearchImplementationToo then
if SearchImplementationToo then begin
BuildTree(lsrEnd);
ClassNode:=FindClassNodeInUnit(AClassName,true,false,false,
ExceptionOnClassNotFound)
else
end
else begin
BuildTree(lsrImplementationStart);
ClassNode:=FindClassNodeInInterface(AClassName,true,false,
ExceptionOnClassNotFound);
end;
if ClassNode=nil then exit;
if (ListOfTypes=nil) or (ListOfTypes.Tree.Count=0) then exit(true);
@ -4837,7 +4847,7 @@ var
DeleteFirstTokenOfLine: Boolean;
begin
Result:=false;
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
Node:=BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos,true);
if Node.Desc in AllIdentifierDefinitions then begin
// Examples:
@ -4935,7 +4945,7 @@ function TStandardCodeTool.FindBlockCounterPart(
var CleanCursorPos: integer;
begin
Result:=false;
BeginParsingAndGetCleanPos(true,false,CursorPos,CleanCursorPos);
BeginParsingAndGetCleanPos(lsrEnd,CursorPos,CleanCursorPos);
// read word at cursor
MoveCursorToCleanPos(CleanCursorPos);
if Src[CurPos.StartPos] in ['(','[','{'] then begin
@ -4978,7 +4988,7 @@ var CleanCursorPos: integer;
begin
Result:=false;
// scan code
BeginParsingAndGetCleanPos(true,false,CursorPos,CleanCursorPos);
BeginParsingAndGetCleanPos(lsrEnd,CursorPos,CleanCursorPos);
// read word at cursor
MoveCursorToCleanPos(CleanCursorPos);
while (CurPos.StartPos>2) and IsWordChar[Src[CurPos.StartPos-1]] do
@ -5057,7 +5067,7 @@ function TStandardCodeTool.GuessUnclosedBlock(const CursorPos: TCodeXYPosition;
var CleanCursorPos: integer;
begin
Result:=false;
BeginParsingAndGetCleanPos(true,false,CursorPos,CleanCursorPos);
BeginParsingAndGetCleanPos(lsrEnd,CursorPos,CleanCursorPos);
// start reading at beginning of code
MoveCursorToCleanPos(1);
BuildBlockKeyWordFuncList;
@ -5077,7 +5087,7 @@ begin
BlockCleanStart:=0;
BlockCleanEnd:=0;
// scan code
BeginParsingAndGetCleanPos(true,false,CursorPos,CleanCursorPos);
BeginParsingAndGetCleanPos(lsrEnd,CursorPos,CleanCursorPos);
// read word at cursor
MoveCursorToCleanPos(CleanCursorPos);
while (CurPos.StartPos>2) and IsWordChar[Src[CurPos.StartPos-1]] do
@ -6014,8 +6024,8 @@ var
begin
Result:=false;
NewPos:=CursorPos;
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos]);
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos]);
StartNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
InternalCursorAtEmptyLine:=ebNone;
@ -6055,7 +6065,7 @@ var
begin
Result:=false;
try
BeginParsing(true,false);
BeginParsing(lsrEnd);
except
// ignore scanner and parser errors
on e: ELinkScannerError do ;
@ -6086,8 +6096,8 @@ var
begin
Result:=false;
try
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos]);
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos]);
LinkIndex:=Scanner.LinkIndexAtCleanPos(CleanCursorPos);
LinkIndex:=Scanner.FindParentLink(LinkIndex);
if LinkIndex<0 then
@ -6109,7 +6119,7 @@ var
begin
Result:=false;
ACleanPos:=0;
if DoBuildTree then BuildTree(true);
if DoBuildTree then BuildTree(lsrMainUsesSectionStart);
ACleanPos:=FindNextCompilerDirectiveWithName(Src,1,'Mode',
Scanner.NestedComments,ParamPos);
if ParamPos=0 then ;
@ -6124,7 +6134,7 @@ var
FilenameEndPos: LongInt;
begin
Result:=false;
if DoBuildTree then BuildTree(true);
if DoBuildTree then BuildTree(lsrEnd);
ACleanPos:=1;
repeat
ACleanPos:=FindNextCompilerDirectiveWithName(Src,ACleanPos,'R',
@ -6158,7 +6168,7 @@ var
CleanCursorPos: integer;
begin
Result:=false;
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
if not FindResourceDirective(false,CleanCursorPos,Filename) then begin
//DebugLn('TStandardCodeTool.FindResourceDirective resource directive not found');
exit;
@ -6175,7 +6185,7 @@ var
AddSrc: String;
begin
Result:=false;
BuildTree(true);
BuildTree(lsrEnd);
// find an insert position
ANode:=FindImplementationNode;
if ANode<>nil then begin
@ -6220,7 +6230,7 @@ var
CommentEnd: integer;
begin
Result:=false;
if DoBuildTree then BuildTree(true);
if DoBuildTree then BuildTree(lsrEnd);
ACleanPos:=1;
repeat
ACleanPos:=FindNextIncludeDirective(Src,ACleanPos,Scanner.NestedComments,
@ -6249,7 +6259,7 @@ var
CleanCursorPos: integer;
begin
Result:=false;
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
BuildTreeAndGetCleanPos(CursorPos,CleanCursorPos);
if not FindIncludeDirective(false,CleanCursorPos,Filename) then begin
//DebugLn('TStandardCodeTool.FindIncludeDirective resource directive not found');
exit;
@ -6266,7 +6276,7 @@ var
AddSrc: String;
begin
Result:=false;
BuildTree(true);
BuildTree(lsrEnd);
// find an insert position
ANode:=FindInitializationNode;
if ANode<>nil then begin
@ -6737,12 +6747,12 @@ begin
end;
function TStandardCodeTool.Explore(WithStatements: boolean;
OnlyInterface: boolean): boolean;
Range: TLinkScannerRange): boolean;
var
Node: TCodeTreeNode;
begin
Result:=true;
BuildTree(OnlyInterface);
BuildTree(Range);
Node:=Tree.Root;
while Node<>nil do begin
case Node.Desc of
@ -6752,12 +6762,21 @@ begin
if WithStatements then
BuildSubTreeForBeginBlock(Node);
ctnImplementation:
if OnlyInterface then exit;
if ord(Range)<ord(lsrImplementationStart) then exit;
end;
Node:=Node.Next;
end;
end;
function TStandardCodeTool.Explore(WithStatements: boolean;
OnlyInterface: boolean): boolean;
begin
if OnlyInterface then
Result:=Explore(WithStatements,lsrImplementationStart)
else
Result:=Explore(WithStatements,lsrEnd);
end;
finalization
FreeAndNil(BlockKeywordFuncList);

11
converter/convcodetool.pas
View File

@ -211,7 +211,7 @@ begin
Result:=false;
ACleanPos:=0;
with fCTLink.CodeTool do begin
BuildTree(true);
BuildTree(lsrImplementationStart);
ACleanPos:=FindNextCompilerDirectiveWithName(Src, 1, 'Apptype',
Scanner.NestedComments, ParamPos);
if (ACleanPos>0) and (ACleanPos<=SrcLen) and (ParamPos>0) then
@ -227,8 +227,7 @@ var
begin
Result:=false;
with fCTLink.CodeTool do begin
BuildTree(true);
if not FindModeDirective(false,ModeDirectivePos) then begin
if not FindModeDirective(true,ModeDirectivePos) then begin
// add {$MODE Delphi} behind source type
if Tree.Root=nil then exit;
MoveCursorToNodeStart(Tree.Root);
@ -243,7 +242,7 @@ begin
fCTLink.SrcCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,s);
end;
// changing mode requires rescan
BuildTree(false);
BuildTree(lsrEnd);
end;
Result:=true;
end;
@ -323,7 +322,7 @@ var
begin
Result:=false;
with fCTLink.CodeTool do begin
BuildTree(true);
BuildTree(lsrImplementationStart);
// Find the class name that the main class inherits from.
ANode:=FindClassNodeInUnit(AClassName,true,false,false,false);
if ANode=nil then exit;
@ -697,7 +696,7 @@ begin
fDefinedProcNames.Duplicates:=dupIgnore;
ActivateGlobalWriteLock;
try
BuildTree(false);
BuildTree(lsrEnd);
// Only convert identifiers in ctnBeginBlock nodes
Node:=fCTLink.CodeTool.Tree.Root;
while Node<>nil do begin

4
converter/formfileconv.pas
View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, Forms, Controls, contnrs,
// codetools
LFMTrees, CodeCache, BasicCodeTools, KeywordFuncLists,
LFMTrees, CodeCache, LinkScanner, BasicCodeTools, KeywordFuncLists,
// Converter
ConverterTypes, ConvCodeTool;
@ -179,7 +179,7 @@ begin
fCTLink.CodeTool.ActivateGlobalWriteLock;
try
if not fLFMTree.ParseIfNeeded then exit;
fCTLink.CodeTool.BuildTree(true);
fCTLink.CodeTool.BuildTree(lsrImplementationStart);
// Iterate the root objects
CurRootNode:=fLFMTree.Root;
while (CurRootNode<>nil) and (CurRootNode is TLFMObjectNode) do begin

21
converter/usedunits.pas
View File

@ -36,7 +36,7 @@ uses
LazarusIDEStrConsts, IDEMsgIntf,
// codetools
CodeToolManager, StdCodeTools, CodeTree, CodeCache, CodeToolsStructs, AVL_Tree,
KeywordFuncLists, SourceChanger, CodeAtom, CodeToolsStrConsts,
LinkScanner, KeywordFuncLists, SourceChanger, CodeAtom, CodeToolsStrConsts,
// Converter
ConverterTypes, ConvCodeTool, ConvertSettings, ReplaceNamesUnit;
@ -312,7 +312,10 @@ var
Result:=True;
with fCTLink do begin
ResetMainScanner;
CodeTool.BuildTree(fUsesSection=usMain);
if fUsesSection=usMain then
CodeTool.BuildTree(lsrMainUsesSectionEnd)
else
CodeTool.BuildTree(lsrImplementationUsesSectionEnd);
// Calls either FindMainUsesSection or FindImplementationUsesSection
UsesNode:=UsesSectionNode;
Assert(Assigned(UsesNode),
@ -368,7 +371,10 @@ begin
// Add LCL and Delphi sections for output.
if (LclOnlyUnits.Count=0) and (DelphiOnlyUnits.Count=0) then Exit(True);
fCTLink.ResetMainScanner;
fCTLink.CodeTool.BuildTree(fUsesSection=usMain);
if fUsesSection=usMain then
fCTLink.CodeTool.BuildTree(lsrMainUsesSectionEnd)
else
fCTLink.CodeTool.BuildTree(lsrImplementationUsesSectionEnd);
UsesNode:=UsesSectionNode;
if Assigned(UsesNode) then begin //uses section exists
EndChar:=',';
@ -439,7 +445,10 @@ begin
Result:=false;
for i:=0 to fUnitsToRemove.Count-1 do begin
fCTLink.ResetMainScanner;
fCTLink.CodeTool.BuildTree(fUsesSection=usMain);
if fUsesSection=usMain then
fCTLink.CodeTool.BuildTree(lsrMainUsesSectionEnd)
else
fCTLink.CodeTool.BuildTree(lsrImplementationUsesSectionEnd);
if not fCTLink.CodeTool.RemoveUnitFromUsesSection(UsesSectionNode,
UpperCaseStr(fUnitsToRemove[i]), fCTLink.SrcCache) then
exit;
@ -504,7 +513,7 @@ begin
fFilename:=AFilename;
fIsMainFile:=False;
fIsConsoleApp:=False;
fCTLink.CodeTool.BuildTree(False);
fCTLink.CodeTool.BuildTree(lsrEnd);
// These will read uses sections while creating.
fMainUsedUnits:=TMainUsedUnits.Create(ACTLink, Self);
fImplUsedUnits:=TImplUsedUnits.Create(ACTLink, Self);
@ -542,7 +551,7 @@ begin
MapToEdit:=Nil;
if fCTLink.Settings.UnitsReplaceMode=rlInteractive then
MapToEdit:=TStringToStringTree.Create(false);
fCTLink.CodeTool.BuildTree(false);
fCTLink.CodeTool.BuildTree(lsrEnd);
if not (fMainUsedUnits.FindMissingUnits(UnitUpdater) and
fImplUsedUnits.FindMissingUnits(UnitUpdater)) then begin
Result:=mrCancel;

37
test/codetoolstests/testctrangescan.pas
View File

@ -2,6 +2,7 @@
Test with:
./runtests --format=plain --suite=TestCTScanRange
./runtests --format=plain --suite=TestCTScanRangeAscending
./runtests --format=plain --suite=TestCTScanRangeProcModified
}
unit TestCTRangeScan;
@ -21,6 +22,7 @@ uses
type
TCTRgSrcFlag = (
crsfWithProc1,
crsfWithProc1Modified,
crsfWithCommentAtEnd,
crsfWithInitialization,
crsfWithFinalization
@ -36,6 +38,7 @@ type
procedure TestCTScanRange;
procedure TestCTScanRangeAscending;
procedure TestCTScanRangeDescending;
procedure TestCTScanRangeProcModified;
end;
implementation
@ -56,7 +59,13 @@ begin
+'const c = 3;'+LineEnding;
if crsfWithProc1 in Flags then
Result:=Result+'procedure Proc1;'+LineEnding
+'begin end;'+LineEnding;
+'begin'+LineEnding
+'end;'+LineEnding;
if crsfWithProc1Modified in Flags then
Result:=Result+'procedure Proc1;'+LineEnding
+'begin'+LineEnding
+' // comment'+LineEnding
+'end;'+LineEnding;
if crsfWithInitialization in Flags then
Result:=Result+'initialization'+LineEnding;
if crsfWithFinalization in Flags then
@ -116,6 +125,10 @@ begin
Code:=CodeToolBoss.CreateFile('TestRangeScan.pas');
Tool:=CodeToolBoss.GetCodeToolForSource(Code,false,true) as TCodeTool;
// empty tool
Code.Source:='';
Tool.BuildTree(lsrInit);
// scan source
Code.Source:=GetSource([crsfWithInitialization,crsfWithFinalization]);
RootNode:=nil;
@ -173,13 +186,33 @@ begin
MinRange:=low(TLinkScannerRange);
MaxRange:=high(TLinkScannerRange);
for r:=MaxRange downto MinRange do begin
debugln(['TTestCodetoolsRangeScan.TestCTScanRangeAscending Range=',dbgs(r)]);
debugln(['TTestCodetoolsRangeScan.TestCTScanRangeDescending Range=',dbgs(r)]);
Tool.BuildTree(r);
AssertEquals('RootNode must stay for descending range '+dbgs(r),true,Tool.Tree.Root<>nil);
//Tool.WriteDebugTreeReport;
end;
end;
procedure TTestCodetoolsRangeScan.TestCTScanRangeProcModified;
var
Code: TCodeBuffer;
Tool: TEventsCodeTool;
begin
Code:=CodeToolBoss.CreateFile('TestRangeScan.pas');
Tool:=CodeToolBoss.GetCodeToolForSource(Code,false,true) as TCodeTool;
// scan source
Code.Source:=GetSource([crsfWithProc1]);
Tool.BuildTree(lsrEnd);
Tool.WriteDebugTreeReport;
AssertEquals('step1: end. found',true,Tool.Tree.FindRootNode(ctnEndPoint)<>nil);
Code.Source:=GetSource([crsfWithProc1Modified]);
Tool.BuildTree(lsrEnd);
Tool.WriteDebugTreeReport;
AssertEquals('step2: end. found',true,Tool.Tree.FindRootNode(ctnEndPoint)<>nil);
end;
initialization
AddToCodetoolsTestSuite(TTestCodetoolsRangeScan);