From 7460fce057db2c4108b9045cf4157a54651c8b5e Mon Sep 17 00:00:00 2001 From: lazarus Date: Thu, 19 Sep 2002 14:53:38 +0000 Subject: [PATCH] MG: implemented IgnoreErrorAfter position for codetools git-svn-id: trunk@3362 - --- components/codetools/codeatom.pas | 7 + components/codetools/customcodetool.pas | 145 +++++++++++-- components/codetools/finddeclarationtool.pas | 18 +- components/codetools/linkscanner.pas | 207 +++++++++++++++---- components/codetools/methodjumptool.pas | 2 +- components/codetools/pascalparsertool.pas | 130 +++++++----- components/codetools/stdcodetools.pas | 27 ++- 7 files changed, 419 insertions(+), 117 deletions(-) diff --git a/components/codetools/codeatom.pas b/components/codetools/codeatom.pas index 5512d10e32..acdede31e4 100644 --- a/components/codetools/codeatom.pas +++ b/components/codetools/codeatom.pas @@ -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 } diff --git a/components/codetools/customcodetool.pas b/components/codetools/customcodetool.pas index 16c6338112..51a2b18931 100644 --- a/components/codetools/customcodetool.pas +++ b/components/codetools/customcodetool.pas @@ -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'') 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; diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 6424062365..17f25add36 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -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} diff --git a/components/codetools/linkscanner.pas b/components/codetools/linkscanner.pas index bd16125a70..54467c4906 100644 --- a/components/codetools/linkscanner.pas +++ b/components/codetools/linkscanner.pas @@ -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; diff --git a/components/codetools/methodjumptool.pas b/components/codetools/methodjumptool.pas index d136f25f81..96fdd30cbf 100644 --- a/components/codetools/methodjumptool.pas +++ b/components/codetools/methodjumptool.pas @@ -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=LastAtomEnd then CleanCursorPos:=LastAtomEnd-1; diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index 317ccccb9f..9cfc9bf5ab 100644 --- a/components/codetools/pascalparsertool.pas +++ b/components/codetools/pascalparsertool.pas @@ -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( diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index b51a777e6c..5f1933baa9 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -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(