diff --git a/components/codetools/basiccodetools.pas b/components/codetools/basiccodetools.pas index a641002834..06d0162ffc 100644 --- a/components/codetools/basiccodetools.pas +++ b/components/codetools/basiccodetools.pas @@ -2229,7 +2229,7 @@ var SrcStart: integer; begin dec(P); while (P>=SrcStart) and (Source[P]<>'{') do begin - if NestedComments and (Source[P] in ['}',')']) then + if NestedComments and (Source[P]='}') then ReadComment(P) else dec(P); @@ -2245,7 +2245,7 @@ var SrcStart: integer; dec(P); while (P>SrcStart) and ((Source[P-1]<>'(') or (Source[P]<>'*')) do begin - if NestedComments and (Source[P] in ['}',')']) then + if NestedComments and ((Source[P]=')') and (Source[P-1]='*')) then ReadComment(P) else dec(P); diff --git a/components/codetools/customcodetool.pas b/components/codetools/customcodetool.pas index deeb859602..779aecc2f1 100644 --- a/components/codetools/customcodetool.pas +++ b/components/codetools/customcodetool.pas @@ -1697,7 +1697,7 @@ begin CurrentPhase:=CodeToolPhaseScan; try if OnlyInterfaceNeeded then - LinkScanRange:=lsrInterface + LinkScanRange:=lsrImplementationStart else LinkScanRange:=lsrEnd; Scanner.Scan(LinkScanRange,CheckFilesOnDisk); @@ -2460,7 +2460,7 @@ begin Result:=true; end else begin if OnlyInterfaceNeeded then - LinkScanRange:=lsrInterface + LinkScanRange:=lsrImplementationStart else LinkScanRange:=lsrEnd; Result:=Scanner.UpdateNeeded(LinkScanRange, CheckFilesOnDisk); diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 863eed9a86..c31066d3a2 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -1920,8 +1920,8 @@ var NewInFilename: String; NewCompiledUnitname: String; begin - {$IFDEF ShowTriedFiles} - DebugLn('TFindDeclarationTool.FindUnitSource A AnUnitName="',AnUnitName,'" AnUnitInFilename="',AnUnitInFilename,'" Self="',MainFilename,'"'); + {$IF defined(ShowTriedFiles) or defined(ShowTriedUnits)} + DebugLn('TFindDeclarationTool.FindUnitSource Self="',MainFilename,'" AnUnitName="',AnUnitName,'" AnUnitInFilename="',AnUnitInFilename,'"'); {$ENDIF} Result:=nil; if (AnUnitName='') or (Scanner=nil) or (Scanner.MainCode=nil) @@ -3005,7 +3005,7 @@ begin raise; end; end;} - // if we are here, the identifier was not found + // if we are here, the identifier was not found and there was no error if (FirstSearchedNode<>nil) and (Params.FoundProc=nil) and (not (fdfCollect in Params.Flags)) then begin // add result to cache @@ -5203,7 +5203,7 @@ begin RaiseException('unit '+AnUnitName+' not found'); end else begin // source found -> get codetool for it - {$IFDEF ShowTriedFiles} + {$IF defined(ShowTriedFiles) or defined(ShowTriedUnits)} DebugLn('[TFindDeclarationTool.FindCodeToolForUsedUnit] ', ' This source is=',TCodeBuffer(Scanner.MainCode).Filename, ' NewCode=',NewCode.Filename); @@ -5434,7 +5434,9 @@ var Node: TCodeTreeNode; begin // build tree for pascal source + debugln(['TFindDeclarationTool.BuildInterfaceIdentifierCache BEFORE ',MainFilename]); BuildTree(true); + debugln(['TFindDeclarationTool.BuildInterfaceIdentifierCache AFTER ',MainFilename]); // search interface section InterfaceNode:=FindInterfaceNode; @@ -6527,7 +6529,7 @@ begin ' StartContext=',StartContext.Node.DescAsString,'=',dbgstr(copy(StartContext.Tool.Src,StartContext.Node.StartPos,15)) ); {$ENDIF} - + if not InitAtomQueue then exit; {$IFDEF ShowExprEval} DebugLn(['TFindDeclarationTool.FindExpressionTypeOfVariable Expression="',copy(Src,StartPos,EndPos-StartPos),'"']); @@ -8465,7 +8467,7 @@ begin end; {$IFDEF ShowNodeCache} - beVerbose:=CompareSrcIdentifiers(Params.Identifier,'InitDecompressor'); + beVerbose:=true; //CompareSrcIdentifiers(Params.Identifier,'InitDecompressor'); if beVerbose then begin DebugLn('(((((((((((((((((((((((((((=================='); @@ -8503,6 +8505,7 @@ begin ' NewTool=',ExtractFileName(NewTool.MainFilename)); end else begin DebugLn(' NOT FOUND'); + //RaiseCatchableException(''); end; DebugLn(' CleanStartPos=',DbgS(CleanStartPos),' ',WriteSrcPos(Self,CleanStartPos)); diff --git a/components/codetools/linkscanner.pas b/components/codetools/linkscanner.pas index 61a85e1265..ca7111cfec 100644 --- a/components/codetools/linkscanner.pas +++ b/components/codetools/linkscanner.pas @@ -88,7 +88,8 @@ type Next: PSourceLink; end; - { TSourceChangeStep is used save the ChangeStep of every used file } + { TSourceChangeStep is used to save the ChangeStep of every used file + A ChangeStep is switching to or from an include file } PSourceChangeStep = ^TSourceChangeStep; TSourceChangeStep = record Code: Pointer; @@ -99,7 +100,16 @@ type TLinkScannerRange = ( lsrNone, // undefined lsrInit, // init, but do not scan any code - lsrInterface, // scan only interface + lsrSourceType, // read till source type (e.g. keyword program or unit) + lsrSourceName, // read till source name + lsrInterfaceStart, // read till keyword interface + lsrMainUsesSectionStart, // uses section of interface/program + lsrMainUsesSectionEnd, // uses section of interface/program + lsrImplementationStart, // scan only interface + lsrImplementationUsesSectionStart, // uses section of implementation + lsrImplementationUsesSectionEnd, // uses section of implementation + lsrInitializationStart, + lsrFinalizationStart, lsrEnd // scan till 'end.' ); @@ -141,8 +151,16 @@ type { LinkScanner Token Types } TLSTokenType = ( - lsttNone, lsttSrcEnd, lsttIdentifier, lsttEqual, lsttPoint, lsttEnd, - lsttEndOfInterface); + lsttNone, + lsttSrcEnd, // no more tokens + lsttWord, + lsttEqual, + lsttPoint, + lsttSemicolon, + lsttComma, + lsttStringConstant, + lsttEnd + ); { Error handling } ELinkScannerError = class(Exception) @@ -234,10 +252,17 @@ type procedure HandleDirectives; procedure UpdateCleanedSource(SourcePos: integer); function ReturnFromIncludeFile: boolean; - function ParseKeyWord(StartPos, WordLen: integer): boolean; + function ParseKeyWord(StartPos, WordLen: integer; LastTokenType: TLSTokenType + ): boolean; function DoEndToken: boolean; {$IFDEF UseInline}inline;{$ENDIF} - function DoDefaultIdentToken: boolean; {$IFDEF UseInline}inline;{$ENDIF} - function DoEndOfInterfaceToken: boolean; {$IFDEF UseInline}inline;{$ENDIF} + function DoSourceTypeToken: boolean; {$IFDEF UseInline}inline;{$ENDIF} + function DoInterfaceToken: boolean; {$IFDEF UseInline}inline;{$ENDIF} + function DoImplementationToken: boolean; {$IFDEF UseInline}inline;{$ENDIF} + function DoFinalizationToken: boolean; {$IFDEF UseInline}inline;{$ENDIF} + function DoInitializationToken: boolean; {$IFDEF UseInline}inline;{$ENDIF} + function DoUsesToken: boolean; {$IFDEF UseInline}inline;{$ENDIF} + function IsUsesToken: boolean; + function TokenIsWord(p: PChar): boolean; private // directives FDirectiveName: shortstring; @@ -287,7 +312,7 @@ type function MissingIncludeFilesNeedsUpdate: boolean; procedure ClearMissingIncludeFiles; protected - // errors + // error: the error is in range Succ(ScannedRange) LastErrorMessage: string; LastErrorSrcPos: integer; LastErrorCode: pointer; @@ -482,13 +507,29 @@ var PSourceLinkMemManager: TPSourceLinkMemManager; PSourceChangeStepMemManager: TPSourceChangeStepMemManager; +const + LinkScannerRangeNames: array[TLinkScannerRange] of string = ( + 'lsrNone', + 'lsrInit', + 'lsrSourceType', + 'lsrSourceName', + 'lsrInterfaceStart', + 'lsrMainUsesSectionStart', + 'lsrMainUsesSectionEnd', + 'lsrImplementationStart', + 'lsrImplementationUsesSectionStart', + 'lsrImplementationUsesSectionEnd', + 'lsrInitializationStart', + 'lsrFinalizationStart', + 'lsrEnd' + ); procedure AddCodeToUniqueList(ACode: Pointer; UniqueSortedCodeList: TFPList); function IndexOfCodeInUniqueList(ACode: Pointer; UniqueSortedCodeList: TList): integer; function IndexOfCodeInUniqueList(ACode: Pointer; UniqueSortedCodeList: TFPList): integer; - +function dbgs(r: TLinkScannerRange): string; overload; implementation @@ -537,6 +578,11 @@ begin Result:=-1; end; +function dbgs(r: TLinkScannerRange): string; overload; +begin + Result:=LinkScannerRangeNames[r]; +end; + procedure AddCodeToUniqueList(ACode: Pointer; UniqueSortedCodeList: TFPList); var l,m,r: integer; begin @@ -916,36 +962,35 @@ var c1: char; c2: char; begin - // Skip all spaces and comments //DebugLn(' TLinkScanner.ReadNextToken SrcPos=',SrcPos,' SrcLen=',SrcLen,' "',copy(Src,SrcPos,5),'"'); + {$IFOPT R+}{$DEFINE RangeChecking}{$ENDIF} + {$R-} if (SrcPos>SrcLen) and ReturnFromIncludeFileAndIsEnd then exit; + // Skip all spaces and comments c1:=Src[SrcPos]; - if IsCommentStartChar[c1] or IsSpaceChar[c1] then begin - while true do begin - if IsCommentStartChar[c1] then begin - case c1 of - '{' : - SkipComment; - '/': - if (SrcPosSrcLen) or (not (IsSpaceChar[Src[SrcPos]])); - end else - break; - if (SrcPos>SrcLen) and ReturnFromIncludeFileAndIsEnd then exit; - c1:=Src[SrcPos]; + else + break; end; + if (SrcPos>SrcLen) and ReturnFromIncludeFileAndIsEnd then exit; + c1:=Src[SrcPos]; end; TokenStart:=SrcPos; TokenType:=lsttNone; @@ -953,15 +998,16 @@ begin case c1 of '_','A'..'Z','a'..'z': begin - // identifier + // keyword or identifier inc(SrcPos); while (SrcPos<=SrcLen) and (IsIdentChar[Src[SrcPos]]) do inc(SrcPos); - ParseKeyWord(TokenStart,SrcPos-TokenStart); + TokenType:=lsttWord; end; '''','#': begin + TokenType:=lsttStringConstant; while (SrcPos<=SrcLen) do begin case (Src[SrcPos]) of '#': @@ -1036,6 +1082,16 @@ begin inc(SrcPos); TokenType:=lsttPoint; end; + ';': + begin + inc(SrcPos); + TokenType:=lsttSemicolon; + end; + ',': + begin + inc(SrcPos); + TokenType:=lsttComma; + end; else inc(SrcPos); if SrcPos<=SrcLen then begin @@ -1050,6 +1106,7 @@ begin then inc(SrcPos); end; end; + {$IFDEF RangeChecking}{$R+}{$UNDEF RangeChecking}{$ENDIF} end; procedure TLinkScanner.Scan(Range: TLinkScannerRange; CheckFilesOnDisk: boolean); @@ -1064,20 +1121,24 @@ var begin if (not UpdateNeeded(Range,CheckFilesOnDisk)) then begin // 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; + // -> if there was an error and it was in a needed range, raise it again + if LastErrorIsValid then begin + // the error is happened in ScannedRange + if ord(ScannedRange)>ord(Range) then begin + // error was not in needed range + end else if (ScannedRange=Range) + and ((not IgnoreErrorAfterValid) + or (not IgnoreErrAfterPositionIsInFrontOfLastErrMessage)) + then + RaiseLastError; + end; exit; end; {$IFDEF CTDEBUG} - DebugLn('TLinkScanner.Scan A -------- TillInterfaceEnd=',dbgs(TillInterfaceEnd)); + DebugLn('TLinkScanner.Scan A -------- Range=',dbgs(Range)); {$ENDIF} ScanTill:=Range; Clear; - IncreaseChangeStep; {$IFDEF CTDEBUG} DebugLn('TLinkScanner.Scan B '); {$ENDIF} @@ -1124,10 +1185,9 @@ begin //DebugLn(['TLinkScanner.Scan ',MainFilename,' ',PascalCompilerNames[PascalCompiler],' ',CompilerModeNames[CompilerMode],' ',FInitValues.IsDefined(NestedCompilerDefine),' FNestedComments=',FNestedComments]); //DebugLn(Values.AsString); - //DebugLn('TLinkScanner.Scan E --------'); FMacrosOn:=(Values.Variables['MACROS']<>'0'); if Src='' then exit; - // beging scanning + // begin scanning AddLink(1,SrcPos,Code); LastTokenType:=lsttNone; LastProgressPos:=0; @@ -1135,28 +1195,34 @@ begin {$IFDEF CTDEBUG} DebugLn('TLinkScanner.Scan F ',dbgs(SrcLen)); {$ENDIF} + ScannedRange:=lsrInit; if ScanTill=lsrInit then exit; try try - repeat + ReadNextToken; + if IsUsesToken then + DoUsesToken + else + SrcPos:=TokenStart; + while ord(ScanTill)>ord(ScannedRange) do begin // check every 100.000 bytes for abort if CheckForAbort and ((LastProgressPos-LastCleanSrcPos)>100000) then begin LastProgressPos:=LastCleanSrcPos; DoCheckAbort; end; ReadNextToken; + if TokenType=lsttWord then + ParseKeyWord(TokenStart,SrcPos-TokenStart,LastTokenType); + //DebugLn('TLinkScanner.Scan G "',copy(Src,TokenStart,SrcPos-TokenStart),'"'); - if (TokenType=lsttEndOfInterface) and (LastTokenType<>lsttEqual) then - begin - ScannedRange:=lsrInterface; - if ScanTill=lsrInterface then break; - end else if (LastTokenType=lsttEnd) and (TokenType=lsttPoint) then begin + if (LastTokenType=lsttEnd) and (TokenType=lsttPoint) then begin ScannedRange:=lsrEnd; break; - end else if (SrcPos>SrcLen) and ReturnFromIncludeFileAndIsEnd then + end; + if (SrcPos>SrcLen) and ReturnFromIncludeFileAndIsEnd then break; LastTokenType:=TokenType; - until false; + end; finally if FSkippingDirectives=lssdNone then begin {$IFDEF ShowUpdateCleanedSrc} @@ -1183,7 +1249,7 @@ begin end; end; {$IFDEF CTDEBUG} - DebugLn('TLinkScanner.Scan END ',dbgs(CleanedLen)); + DebugLn('TLinkScanner.Scan END ',dbgs(CleanedLen),' ',dbgs(ScannedRange)); {$ENDIF} end; @@ -1432,10 +1498,12 @@ end; function TLinkScanner.UpdateNeeded( Range: TLinkScannerRange; CheckFilesOnDisk: boolean): boolean; { the clean source must be rebuilt if - 1. scanrange changed from only interface to whole source + 1. scanrange increased 2. unit source changed 3. one of its include files changed 4. init values changed (e.g. initial compiler defines) + 5. FForceUpdateNeeded is set + 6. a missing include file can now be found } var i: integer; SrcLog: TSourceLog; @@ -1468,14 +1536,20 @@ begin end; end; - // check if any input has changed ... - FForceUpdateNeeded:=true; - // check if ScanRange has increased if ord(Range)>ord(ScannedRange) then exit; + // check if any input has changed ... + FForceUpdateNeeded:=true; + // check all used files if Assigned(FOnGetSource) then begin + for i:=0 to FSourceChangeSteps.Count-1 do begin + SrcChange:=PSourceChangeStep(FSourceChangeSteps[i]); + SrcLog:=FOnGetSource(Self,SrcChange^.Code); + //debugln(['TLinkScanner.UpdateNeeded ',ExtractFilename(MainFilename),' i=',i,' File=',FOnGetFileName(Self,SrcLog),' Last=',SrcChange^.ChangeStep,' Now=',SrcLog.ChangeStep]); + if SrcChange^.ChangeStep<>SrcLog.ChangeStep then exit; + end; if CheckFilesOnDisk and Assigned(FOnCheckFileOnDisk) then begin // if files changed on disk, reload them for i:=0 to FSourceChangeSteps.Count-1 do begin @@ -1484,12 +1558,6 @@ begin FOnCheckFileOnDisk(SrcLog); end; end; - for i:=0 to FSourceChangeSteps.Count-1 do begin - SrcChange:=PSourceChangeStep(FSourceChangeSteps[i]); - SrcLog:=FOnGetSource(Self,SrcChange^.Code); - //debugln(['TLinkScanner.UpdateNeeded ',ExtractFilename(MainFilename),' i=',i,' File=',FOnGetFileName(Self,SrcLog),' Last=',SrcChange^.ChangeStep,' Now=',SrcLog.ChangeStep]); - if SrcChange^.ChangeStep<>SrcLog.ChangeStep then exit; - end; end; // check initvalues @@ -2921,7 +2989,8 @@ begin Result:=SrcPos<=SrcLen; end; -function TLinkScanner.ParseKeyWord(StartPos, WordLen: integer): boolean; +function TLinkScanner.ParseKeyWord(StartPos, WordLen: integer; + LastTokenType: TLSTokenType): boolean; var p: PChar; begin @@ -2929,12 +2998,24 @@ begin p:=@Src[StartPos]; case UpChars[p^] of 'E': if CompareIdentifiers(p,'END')=0 then exit(DoEndToken); - 'F': if CompareIdentifiers(p,'FINALIZATION')=0 then exit(DoEndOfInterfaceToken); + 'F': if CompareIdentifiers(p,'FINALIZATION')=0 then exit(DoFinalizationToken); 'I': case UpChars[p[1]] of - 'M': if CompareIdentifiers(p,'IMPLEMENTATION')=0 then exit(DoEndOfInterfaceToken); - 'N': if CompareIdentifiers(p,'INITIALIZIATION')=0 then exit(DoEndOfInterfaceToken); + 'M': if CompareIdentifiers(p,'IMPLEMENTATION')=0 then exit(DoImplementationToken); + 'N': + case UpChars[p[2]] of + 'I': if CompareIdentifiers(p,'INITIALIZATION')=0 then exit(DoInitializationToken); + 'T': if (LastTokenType<>lsttEqual) + and (CompareIdentifiers(p,'INTERFACE')=0) then exit(DoInterfaceToken); + end; end; + 'L': if CompareIdentifiers(p,'LIBRARY')=0 then exit(DoSourceTypeToken); + 'P': + case UpChars[p[1]] of + 'R': if CompareIdentifiers(p,'PROGRAM')=0 then exit(DoSourceTypeToken); + 'A': if CompareIdentifiers(p,'PACKAGE')=0 then exit(DoSourceTypeToken); + end; + 'U': if CompareIdentifiers(p,'UNIT')=0 then exit(DoSourceTypeToken); end; Result:=false; end; @@ -2945,18 +3026,97 @@ begin Result:=true; end; -function TLinkScanner.DoDefaultIdentToken: boolean; +function TLinkScanner.DoSourceTypeToken: boolean; +// program, unit, library, package +// unit unit1; +// unit unit1 platform; +// unit unit1 unimplemented; begin - TokenType:=lsttIdentifier; + if ScannedRange<>lsrInit then exit(false); + Result:=true; + ScannedRange:=lsrSourceType; + if ScannedRange=ScanTill then exit; + ReadNextToken; + ScannedRange:=lsrSourceName; + if ScannedRange=ScanTill then exit; + ReadNextToken; + if IsUsesToken then Result:=DoUsesToken; +end; + +function TLinkScanner.DoInterfaceToken: boolean; +begin + if ord(ScannedRange)>=ord(lsrInterfaceStart) then exit(false); + ScannedRange:=lsrInterfaceStart; + Result:=true; + if ScannedRange=ScanTill then exit; + ReadNextToken; + if IsUsesToken then Result:=DoUsesToken; +end; + +function TLinkScanner.DoFinalizationToken: boolean; +begin + if ord(ScannedRange)>=ord(lsrFinalizationStart) then exit(false); + ScannedRange:=lsrFinalizationStart; Result:=true; end; -function TLinkScanner.DoEndOfInterfaceToken: boolean; +function TLinkScanner.DoInitializationToken: boolean; begin - TokenType:=lsttEndOfInterface; + if ord(ScannedRange)>=ord(lsrInitializationStart) then exit(false); + ScannedRange:=lsrInitializationStart; Result:=true; end; +function TLinkScanner.DoUsesToken: boolean; +// uses name, name in 'string'; +begin + if ord(ScannedRange)<=ord(lsrInterfaceStart) then + ScannedRange:=lsrMainUsesSectionStart + else if ScannedRange=lsrImplementationStart then + ScannedRange:=lsrImplementationUsesSectionStart; + repeat + // read unit name + ReadNextToken; + if (TokenType<>lsttWord) + or WordIsKeyWord.DoItCaseInsensitive(@Src[SrcPos]) then exit(false); + ReadNextToken; + if TokenIs('in') then begin + // read "in" filename + ReadNextToken; + if TokenType=lsttStringConstant then + ReadNextToken; + end; + if TokenType=lsttSemicolon then break; + if TokenType<>lsttComma then begin + // syntax error -> this token does not belong to the uses section + SrcPos:=TokenStart; + break; + end; + until false; + ScannedRange:=succ(ScannedRange); // lsrMainUsesSectionEnd, lsrImplementationUsesSectionEnd; + Result:=true; +end; + +function TLinkScanner.IsUsesToken: boolean; +begin + Result:=(TokenType=lsttWord) and (CompareIdentifiers(@Src[SrcPos],'USES')=0); +end; + +function TLinkScanner.TokenIsWord(p: PChar): boolean; +begin + Result:=(TokenType=lsttWord) and (CompareIdentifiers(p,@Src[SrcPos])=0); +end; + +function TLinkScanner.DoImplementationToken: boolean; +begin + if ord(ScannedRange)>=ord(lsrImplementationStart) then exit(false); + ScannedRange:=lsrImplementationStart; + Result:=true; + if ScannedRange=ScanTill then exit; + ReadNextToken; + if IsUsesToken then Result:=DoUsesToken; +end; + procedure TLinkScanner.SkipTillEndifElse(SkippingUntil: TLSSkippingDirective); procedure RaiseAlreadySkipping; diff --git a/components/synedit/synedit.pp b/components/synedit/synedit.pp index 5d4f99e6a5..526ac41f37 100644 --- a/components/synedit/synedit.pp +++ b/components/synedit/synedit.pp @@ -7500,6 +7500,7 @@ begin // TODO: Clear style only, if Highlighter uses styles Style := []; // Reserved for Highlighter end; + //debugln(['TCustomSynEdit.RecalcCharExtent ',fFontDummy.Name,' ',fFontDummy.Size]); with fTextDrawer do begin //debugln('TCustomSynEdit.RecalcCharExtent A UseUTF8=',dbgs(UseUTF8), // ' Font.CanUTF8='+dbgs(Font.CanUTF8)+' CharHeight=',dbgs(CharHeight));