mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-10 18:36:25 +02:00
MG: implemented IgnoreErrorAfter position for codetools
git-svn-id: trunk@3362 -
This commit is contained in:
lazarus
parent
e4c398a208
commit
7460fce057
@ -137,6 +137,7 @@ type
|
||||
// useful functions
|
||||
function AtomPosition(StartPos, EndPos: integer): TAtomPosition;
|
||||
function CodePosition(P: integer; Code: TCodeBuffer): TCodePosition;
|
||||
function CodeXYPosition(X, Y: integer; Code: TCodeBuffer): TCodeXYPosition;
|
||||
|
||||
var
|
||||
WordToAtomFlag: TWordToAtomFlag;
|
||||
@ -159,6 +160,12 @@ begin
|
||||
Result.Code:=Code;
|
||||
end;
|
||||
|
||||
function CodeXYPosition(X, Y: integer; Code: TCodeBuffer): TCodeXYPosition;
|
||||
begin
|
||||
Result.X:=X;
|
||||
Result.Y:=Y;
|
||||
Result.Code:=Code;
|
||||
end;
|
||||
|
||||
{ TAtomRing }
|
||||
|
||||
|
||||
@ -35,6 +35,8 @@ interface
|
||||
|
||||
{$I codetools.inc}
|
||||
|
||||
{ $DEFINE ShowIgnoreError}
|
||||
|
||||
uses
|
||||
{$IFDEF MEM_CHECK}
|
||||
MemCheck,
|
||||
@ -57,7 +59,7 @@ type
|
||||
FOnGetGlobalWriteLockInfo: TOnGetWriteLockInfo;
|
||||
FOnSetGlobalWriteLock: TOnSetWriteLock;
|
||||
protected
|
||||
FIgnoreAfterCodeXY: TCodeXYPosition;
|
||||
FIgnoreErrorAfter: TCodePosition;
|
||||
KeyWordFuncList: TKeyWordFunctionList;
|
||||
FForceUpdateNeeded: boolean;
|
||||
function DefaultKeyWordFunc: boolean;
|
||||
@ -67,11 +69,14 @@ type
|
||||
procedure RaiseIdentExpectedButAtomFound;
|
||||
procedure RaiseBracketOpenExpectedButAtomFound;
|
||||
procedure RaiseBracketCloseExpectedButAtomFound;
|
||||
procedure SetIgnoreAfterCodeXY(const AValue: TCodeXYPosition); virtual;
|
||||
procedure SetIgnoreErrorAfter(const AValue: TCodePosition); virtual;
|
||||
protected
|
||||
LastErrorMessage: string;
|
||||
LastErrorCurPos: TAtomPosition;
|
||||
LastErrorPhase: integer;
|
||||
LastErrorValid: boolean;
|
||||
LastErrorBehindIgnorePosition: boolean;
|
||||
LastErrorCheckedForIgnored: boolean;
|
||||
CurrentPhase: integer;
|
||||
procedure RaiseException(const AMessage: string); virtual;
|
||||
procedure RaiseExceptionFmt(const AMessage: string;
|
||||
@ -124,14 +129,13 @@ type
|
||||
function FindLineEndOrCodeInFrontOfPosition(StartPos: integer;
|
||||
StopAtDirectives: boolean): integer;
|
||||
function FindFirstLineEndAfterInCode(StartPos: integer): integer;
|
||||
procedure ClearIgnoreAfterPosition;
|
||||
|
||||
function UpdateNeeded(OnlyInterfaceNeeded: boolean): boolean;
|
||||
procedure BeginParsing(DeleteNodes, OnlyInterfaceNeeded: boolean); virtual;
|
||||
procedure BeginParsingAndGetCleanPos(DeleteNodes,
|
||||
OnlyInterfaceNeeded: boolean; CursorPos: TCodeXYPosition;
|
||||
var CleanCursorPos: integer);
|
||||
|
||||
|
||||
function StringIsKeyWord(const Word: string): boolean;
|
||||
|
||||
procedure MoveCursorToNodeStart(ANode: TCodeTreeNode);
|
||||
@ -185,7 +189,14 @@ type
|
||||
property OnSetGlobalWriteLock: TOnSetWriteLock
|
||||
read FOnSetGlobalWriteLock write FOnSetGlobalWriteLock;
|
||||
|
||||
property IgnoreAfterCodeXY: TCodeXYPosition read FIgnoreAfterCodeXY write SetIgnoreAfterCodeXY;
|
||||
property IgnoreErrorAfter: TCodePosition
|
||||
read FIgnoreErrorAfter write SetIgnoreErrorAfter;
|
||||
procedure ClearIgnoreErrorAfter;
|
||||
function IgnoreErrAfterPositionIsInFrontOfLastErrMessage: boolean;
|
||||
function IgnoreErrorAfterValid: boolean;
|
||||
function IgnoreErrorAfterCleanedPos: integer;
|
||||
function LastErrorsInFrontOfCleanedPos(ACleanedPos: integer): boolean;
|
||||
procedure RaiseLastErrorIfInFrontOfCleanedPos(ACleanedPos: integer);
|
||||
|
||||
procedure Clear; virtual;
|
||||
function NodeDescToStr(Desc: integer): string;
|
||||
@ -279,6 +290,7 @@ begin
|
||||
LastErrorMessage:=AMessage;
|
||||
LastErrorCurPos:=CurPos;
|
||||
LastErrorPhase:=CurrentPhase;
|
||||
LastErrorValid:=true;
|
||||
RaiseException(AMessage);
|
||||
end;
|
||||
|
||||
@ -290,7 +302,9 @@ end;
|
||||
|
||||
procedure TCustomCodeTool.ClearLastError;
|
||||
begin
|
||||
LastErrorPhase:=0;
|
||||
LastErrorPhase:=CodeToolPhaseNone;
|
||||
LastErrorValid:=false;
|
||||
LastErrorCheckedForIgnored:=false;
|
||||
end;
|
||||
|
||||
procedure TCustomCodeTool.RaiseLastError;
|
||||
@ -298,16 +312,20 @@ begin
|
||||
CurPos:=LastErrorCurPos;
|
||||
CurNode:=nil;
|
||||
CurrentPhase:=LastErrorPhase;
|
||||
writeln('TCustomCodeTool.RaiseLastError "',LastErrorMessage,'"');
|
||||
SaveRaiseException(LastErrorMessage);
|
||||
end;
|
||||
|
||||
procedure TCustomCodeTool.SetScanner(NewScanner: TLinkScanner);
|
||||
begin
|
||||
if NewScanner=FScanner then exit;
|
||||
LastErrorCheckedForIgnored:=false;
|
||||
Clear;
|
||||
FScanner:=NewScanner;
|
||||
if FScanner<>nil then
|
||||
FScanner:=NewScanner; begin
|
||||
if Scanner<>nil then
|
||||
FLastScannerChangeStep:=Scanner.ChangeStep;
|
||||
Scanner.SetIgnoreErrorAfter(IgnoreErrorAfter.P,IgnoreErrorAfter.Code);
|
||||
end;
|
||||
FForceUpdateNeeded:=true;
|
||||
end;
|
||||
|
||||
@ -1400,6 +1418,92 @@ begin
|
||||
RaiseException(ctsCursorPosOutsideOfCode);
|
||||
end;
|
||||
|
||||
function TCustomCodeTool.IgnoreErrAfterPositionIsInFrontOfLastErrMessage: boolean;
|
||||
var
|
||||
IgnoreErrorAfterCleanPos: integer;
|
||||
begin
|
||||
//writeln('TCustomCodeTool.IgnoreErrAfterPositionIsInFrontOfLastErrMessage ',
|
||||
// ' LastErrorCheckedForIgnored=',LastErrorCheckedForIgnored,
|
||||
// ' LastErrorBehindIgnorePosition=',LastErrorBehindIgnorePosition);
|
||||
if LastErrorCheckedForIgnored then begin
|
||||
Result:=LastErrorBehindIgnorePosition;
|
||||
end else begin
|
||||
if (Scanner<>nil) then begin
|
||||
IgnoreErrorAfterCleanPos:=Scanner.IgnoreErrorAfterCleanedPos;
|
||||
//writeln(' IgnoreErrorAfterCleanPos=',IgnoreErrorAfterCleanPos,
|
||||
// ' LastErrorCurPos.EndPos=',LastErrorCurPos.EndPos,
|
||||
// ' LastErrorPhase>CodeToolPhaseParse=',LastErrorPhase>CodeToolPhaseParse);
|
||||
if IgnoreErrorAfterCleanPos>0 then begin
|
||||
// ignore position in scanned code
|
||||
// -> check if last error behind ignore position
|
||||
if (not LastErrorValid)
|
||||
or (IgnoreErrorAfterCleanPos<=LastErrorCurPos.EndPos) then
|
||||
Result:=true
|
||||
else
|
||||
Result:=false;
|
||||
end else
|
||||
Result:=false;
|
||||
end else
|
||||
Result:=false;
|
||||
LastErrorBehindIgnorePosition:=Result;
|
||||
LastErrorCheckedForIgnored:=true;
|
||||
end;
|
||||
{$IFDEF ShowIgnoreErrorAfter}
|
||||
writeln('TCustomCodeTool.IgnoreErrAfterPositionIsInFrontOfLastErrMessage ',Result);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TCustomCodeTool.IgnoreErrorAfterValid: boolean;
|
||||
begin
|
||||
Result:=(Scanner<>nil) and (Scanner.IgnoreErrorAfterValid);
|
||||
{$IFDEF ShowIgnoreErrorAfter}
|
||||
writeln('TCustomCodeTool.IgnoreErrorAfterValid ',Result);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TCustomCodeTool.IgnoreErrorAfterCleanedPos: integer;
|
||||
begin
|
||||
if Scanner<>nil then
|
||||
Result:=Scanner.IgnoreErrorAfterCleanedPos
|
||||
else
|
||||
Result:=-1;
|
||||
{$IFDEF ShowIgnoreErrorAfter}
|
||||
writeln('TCustomCodeTool.IgnoreErrorAfterCleanedPos ',Result);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TCustomCodeTool.LastErrorsInFrontOfCleanedPos(ACleanedPos: integer
|
||||
): boolean;
|
||||
begin
|
||||
if (Scanner<>nil) and Scanner.LastErrorsInFrontOfCleanedPos(ACleanedPos)
|
||||
then
|
||||
Result:=true
|
||||
else if (LastErrorValid)
|
||||
and (LastErrorCurPos.EndPos<=ACleanedPos) then
|
||||
Result:=true
|
||||
else
|
||||
Result:=false;
|
||||
{$IFDEF ShowIgnoreErrorAfter}
|
||||
writeln('TCustomCodeTool.LastErrorsInFrontOfCleanedPos ACleanedPos=',ACleanedPos,
|
||||
Result);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TCustomCodeTool.RaiseLastErrorIfInFrontOfCleanedPos(
|
||||
ACleanedPos: integer);
|
||||
begin
|
||||
{$IFDEF ShowIgnoreErrorAfter}
|
||||
writeln('TCustomCodeTool.RaiseLastErrorIfInFrontOfCleanedPos A ACleanedPos=',ACleanedPos,
|
||||
' ');
|
||||
{$ENDIF}
|
||||
if Scanner<>nil then Scanner.RaiseLastErrorIfInFrontOfCleanedPos(ACleanedPos);
|
||||
//writeln('TCustomCodeTool.RaiseLastErrorIfInFrontOfCleanedPos B ',LastErrorPhase<CodeToolPhaseTool,' ',LastErrorCurPos.EndPos);
|
||||
if LastErrorValid
|
||||
and (LastErrorCurPos.EndPos<=ACleanedPos) then
|
||||
RaiseLastError;
|
||||
//writeln('TCustomCodeTool.RaiseLastErrorIfInFrontOfCleanedPos END ');
|
||||
end;
|
||||
|
||||
function TCustomCodeTool.StringIsKeyWord(const Word: string): boolean;
|
||||
begin
|
||||
Result:=(Word<>'') and IsIdentStartChar[Word[1]]
|
||||
@ -1487,12 +1591,23 @@ begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
procedure TCustomCodeTool.SetIgnoreAfterCodeXY(const AValue: TCodeXYPosition);
|
||||
procedure TCustomCodeTool.SetIgnoreErrorAfter(const AValue: TCodePosition);
|
||||
begin
|
||||
if (FIgnoreAfterCodeXY.Code=AValue.Code)
|
||||
and (FIgnoreAfterCodeXY.X=AValue.X)
|
||||
and (FIgnoreAfterCodeXY.Y=AValue.Y) then exit;
|
||||
FIgnoreAfterCodeXY:=AValue;
|
||||
if (IgnoreErrorAfter.Code=AValue.Code)
|
||||
and (IgnoreErrorAfter.P=AValue.P) then exit;
|
||||
FIgnoreErrorAfter:=AValue;
|
||||
LastErrorCheckedForIgnored:=false;
|
||||
{$IFDEF ShowIgnoreErrorAfter}
|
||||
write('TCustomCodeTool.SetIgnoreErrorAfter ');
|
||||
if FIgnoreErrorAfter.Code<>nil then
|
||||
write(FIgnoreErrorAfter.Code.Filename)
|
||||
else
|
||||
write('nil');
|
||||
write(' ',FIgnoreErrorAfter.P);
|
||||
writeln('');
|
||||
{$ENDIF}
|
||||
if Scanner<>nil then
|
||||
Scanner.SetIgnoreErrorAfter(IgnoreErrorAfter.P,IgnoreErrorAfter.Code);
|
||||
end;
|
||||
|
||||
function TCustomCodeTool.DefaultKeyWordFunc: boolean;
|
||||
@ -1729,9 +1844,9 @@ begin
|
||||
Result:=StartPos;
|
||||
end;
|
||||
|
||||
procedure TCustomCodeTool.ClearIgnoreAfterPosition;
|
||||
procedure TCustomCodeTool.ClearIgnoreErrorAfter;
|
||||
begin
|
||||
FIgnoreAfterCodeXY.Code:=nil;
|
||||
IgnoreErrorAfter:=CodePosition(0,nil);
|
||||
end;
|
||||
|
||||
function TCustomCodeTool.UpdateNeeded(OnlyInterfaceNeeded: boolean): boolean;
|
||||
|
||||
@ -49,7 +49,7 @@ interface
|
||||
|
||||
{ $DEFINE CTDEBUG}
|
||||
{ $DEFINE ShowSearchPaths}
|
||||
{$DEFINE ShowTriedFiles}
|
||||
{ $DEFINE ShowTriedFiles}
|
||||
{ $DEFINE ShowTriedContexts}
|
||||
{ $DEFINE ShowTriedIdentifiers}
|
||||
{ $DEFINE ShowExprEval}
|
||||
@ -59,6 +59,7 @@ interface
|
||||
{ $DEFINE ShowBaseTypeCache}
|
||||
{ $DEFINE ShowCacheDependencies}
|
||||
{ $DEFINE ShowCollect}
|
||||
{ $DEFINE IgnoreErrorAfterCursor}
|
||||
|
||||
|
||||
uses
|
||||
@ -765,13 +766,13 @@ begin
|
||||
Result:=false;
|
||||
SkipChecks:=false;
|
||||
ActivateGlobalWriteLock;
|
||||
IgnoreAfterCodeXY:=CursorPos;
|
||||
try
|
||||
// build code tree
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln(DebugPrefix,'TFindDeclarationTool.FindDeclaration A CursorPos=',CursorPos.X,',',CursorPos.Y);
|
||||
{$ENDIF}
|
||||
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos);
|
||||
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
|
||||
[{$IFDEF IgnoreErrorAfterCursor}btSetIgnoreErrorPos{$ENDIF}]);
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln(DebugPrefix,'TFindDeclarationTool.FindDeclaration C CleanCursorPos=',CleanCursorPos);
|
||||
{$ENDIF}
|
||||
@ -847,7 +848,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
ClearIgnoreAfterPosition;
|
||||
ClearIgnoreErrorAfter;
|
||||
DeactivateGlobalWriteLock;
|
||||
end;
|
||||
end;
|
||||
@ -1328,9 +1329,10 @@ var
|
||||
BuildSubTreeForClass(ContextNode);
|
||||
end;
|
||||
if (ContextNode.LastChild<>nil) then begin
|
||||
if not (fdfSearchForward in Params.Flags) then
|
||||
if not (fdfSearchForward in Params.Flags) then begin
|
||||
RaiseLastErrorIfInFrontOfCleanedPos(ContextNode.EndPos);
|
||||
ContextNode:=ContextNode.LastChild
|
||||
else
|
||||
end else
|
||||
ContextNode:=ContextNode.FirstChild;
|
||||
end;
|
||||
end;
|
||||
@ -1464,8 +1466,10 @@ var
|
||||
// search next in prior/next brother
|
||||
if not (fdfSearchForward in Params.Flags) then
|
||||
ContextNode:=ContextNode.PriorBrother
|
||||
else
|
||||
else begin
|
||||
RaiseLastErrorIfInFrontOfCleanedPos(ContextNode.NextBrother.EndPos);
|
||||
ContextNode:=ContextNode.NextBrother;
|
||||
end;
|
||||
{$IFDEF ShowTriedIdentifiers}
|
||||
writeln('[TFindDeclarationTool.FindIdentifierInContext] Searching in Brother ContextNode=',ContextNode.DescAsString);
|
||||
{$ENDIF}
|
||||
|
||||
@ -37,6 +37,8 @@ unit LinkScanner;
|
||||
|
||||
{$I codetools.inc}
|
||||
|
||||
{ $DEFINE ShowIgnoreErrorAfter}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
@ -129,6 +131,8 @@ type
|
||||
FOnCheckFileOnDisk: TOnCheckFileOnDisk;
|
||||
FOnGetInitValues: TOnGetInitValues;
|
||||
FOnIncludeCode: TOnIncludeCode;
|
||||
FIgnoreErrorAfterCode: Pointer;
|
||||
FIgnoreErrorAfterCursorPos: integer;
|
||||
FInitValues: TExpressionEvaluator;
|
||||
FInitValuesChangeStep: integer;
|
||||
FSourceChangeSteps: TList; // list of PSourceChangeStep sorted with Code
|
||||
@ -226,6 +230,9 @@ type
|
||||
LastErrorSrcPos: integer;
|
||||
LastErrorCode: pointer;
|
||||
LastErrorIsValid: boolean;
|
||||
LastErrorBehindIgnorePosition: boolean;
|
||||
LastErrorCheckedForIgnored: boolean;
|
||||
CleanedIgnoreErrorAfterPosition: integer;
|
||||
procedure RaiseExceptionFmt(const AMessage: string; args: array of const);
|
||||
procedure RaiseException(const AMessage: string);
|
||||
procedure ClearLastError;
|
||||
@ -244,6 +251,7 @@ type
|
||||
EndOfInterfaceFound: boolean;
|
||||
EndOfSourceFound: boolean;
|
||||
|
||||
// links
|
||||
property Links[Index: integer]: TSourceLink read GetLinks write SetLinks;
|
||||
function LinkCount: integer;
|
||||
function LinkIndexAtCleanPos(ACleanPos: integer): integer;
|
||||
@ -253,6 +261,7 @@ type
|
||||
function FindFirstSiblingLink(LinkIndex: integer): integer;
|
||||
function FindParentLink(LinkIndex: integer): integer;
|
||||
|
||||
// source mapping (Cleaned <-> Original)
|
||||
function CleanedSrc: string;
|
||||
function CursorToCleanPos(ACursorPos: integer; ACode: pointer;
|
||||
var ACleanPos: integer): integer; // 0=valid CleanPos
|
||||
@ -260,12 +269,40 @@ type
|
||||
// 1=CursorPos beyond scanned code
|
||||
function CleanedPosToCursor(ACleanedPos: integer; var ACursorPos: integer;
|
||||
var ACode: Pointer): boolean;
|
||||
function LastErrorsInFrontOfCleanedPos(ACleanedPos: integer): boolean;
|
||||
procedure RaiseLastErrorIfInFrontOfCleanedPos(ACleanedPos: integer);
|
||||
|
||||
// ranges
|
||||
function WholeRangeIsWritable(CleanStartPos, CleanEndPos: integer): boolean;
|
||||
procedure FindCodeInRange(CleanStartPos, CleanEndPos: integer;
|
||||
UniqueSortedCodeList: TList);
|
||||
procedure DeleteRange(CleanStartPos,CleanEndPos: integer);
|
||||
|
||||
|
||||
// scanning
|
||||
procedure Scan(TillInterfaceEnd, CheckFilesOnDisk: boolean);
|
||||
function UpdateNeeded(OnlyInterfaceNeeded,
|
||||
CheckFilesOnDisk: boolean): boolean;
|
||||
procedure SetIgnoreErrorAfter(ACursorPos: integer; ACode: Pointer);
|
||||
procedure ClearIgnoreErrorAfter;
|
||||
function IgnoreErrAfterPositionIsInFrontOfLastErrMessage: boolean;
|
||||
function IgnoreErrorAfterCleanedPos: integer;
|
||||
function IgnoreErrorAfterValid: boolean;
|
||||
|
||||
function GuessMisplacedIfdefEndif(StartCursorPos: integer;
|
||||
StartCode: pointer;
|
||||
var EndCursorPos: integer; var EndCode: Pointer): boolean;
|
||||
|
||||
property ChangeStep: integer read FChangeStep;
|
||||
|
||||
// global write lock
|
||||
procedure ActivateGlobalWriteLock;
|
||||
procedure DeactivateGlobalWriteLock;
|
||||
property OnGetGlobalWriteLockInfo: TOnGetWriteLockInfo
|
||||
read FOnGetGlobalWriteLockInfo write FOnGetGlobalWriteLockInfo;
|
||||
property OnSetGlobalWriteLock: TOnSetWriteLock
|
||||
read FOnSetGlobalWriteLock write FOnSetGlobalWriteLock;
|
||||
|
||||
// properties
|
||||
property OnGetSource: TOnGetSource read FOnGetSource write FOnGetSource;
|
||||
property OnLoadSource: TOnLoadSource read FOnLoadSource write FOnLoadSource;
|
||||
property OnDeleteSource: TOnDeleteSource
|
||||
@ -294,22 +331,6 @@ type
|
||||
property ScanTillInterfaceEnd: boolean
|
||||
read FScanTillInterfaceEnd write SetScanTillInterfaceEnd;
|
||||
|
||||
procedure Scan(TillInterfaceEnd, CheckFilesOnDisk: boolean);
|
||||
function UpdateNeeded(OnlyInterfaceNeeded,
|
||||
CheckFilesOnDisk: boolean): boolean;
|
||||
function GuessMisplacedIfdefEndif(StartCursorPos: integer;
|
||||
StartCode: pointer;
|
||||
var EndCursorPos: integer; var EndCode: Pointer): boolean;
|
||||
|
||||
property ChangeStep: integer read FChangeStep;
|
||||
|
||||
procedure ActivateGlobalWriteLock;
|
||||
procedure DeactivateGlobalWriteLock;
|
||||
property OnGetGlobalWriteLockInfo: TOnGetWriteLockInfo
|
||||
read FOnGetGlobalWriteLockInfo write FOnGetGlobalWriteLockInfo;
|
||||
property OnSetGlobalWriteLock: TOnSetWriteLock
|
||||
read FOnSetGlobalWriteLock write FOnSetGlobalWriteLock;
|
||||
|
||||
procedure Clear;
|
||||
function ConsistencyCheck: integer;
|
||||
procedure WriteDebugReport;
|
||||
@ -890,8 +911,13 @@ var LastTokenType: TLSTokenType;
|
||||
s: string;
|
||||
begin
|
||||
if not UpdateNeeded(TillInterfaceEnd,CheckFilesOnDisk) then begin
|
||||
// no input has changed -> the output is the same
|
||||
if LastErrorIsValid then RaiseLastError;
|
||||
// input is the same as last time -> output is the same
|
||||
// -> if there was an error, raise it again
|
||||
if LastErrorIsValid
|
||||
and ((not IgnoreErrorAfterValid)
|
||||
or (not IgnoreErrAfterPositionIsInFrontOfLastErrMessage))
|
||||
then
|
||||
RaiseLastError;
|
||||
exit;
|
||||
end;
|
||||
{$IFDEF CTDEBUG}
|
||||
@ -941,26 +967,35 @@ begin
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TLinkScanner.Scan F ',SrcLen);
|
||||
{$ENDIF}
|
||||
repeat
|
||||
ReadNextToken;
|
||||
//writeln('TLinkScanner.Scan G "',copy(Src,TokenStart,SrcPos-TokenStart),'"');
|
||||
UpdateCleanedSource(SrcPos-1);
|
||||
if (SrcPos<=SrcLen+1) then begin
|
||||
if (LastTokenType<>lsttEqual)
|
||||
and (TokenType=lsttEndOfInterface) then begin
|
||||
EndOfInterfaceFound:=true
|
||||
end else if (LastTokenType=lsttEnd) and (TokenType=lsttPoint) then begin
|
||||
EndOfInterfaceFound:=true;
|
||||
EndOfSourceFound:=true;
|
||||
try
|
||||
repeat
|
||||
ReadNextToken;
|
||||
//writeln('TLinkScanner.Scan G "',copy(Src,TokenStart,SrcPos-TokenStart),'"');
|
||||
UpdateCleanedSource(SrcPos-1);
|
||||
if (SrcPos<=SrcLen+1) then begin
|
||||
if (LastTokenType<>lsttEqual)
|
||||
and (TokenType=lsttEndOfInterface) then begin
|
||||
EndOfInterfaceFound:=true
|
||||
end else if (LastTokenType=lsttEnd) and (TokenType=lsttPoint) then begin
|
||||
EndOfInterfaceFound:=true;
|
||||
EndOfSourceFound:=true;
|
||||
break;
|
||||
end;
|
||||
LastTokenType:=TokenType;
|
||||
end else
|
||||
break;
|
||||
end;
|
||||
LastTokenType:=TokenType;
|
||||
end else
|
||||
break;
|
||||
until (SrcPos>SrcLen) or EndOfSourceFound
|
||||
or (ScanTillInterfaceEnd and EndOfInterfaceFound);
|
||||
IncreaseChangeStep;
|
||||
FForceUpdateNeeded:=false;
|
||||
until (SrcPos>SrcLen) or EndOfSourceFound
|
||||
or (ScanTillInterfaceEnd and EndOfInterfaceFound);
|
||||
IncreaseChangeStep;
|
||||
FForceUpdateNeeded:=false;
|
||||
except
|
||||
if (not IgnoreErrorAfterValid)
|
||||
or (not IgnoreErrAfterPositionIsInFrontOfLastErrMessage) then
|
||||
raise;
|
||||
{$IFDEF ShowIgnoreErrorAfter}
|
||||
writeln('TLinkScanner.Scan IGNORING ERROR: ',LastErrorMessage);
|
||||
{$ENDIF}
|
||||
end;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TLinkScanner.Scan END ',CleanedLen);
|
||||
{$ENDIF}
|
||||
@ -1266,6 +1301,100 @@ begin
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
procedure TLinkScanner.SetIgnoreErrorAfter(ACursorPos: integer; ACode: Pointer
|
||||
);
|
||||
begin
|
||||
if (FIgnoreErrorAfterCode=ACode)
|
||||
and (FIgnoreErrorAfterCursorPos=ACursorPos) then exit;
|
||||
FIgnoreErrorAfterCode:=ACode;
|
||||
FIgnoreErrorAfterCursorPos:=ACursorPos;
|
||||
LastErrorCheckedForIgnored:=false;
|
||||
{$IFDEF ShowIgnoreErrorAfter}
|
||||
write('TLinkScanner.SetIgnoreErrorAfter ');
|
||||
if FIgnoreErrorAfterCode<>nil then
|
||||
write(OnGetFileName(Self,FIgnoreErrorAfterCode))
|
||||
else
|
||||
write('nil');
|
||||
write(' ',FIgnoreErrorAfterCursorPos);
|
||||
writeln('');
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TLinkScanner.ClearIgnoreErrorAfter;
|
||||
begin
|
||||
SetIgnoreErrorAfter(0,nil);
|
||||
end;
|
||||
|
||||
function TLinkScanner.IgnoreErrAfterPositionIsInFrontOfLastErrMessage: boolean;
|
||||
var
|
||||
CleanResult: integer;
|
||||
begin
|
||||
//writeln('TLinkScanner.IgnoreErrAfterPositionIsInFrontOfLastErrMessage');
|
||||
//writeln(' LastErrorCheckedForIgnored=',LastErrorCheckedForIgnored,
|
||||
// ' LastErrorBehindIgnorePosition=',LastErrorBehindIgnorePosition);
|
||||
if LastErrorCheckedForIgnored then
|
||||
Result:=LastErrorBehindIgnorePosition
|
||||
else begin
|
||||
CleanedIgnoreErrorAfterPosition:=-1;
|
||||
if (FIgnoreErrorAfterCode<>nil) and (FIgnoreErrorAfterCursorPos>0) then
|
||||
begin
|
||||
CleanResult:=CursorToCleanPos(FIgnoreErrorAfterCursorPos,
|
||||
FIgnoreErrorAfterCode,CleanedIgnoreErrorAfterPosition);
|
||||
//writeln(' CleanResult=',CleanResult,
|
||||
// ' CleanedIgnoreErrorAfterPosition=',CleanedIgnoreErrorAfterPosition,
|
||||
// ' FIgnoreErrorAfterCursorPos=',FIgnoreErrorAfterCursorPos);
|
||||
if (CleanResult=0) or (CleanResult=-1)
|
||||
or (not LastErrorIsValid) then begin
|
||||
Result:=true;
|
||||
end else begin
|
||||
Result:=false;
|
||||
end;
|
||||
end else begin
|
||||
Result:=false;
|
||||
end;
|
||||
LastErrorBehindIgnorePosition:=Result;
|
||||
LastErrorCheckedForIgnored:=true;
|
||||
end;
|
||||
{$IFDEF ShowIgnoreErrorAfter}
|
||||
writeln('TLinkScanner.IgnoreErrAfterPositionIsInFrontOfLastErrMessage Result=',Result);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TLinkScanner.IgnoreErrorAfterCleanedPos: integer;
|
||||
begin
|
||||
if IgnoreErrAfterPositionIsInFrontOfLastErrMessage then
|
||||
Result:=CleanedIgnoreErrorAfterPosition
|
||||
else
|
||||
Result:=-1;
|
||||
{$IFDEF ShowIgnoreErrorAfter}
|
||||
writeln('TLinkScanner.IgnoreErrorAfterCleanedPos Result=',Result);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TLinkScanner.IgnoreErrorAfterValid: boolean;
|
||||
begin
|
||||
Result:=(FIgnoreErrorAfterCode<>nil);
|
||||
{$IFDEF ShowIgnoreErrorAfter}
|
||||
writeln('TLinkScanner.IgnoreErrorAfterValid Result=',Result);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TLinkScanner.LastErrorsInFrontOfCleanedPos(ACleanedPos: integer
|
||||
): boolean;
|
||||
begin
|
||||
Result:=LastErrorIsValid and (CleanedLen>ACleanedPos);
|
||||
{$IFDEF ShowIgnoreErrorAfter}
|
||||
writeln('TLinkScanner.LastErrorsInFrontOfCleanedPos Result=',Result);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TLinkScanner.RaiseLastErrorIfInFrontOfCleanedPos(ACleanedPos: integer
|
||||
);
|
||||
begin
|
||||
if LastErrorsInFrontOfCleanedPos(ACleanedPos) then
|
||||
RaiseLastError;
|
||||
end;
|
||||
|
||||
{-------------------------------------------------------------------------------
|
||||
function TLinkScanner.GuessMisplacedIfdefEndif
|
||||
Params: StartCursorPos: integer; StartCode: pointer;
|
||||
@ -2525,12 +2654,14 @@ begin
|
||||
LastErrorMessage:=AMessage;
|
||||
LastErrorSrcPos:=SrcPos;
|
||||
LastErrorCode:=Code;
|
||||
LastErrorCheckedForIgnored:=false;
|
||||
raise ELinkScannerError.Create(Self,AMessage);
|
||||
end;
|
||||
|
||||
procedure TLinkScanner.ClearLastError;
|
||||
begin
|
||||
LastErrorIsValid:=false;
|
||||
LastErrorCheckedForIgnored:=false;
|
||||
end;
|
||||
|
||||
procedure TLinkScanner.RaiseLastError;
|
||||
|
||||
@ -265,7 +265,7 @@ begin
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint A CursorPos=',CursorPos.X,',',CursorPos.Y);
|
||||
{$ENDIF}
|
||||
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos);
|
||||
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
|
||||
GetLineInfo(CleanCursorPos,LineStart,LineEnd,FirstAtomStart,LastAtomEnd);
|
||||
if CleanCursorPos<FirstAtomStart then CleanCursorPos:=FirstAtomStart;
|
||||
if CleanCursorPos>=LastAtomEnd then CleanCursorPos:=LastAtomEnd-1;
|
||||
|
||||
@ -35,6 +35,8 @@ interface
|
||||
|
||||
{$I codetools.inc}
|
||||
|
||||
{ $DEFINE ShowIgnoreErrorAfter}
|
||||
|
||||
uses
|
||||
{$IFDEF MEM_CHECK}
|
||||
MemCheck,
|
||||
@ -83,6 +85,9 @@ type
|
||||
|
||||
TTreeRange = (trInterface, trAll, trTillCursor);
|
||||
|
||||
TBuildTreeFlag = (btSetIgnoreErrorPos,btKeepIgnoreErrorPos);
|
||||
TBuildTreeFlags = set of TBuildTreeFlag;
|
||||
|
||||
TPascalParserTool = class(TMultiKeyWordListCodeTool)
|
||||
private
|
||||
protected
|
||||
@ -179,13 +184,14 @@ type
|
||||
|
||||
procedure BuildTree(OnlyInterfaceNeeded: boolean); virtual;
|
||||
procedure BuildTreeAndGetCleanPos(TreeRange: TTreeRange;
|
||||
CursorPos: TCodeXYPosition; var CleanCursorPos: integer);
|
||||
CursorPos: TCodeXYPosition; var CleanCursorPos: integer;
|
||||
BuildTreeFlags: TBuildTreeFlags);
|
||||
procedure BuildSubTreeForClass(ClassNode: TCodeTreeNode); virtual;
|
||||
procedure BuildSubTreeForBeginBlock(BeginNode: TCodeTreeNode); virtual;
|
||||
procedure BuildSubTreeForProcHead(ProcNode: TCodeTreeNode); virtual;
|
||||
procedure BuildSubTreeForProcHead(ProcNode: TCodeTreeNode;
|
||||
var FunctionResult: TCodeTreeNode);
|
||||
|
||||
|
||||
function DoAtom: boolean; override;
|
||||
|
||||
function ExtractPropName(PropNode: TCodeTreeNode;
|
||||
@ -435,9 +441,12 @@ begin
|
||||
writeln('TPascalParserTool.BuildTree A');
|
||||
{$ENDIF}
|
||||
if not UpdateNeeded(OnlyInterfaceNeeded) then begin
|
||||
// input has not changed
|
||||
// input is the same as last time -> output is the same
|
||||
// -> if there was an error, raise it again
|
||||
if LastErrorPhase in [CodeToolPhaseScan,CodeToolPhaseParse] then
|
||||
if (LastErrorPhase in [CodeToolPhaseScan,CodeToolPhaseParse])
|
||||
and ((not IgnoreErrorAfterValid)
|
||||
or (not IgnoreErrAfterPositionIsInFrontOfLastErrMessage))
|
||||
then
|
||||
RaiseLastError;
|
||||
exit;
|
||||
end;
|
||||
@ -455,48 +464,60 @@ begin
|
||||
ImplementationSectionFound:=false;
|
||||
EndOfSourceFound:=false;
|
||||
|
||||
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]);
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=CurSection;
|
||||
ReadNextAtom; // read source name
|
||||
AtomIsIdentifier(true);
|
||||
ReadNextAtom; // read ';'
|
||||
if (CurPos.Flag<>cafSemicolon) then
|
||||
RaiseCharExpectedButAtomFound(';');
|
||||
if CurSection=ctnUnit then begin
|
||||
try
|
||||
ReadNextAtom;
|
||||
CurNode.EndPos:=CurPos.StartPos;
|
||||
EndChildNode;
|
||||
if not UpAtomIs('INTERFACE') then
|
||||
RaiseStringExpectedButAtomFound('"interface"');
|
||||
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]);
|
||||
CreateChildNode;
|
||||
CurSection:=ctnInterface;
|
||||
CurNode.Desc:=CurSection;
|
||||
end;
|
||||
InterfaceSectionFound:=true;
|
||||
ReadNextAtom;
|
||||
if UpAtomIs('USES') then
|
||||
ReadUsesSection(true);
|
||||
repeat
|
||||
//writeln('[TPascalParserTool.BuildTree] ALL '+GetAtom);
|
||||
if not DoAtom then break;
|
||||
if CurSection=ctnNone then begin
|
||||
EndOfSourceFound:=true;
|
||||
break;
|
||||
ReadNextAtom; // read source name
|
||||
AtomIsIdentifier(true);
|
||||
ReadNextAtom; // read ';'
|
||||
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;
|
||||
InterfaceSectionFound:=true;
|
||||
ReadNextAtom;
|
||||
until (CurPos.StartPos>SrcLen);
|
||||
FForceUpdateNeeded:=false;
|
||||
if UpAtomIs('USES') then
|
||||
ReadUsesSection(true);
|
||||
repeat
|
||||
//writeln('[TPascalParserTool.BuildTree] ALL '+GetAtom);
|
||||
if not DoAtom then break;
|
||||
if CurSection=ctnNone then begin
|
||||
EndOfSourceFound:=true;
|
||||
break;
|
||||
end;
|
||||
ReadNextAtom;
|
||||
until (CurPos.StartPos>SrcLen);
|
||||
FForceUpdateNeeded:=false;
|
||||
except
|
||||
{$IFDEF ShowIgnoreErrorAfter}
|
||||
writeln('TPascalParserTool.BuildTree ',MainFilename,' ERROR: ',LastErrorMessage);
|
||||
{$ENDIF}
|
||||
if (not IgnoreErrorAfterValid)
|
||||
or (not IgnoreErrAfterPositionIsInFrontOfLastErrMessage) then
|
||||
raise;
|
||||
{$IFDEF ShowIgnoreErrorAfter}
|
||||
writeln('TPascalParserTool.BuildTree ',MainFilename,' IGNORING ERROR: ',LastErrorMessage);
|
||||
{$ENDIF}
|
||||
end;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('[TPascalParserTool.BuildTree] END');
|
||||
{$ENDIF}
|
||||
@ -3671,13 +3692,30 @@ end;
|
||||
|
||||
procedure TPascalParserTool.BuildTreeAndGetCleanPos(
|
||||
TreeRange: TTreeRange; CursorPos: TCodeXYPosition;
|
||||
var CleanCursorPos: integer);
|
||||
var Dummy: integer;
|
||||
var CleanCursorPos: integer; BuildTreeFlags: TBuildTreeFlags);
|
||||
var
|
||||
Dummy: integer;
|
||||
IgnorePos: TCodePosition;
|
||||
begin
|
||||
if (btSetIgnoreErrorPos in BuildTreeFlags) then begin
|
||||
if (CursorPos.Code<>nil) then begin
|
||||
IgnorePos.Code:=CursorPos.Code;
|
||||
IgnorePos.Code.LineColToPosition(CursorPos.Y,CursorPos.X,IgnorePos.P);
|
||||
if IgnorePos.P<1 then IgnorePos.Code:=nil;
|
||||
IgnoreErrorAfter:=IgnorePos;
|
||||
end else
|
||||
ClearIgnoreErrorAfter;
|
||||
end
|
||||
else if (btKeepIgnoreErrorPos in BuildTreeFlags) then
|
||||
ClearIgnoreErrorAfter;
|
||||
|
||||
if (TreeRange=trTillCursor) and (not UpdateNeeded(true)) then begin
|
||||
// interface tree is valid
|
||||
// -> if there was an error, raise it again
|
||||
if LastErrorPhase in [CodeToolPhaseScan,CodeToolPhaseParse] then
|
||||
if (LastErrorPhase in [CodeToolPhaseScan,CodeToolPhaseParse])
|
||||
and ((not IgnoreErrorAfterValid)
|
||||
or (not IgnoreErrAfterPositionIsInFrontOfLastErrMessage))
|
||||
then
|
||||
RaiseLastError;
|
||||
// check if cursor is in interface
|
||||
Dummy:=CaretToCleanPos(CursorPos, CleanCursorPos);
|
||||
@ -3685,12 +3723,12 @@ begin
|
||||
exit;
|
||||
end;
|
||||
BuildTree(TreeRange=trInterface);
|
||||
if not EndOfSourceFound then
|
||||
if (not IgnoreErrorAfterValid) and (not EndOfSourceFound) then
|
||||
SaveRaiseException(ctsEndOfSourceNotFound);
|
||||
// find the CursorPos in cleaned source
|
||||
Dummy:=CaretToCleanPos(CursorPos, CleanCursorPos);
|
||||
if (Dummy<>0) and (Dummy<>-1) then
|
||||
SaveRaiseException(ctsCursorPosOutsideOfCode);
|
||||
RaiseException(ctsCursorPosOutsideOfCode);
|
||||
end;
|
||||
|
||||
function TPascalParserTool.FindTypeNodeOfDefinition(
|
||||
|
||||
@ -38,6 +38,8 @@ interface
|
||||
|
||||
{$I codetools.inc}
|
||||
|
||||
{ $DEFINE IgnoreErrorAfterCursor}
|
||||
|
||||
uses
|
||||
{$IFDEF MEM_CHECK}
|
||||
MemCheck,
|
||||
@ -1471,16 +1473,21 @@ var
|
||||
CleanCursorPos, LinkIndex, NewCleanPos: integer;
|
||||
begin
|
||||
Result:=false;
|
||||
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos);
|
||||
LinkIndex:=Scanner.LinkIndexAtCleanPos(CleanCursorPos);
|
||||
LinkIndex:=Scanner.FindParentLink(LinkIndex);
|
||||
if LinkIndex<0 then
|
||||
// this is no include file
|
||||
exit;
|
||||
NewPos.Code:=TCodeBuffer(Scanner.Links[LinkIndex].Code);
|
||||
// calculate the directive end bracket
|
||||
NewCleanPos:=Scanner.Links[LinkIndex].CleanedPos+Scanner.LinkSize(LinkIndex)-1;
|
||||
Result:=CleanPosToCaretAndTopLine(NewCleanPos,NewPos,NewTopLine);
|
||||
try
|
||||
BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,
|
||||
[{$IFDEF IgnoreErrorAfterCursor}btSetIgnoreErrorPos{$ENDIF}]);
|
||||
LinkIndex:=Scanner.LinkIndexAtCleanPos(CleanCursorPos);
|
||||
LinkIndex:=Scanner.FindParentLink(LinkIndex);
|
||||
if LinkIndex<0 then
|
||||
// this is no include file
|
||||
exit;
|
||||
NewPos.Code:=TCodeBuffer(Scanner.Links[LinkIndex].Code);
|
||||
// calculate the directive end bracket
|
||||
NewCleanPos:=Scanner.Links[LinkIndex].CleanedPos+Scanner.LinkSize(LinkIndex)-1;
|
||||
Result:=CleanPosToCaretAndTopLine(NewCleanPos,NewPos,NewTopLine);
|
||||
finally
|
||||
ClearIgnoreErrorAfter;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TStandardCodeTool.ReadTilGuessedUnclosedBlock(
|
||||
|
||||
Loading…
Reference in New Issue
Block a user