diff --git a/components/codetools/codecompletiontool.pas b/components/codetools/codecompletiontool.pas index 9547bc6d40..5a5677bb91 100644 --- a/components/codetools/codecompletiontool.pas +++ b/components/codetools/codecompletiontool.pas @@ -773,6 +773,9 @@ writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Gather existing method // gather existing class proc definitions ClassProcs:=GatherProcNodes(StartNode,[phpInUpperCase,phpAddClassName], ExtractClassName(ClassNode,true)); + + // ToDo: check for double defined methods in ClassProcs + // add new class parts to ClassProcs CurNode:=FirstExistingProcBody; ANodeExt:=FirstInsert; @@ -805,7 +808,13 @@ writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Gather existing method if ImplementationNode=nil then RaiseException('implementation node not found'); Indent:=GetLineIndent(Src,ImplementationNode.StartPos); - InsertPos:=ImplementationNode.EndPos; + if (ImplementationNode.LastChild=nil) + or (ImplementationNode.LastChild.Desc<>ctnBeginBlock) then + InsertPos:=ImplementationNode.EndPos + else begin + InsertPos:=FindLineEndOrCodeInFrontOfPosition(Src, + ImplementationNode.LastChild.StartPos,Scanner.NestedComments); + end; end else begin // class is not in interface section // -> insert at the end of the type section @@ -959,7 +968,7 @@ writeln('TCodeCompletionCodeTool.CompleteCode A CleanCursorPos=',CleanCursorPos, writeln('TCodeCompletionCodeTool.CompleteCode In-a-class ',NodeDescriptionAsString(ClassNode.Desc)); {$ENDIF} // cursor is in class/object definition - if CursorNode.SubDesc=ctnsForwardDeclaration then exit; + if (CursorNode.SubDesc and ctnsForwardDeclaration)>0 then exit; // parse class and build CodeTreeNodes for all properties/methods {$IFDEF CTDEBUG} writeln('TCodeCompletionCodeTool.CompleteCode C ',CleanCursorPos,', |',copy(Src,CleanCursorPos,8)); @@ -1079,7 +1088,7 @@ writeln('TCodeCompletionCodeTool.CompleteCode not in-a-class ... '); ProcNode:=CursorNode; if ProcNode.Desc=ctnProcedureHead then ProcNode:=ProcNode.Parent; if (ProcNode.Desc=ctnProcedure) - and (ProcNode.SubDesc=ctnsForwardDeclaration) then begin + and ((ProcNode.SubDesc and ctnsForwardDeclaration)>0) then begin // Node is forward Proc {$IFDEF CTDEBUG} writeln('TCodeCompletionCodeTool.CompleteCode in a forward procedure ... '); @@ -1097,16 +1106,15 @@ writeln('TCodeCompletionCodeTool.CompleteCode Body not found -> create it ... ') // -> create proc body at end of implementation Indent:=GetLineIndent(Src,ImplementationNode.StartPos); - if ImplementationNode.Desc=ctnImplementation then + if (ImplementationNode.LastChild=nil) + or (ImplementationNode.LastChild.Desc<>ctnBeginBlock) then + // insert at end of code InsertPos:=FindLineEndOrCodeInFrontOfPosition(Src, ImplementationNode.EndPos,Scanner.NestedComments) else begin // insert in front of main program begin..end. - StartNode:=ImplementationNode.LastChild; - if (StartNode=nil) or (StartNode.Desc<>ctnBeginBlock) then - RaiseException('main Begin..End block not found'); - InsertPos:=FindLineEndOrCodeInFrontOfPosition(Src,StartNode.StartPos, - Scanner.NestedComments); + InsertPos:=FindLineEndOrCodeInFrontOfPosition(Src, + ImplementationNode.LastChild.StartPos,Scanner.NestedComments); end; // build nice proc diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 4b74f1452c..6bb09478c6 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -40,7 +40,8 @@ uses MemCheck, {$ENDIF} Classes, SysUtils, CodeCompletionTool, CodeTree, CodeAtom, SourceChanger, - DefineTemplates, CodeCache, ExprEval, LinkScanner, KeywordFuncLists, TypInfo; + DefineTemplates, CodeCache, ExprEval, LinkScanner, KeywordFuncLists, TypInfo, + AVL_Tree, CustomCodeTool, FindDeclarationTool; type TCodeToolManager = class; @@ -54,7 +55,7 @@ type private FCatchExceptions: boolean; FCheckFilesOnDisk: boolean; - FCodeTool: TCodeCompletionCodeTool; + FCurCodeTool: TCodeCompletionCodeTool; // current codetool FCursorBeyondEOL: boolean; FErrorCode: TCodeBuffer; FErrorColumn: integer; @@ -66,6 +67,7 @@ type FOnAfterApplyChanges: TOnAfterApplyChanges; FOnBeforeApplyChanges: TOnBeforeApplyChanges; FSourceExtensions: string; // default is '.pp;.pas;.lpr;.dpr;.dpk' + FSourceTools: TAVLTree; // tree of TCustomCodeTool FVisibleEditorLines: integer; FWriteExceptions: boolean; function OnScannerGetInitValues(Code: Pointer): TExpressionEvaluator; @@ -73,7 +75,10 @@ type var Value: string); procedure OnGlobalValuesChanged; function GetMainCode(Code: TCodeBuffer): TCodeBuffer; - function InitCodeTool(Code: TCodeBuffer): boolean; + function InitCurCodeTool(Code: TCodeBuffer): boolean; + function FindCodeToolForSource(Code: TCodeBuffer): TCustomCodeTool; + function GetCodeToolForSource(Code: TCodeBuffer; + ExceptionOnError: boolean): TCustomCodeTool; procedure SetCheckFilesOnDisk(NewValue: boolean); procedure SetIndentSize(NewValue: integer); procedure SetVisibleEditorLines(NewValue: integer); @@ -82,6 +87,8 @@ type procedure BeforeApplyingChanges(var Abort: boolean); procedure AfterApplyingChanges; function HandleException(AnException: Exception): boolean; + function OnGetCodeToolForBuffer(Sender: TObject; + Code: TCodeBuffer): TFindDeclarationTool; public DefinePool: TDefinePool; // definition templates (rules) DefineTree: TDefineTree; // cache for defines (e.g. initial compiler values) @@ -144,6 +151,9 @@ type function FindBlockCounterPart(Code: TCodeBuffer; X,Y: integer; var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer): boolean; + function FindBlockStart(Code: TCodeBuffer; X,Y: integer; + var NewCode: TCodeBuffer; + var NewX, NewY, NewTopLine: integer): boolean; function GuessUnclosedBlock(Code: TCodeBuffer; X,Y: integer; var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer): boolean; @@ -241,6 +251,21 @@ var CodeToolBoss: TCodeToolManager; implementation +function CompareCodeToolMainSources(Data1, Data2: Pointer): integer; +var + Src1, Src2: integer; +begin + Src1:=Integer(TCustomCodeTool(Data1).Scanner.MainCode); + Src2:=Integer(TCustomCodeTool(Data2).Scanner.MainCode); + if Src1Src2 then + Result:=+1 + else + Result:=0; +end; + + { TCodeToolManager } constructor TCodeToolManager.Create; @@ -262,6 +287,7 @@ begin FVisibleEditorLines:=20; FJumpCentered:=true; FCursorBeyondEOL:=true; + FSourceTools:=TAVLTree.Create(@CompareCodeToolMainSources); end; destructor TCodeToolManager.Destroy; @@ -273,7 +299,8 @@ writeln('[TCodeToolManager.Destroy] A'); {$IFDEF CTDEBUG} writeln('[TCodeToolManager.Destroy] B'); {$ENDIF} - FCodeTool.Free; + FSourceTools.FreeAndClear; + FSourceTools.Free; {$IFDEF CTDEBUG} writeln('[TCodeToolManager.Destroy] C'); {$ENDIF} @@ -410,7 +437,7 @@ begin Result:=SourceChangeCache.Apply; end; -function TCodeToolManager.InitCodeTool(Code: TCodeBuffer): boolean; +function TCodeToolManager.InitCurCodeTool(Code: TCodeBuffer): boolean; var MainCode: TCodeBuffer; begin Result:=false; @@ -419,23 +446,15 @@ begin fErrorLine:=-1; MainCode:=GetMainCode(Code); if MainCode=nil then begin - fErrorMsg:='TCodeToolManager.InitCodeTool MainCode=nil'; + fErrorMsg:='TCodeToolManager.InitCurCodeTool MainCode=nil'; exit; end; - if FCodeTool=nil then begin - FCodeTool:=TCodeCompletionCodeTool.Create; - FCodeTool.CheckFilesOnDisk:=FCheckFilesOnDisk; - FCodeTool.IndentSize:=FIndentSize; - FCodeTool.VisibleEditorLines:=FVisibleEditorLines; - FCodeTool.JumpCentered:=FJumpCentered; - FCodeTool.CursorBeyondEOL:=FCursorBeyondEOL; - end; - FCodeTool.ErrorPosition.Code:=nil; - FCodeTool.Scanner:=MainCode.Scanner; + FCurCodeTool:=TCodeCompletionCodeTool(GetCodeToolForSource(MainCode,true)); + FCurCodeTool.ErrorPosition.Code:=nil; {$IFDEF CTDEBUG} -writeln('[TCodeToolManager.InitCodeTool] ',Code.Filename,' ',Code.SourceLength); +writeln('[TCodeToolManager.InitCurCodeTool] ',Code.Filename,' ',Code.SourceLength); {$ENDIF} - Result:=(FCodeTool.Scanner<>nil); + Result:=(FCurCodeTool.Scanner<>nil); if not Result then begin fErrorCode:=MainCode; fErrorMsg:='No scanner available'; @@ -443,26 +462,36 @@ writeln('[TCodeToolManager.InitCodeTool] ',Code.Filename,' ',Code.SourceLength); end; function TCodeToolManager.HandleException(AnException: Exception): boolean; +var ErrorSrcTool: TCustomCodeTool; begin fErrorMsg:=AnException.Message; - if FCodeTool<>nil then begin - fErrorCode:=FCodeTool.ErrorPosition.Code; - fErrorColumn:=FCodeTool.ErrorPosition.X; - fErrorLine:=FCodeTool.ErrorPosition.Y; + if (AnException is ELinkScannerError) + and (FCurCodeTool<>nil) and (FCurCodeTool.Scanner<>nil) + and (FCurCodeTool.Scanner.Code<>nil) + and (FCurCodeTool.Scanner.LinkCount>0) then begin + fErrorCode:=TCodeBuffer(FCurCodeTool.Scanner.Code); + if fErrorCode<>nil then + fErrorCode.AbsoluteToLineCol( + FCurCodeTool.Scanner.SrcPos,fErrorLine,fErrorColumn); + end else if (AnException is ECodeToolError) then begin + ErrorSrcTool:=ECodeToolError(AnException).Sender; + fErrorCode:=ErrorSrcTool.ErrorPosition.Code; + fErrorColumn:=ErrorSrcTool.ErrorPosition.X; + fErrorLine:=ErrorSrcTool.ErrorPosition.Y; + fErrorTopLine:=fErrorLine; + if JumpCentered then begin + dec(fErrorTopLine,VisibleEditorLines div 2); + if fErrorTopLine<1 then fErrorTopLine:=1; + end; + end else if FCurCodeTool<>nil then begin + fErrorCode:=FCurCodeTool.ErrorPosition.Code; + fErrorColumn:=FCurCodeTool.ErrorPosition.X; + fErrorLine:=FCurCodeTool.ErrorPosition.Y; fErrorTopLine:=fErrorLine; if JumpCentered then begin dec(fErrorTopLine,VisibleEditorLines div 2); if fErrorTopLine<1 then fErrorTopLine:=1; end; - end; - if (AnException is ELinkScannerError) - and (FCodeTool<>nil) and (FCodeTool.Scanner<>nil) - and (FCodeTool.Scanner.Code<>nil) - and (FCodeTool.Scanner.LinkCount>0) then begin - fErrorCode:=TCodeBuffer(FCodeTool.Scanner.Code); - if fErrorCode<>nil then - fErrorCode.AbsoluteToLineCol( - FCodeTool.Scanner.SrcPos,fErrorLine,fErrorColumn); end; if FWriteExceptions then begin {$IFDEF CTDEBUG} @@ -485,8 +514,8 @@ function TCodeToolManager.CheckSyntax(Code: TCodeBuffer; begin Result:=false; try - if InitCodeTool(Code) then begin - FCodeTool.BuildTree(false); + if InitCurCodeTool(Code) then begin + FCurCodeTool.BuildTree(false); Result:=true; end; except @@ -509,15 +538,15 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.JumpToMethod A ',Code.Filename,' x=',x,' y=',y); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; CursorPos.X:=X; CursorPos.Y:=Y; CursorPos.Code:=Code; {$IFDEF CTDEBUG} -writeln('TCodeToolManager.JumpToMethod B ',FCodeTool.Scanner<>nil); +writeln('TCodeToolManager.JumpToMethod B ',FCurCodeTool.Scanner<>nil); {$ENDIF} try - Result:=FCodeTool.FindJumpPoint(CursorPos,NewPos,NewTopLine); + Result:=FCurCodeTool.FindJumpPoint(CursorPos,NewPos,NewTopLine); if Result then begin NewX:=NewPos.X; NewY:=NewPos.Y; @@ -542,15 +571,15 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.FindDeclaration A ',Code.Filename,' x=',x,' y=',y); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; CursorPos.X:=X; CursorPos.Y:=Y; CursorPos.Code:=Code; {$IFDEF CTDEBUG} -writeln('TCodeToolManager.FindDeclaration B ',FCodeTool.Scanner<>nil); +writeln('TCodeToolManager.FindDeclaration B ',FCurCodeTool.Scanner<>nil); {$ENDIF} try - Result:=FCodeTool.FindDeclaration(CursorPos,NewPos,NewTopLine); + Result:=FCurCodeTool.FindDeclaration(CursorPos,NewPos,NewTopLine); if Result then begin NewX:=NewPos.X; NewY:=NewPos.Y; @@ -575,15 +604,15 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.FindBlockCounterPart A ',Code.Filename,' x=',x,' y=',y); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; CursorPos.X:=X; CursorPos.Y:=Y; CursorPos.Code:=Code; {$IFDEF CTDEBUG} -writeln('TCodeToolManager.FindBlockCounterPart B ',FCodeTool.Scanner<>nil); +writeln('TCodeToolManager.FindBlockCounterPart B ',FCurCodeTool.Scanner<>nil); {$ENDIF} try - Result:=FCodeTool.FindBlockCounterPart(CursorPos,NewPos,NewTopLine); + Result:=FCurCodeTool.FindBlockCounterPart(CursorPos,NewPos,NewTopLine); if Result then begin NewX:=NewPos.X; NewY:=NewPos.Y; @@ -597,6 +626,39 @@ writeln('TCodeToolManager.FindBlockCounterPart END '); {$ENDIF} end; +function TCodeToolManager.FindBlockStart(Code: TCodeBuffer; + X, Y: integer; var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer + ): boolean; +var + CursorPos: TCodeXYPosition; + NewPos: TCodeXYPosition; +begin + Result:=false; +{$IFDEF CTDEBUG} +writeln('TCodeToolManager.FindBlockStart A ',Code.Filename,' x=',x,' y=',y); +{$ENDIF} + if not InitCurCodeTool(Code) then exit; + CursorPos.X:=X; + CursorPos.Y:=Y; + CursorPos.Code:=Code; +{$IFDEF CTDEBUG} +writeln('TCodeToolManager.FindBlockStart B ',FCurCodeTool.Scanner<>nil); +{$ENDIF} + try + Result:=FCurCodeTool.FindBlockStart(CursorPos,NewPos,NewTopLine); + if Result then begin + NewX:=NewPos.X; + NewY:=NewPos.Y; + NewCode:=NewPos.Code; + end; + except + on e: Exception do Result:=HandleException(e); + end; +{$IFDEF CTDEBUG} +writeln('TCodeToolManager.FindBlockStart END '); +{$ENDIF} +end; + function TCodeToolManager.GuessUnclosedBlock(Code: TCodeBuffer; X, Y: integer; var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer): boolean; var @@ -607,15 +669,15 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.GuessUnclosedBlock A ',Code.Filename,' x=',x,' y=',y); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; CursorPos.X:=X; CursorPos.Y:=Y; CursorPos.Code:=Code; {$IFDEF CTDEBUG} -writeln('TCodeToolManager.GuessUnclosedBlock B ',FCodeTool.Scanner<>nil); +writeln('TCodeToolManager.GuessUnclosedBlock B ',FCurCodeTool.Scanner<>nil); {$ENDIF} try - Result:=FCodeTool.GuessUnclosedBlock(CursorPos,NewPos,NewTopLine); + Result:=FCurCodeTool.GuessUnclosedBlock(CursorPos,NewPos,NewTopLine); if Result then begin NewX:=NewPos.X; NewY:=NewPos.Y; @@ -635,9 +697,9 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.GetCompatibleMethods A ',Code.Filename,' Classname=',AClassname); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - FCodeTool.GetCompatiblePublishedMethods(UpperCaseStr(AClassName), + FCurCodeTool.GetCompatiblePublishedMethods(UpperCaseStr(AClassName), TypeData,Proc); except on e: Exception do HandleException(e); @@ -650,10 +712,10 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.MethodExists A ',Code.Filename,' ',AClassName,':',AMethodName); {$ENDIF} - Result:=InitCodeTool(Code); + Result:=InitCurCodeTool(Code); if not Result then exit; try - Result:=FCodeTool.PublishedMethodExists(UpperCaseStr(AClassName), + Result:=FCurCodeTool.PublishedMethodExists(UpperCaseStr(AClassName), UpperCaseStr(AMethodName),TypeData); except on e: Exception do Result:=HandleException(e); @@ -668,10 +730,10 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.JumpToMethodBody A ',Code.Filename,' ',AClassName,':',AMethodName); {$ENDIF} - Result:=InitCodeTool(Code); + Result:=InitCurCodeTool(Code); if not Result then exit; try - Result:=FCodeTool.JumpToPublishedMethodBody(UpperCaseStr(AClassName), + Result:=FCurCodeTool.JumpToPublishedMethodBody(UpperCaseStr(AClassName), UpperCaseStr(AMethodName),TypeData,NewPos,NewTopLine); if Result then begin NewCode:=NewPos.Code; @@ -689,11 +751,11 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.RenameMethod A'); {$ENDIF} - Result:=InitCodeTool(Code); + Result:=InitCurCodeTool(Code); if not Result then exit; try SourceChangeCache.Clear; - Result:=FCodeTool.RenamePublishedMethod(UpperCaseStr(AClassName), + Result:=FCurCodeTool.RenamePublishedMethod(UpperCaseStr(AClassName), UpperCaseStr(OldMethodName),NewMethodName,TypeData, SourceChangeCache); except @@ -707,11 +769,11 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.CreateMethod A'); {$ENDIF} - Result:=InitCodeTool(Code); + Result:=InitCurCodeTool(Code); if not Result then exit; try SourceChangeCache.Clear; - Result:=FCodeTool.CreatePublishedMethod(UpperCaseStr(AClassName), + Result:=FCurCodeTool.CreatePublishedMethod(UpperCaseStr(AClassName), NewMethodName,TypeData,SourceChangeCache); except on e: Exception do Result:=HandleException(e); @@ -728,12 +790,12 @@ begin writeln('TCodeToolManager.CompleteCode A ',Code.Filename,' x=',x,' y=',y); {$ENDIF} Result:=false; - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; CursorPos.X:=X; CursorPos.Y:=Y; CursorPos.Code:=Code; try - Result:=FCodeTool.CompleteCode(CursorPos,NewPos,NewTopLine,SourceChangeCache); + Result:=FCurCodeTool.CompleteCode(CursorPos,NewPos,NewTopLine,SourceChangeCache); if Result then begin NewX:=NewPos.X; NewY:=NewPos.Y; @@ -753,9 +815,9 @@ writeln('TCodeToolManager.GetSourceName A ',Code.Filename,' ',Code.SourceLength) {$IFDEF MEM_CHECK} CheckHeap(IntToStr(GetMem_Cnt)); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - Result:=FCodeTool.GetSourceName; + Result:=FCurCodeTool.GetSourceName; except on e: Exception do HandleException(e); end; @@ -774,11 +836,11 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.GetSourceType A ',Code.Filename,' ',Code.SourceLength); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try // GetSourceType does not parse the code -> parse it with GetSourceName - FCodeTool.GetSourceName; - case FCodeTool.GetSourceType of + FCurCodeTool.GetSourceName; + case FCurCodeTool.GetSourceType of ctnProgram: Result:='PROGRAM'; ctnPackage: Result:='PACKAGE'; ctnLibrary: Result:='LIBRARY'; @@ -805,9 +867,9 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.RenameSource A ',Code.Filename,' NewName=',NewName); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - Result:=FCodeTool.RenameSource(NewName,SourceChangeCache); + Result:=FCurCodeTool.RenameSource(NewName,SourceChangeCache); except on e: Exception do Result:=HandleException(e); end; @@ -822,12 +884,12 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.FindUnitInAllUsesSections A ',Code.Filename,' UnitName=',AnUnitName); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; {$IFDEF CTDEBUG} writeln('TCodeToolManager.FindUnitInAllUsesSections B ',Code.Filename,' UnitName=',AnUnitName); {$ENDIF} try - Result:=FCodeTool.FindUnitInAllUsesSections(UpperCaseStr(AnUnitName), + Result:=FCurCodeTool.FindUnitInAllUsesSections(UpperCaseStr(AnUnitName), NameAtomPos, InAtomPos); if Result then begin NamePos:=NameAtomPos.StartPos; @@ -845,9 +907,9 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.RenameUsedUnit A, ',Code.Filename,' Old=',OldUnitName,' New=',NewUnitName); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - Result:=FCodeTool.RenameUsedUnit(UpperCaseStr(OldUnitName),NewUnitName, + Result:=FCurCodeTool.RenameUsedUnit(UpperCaseStr(OldUnitName),NewUnitName, NewUnitInFile,SourceChangeCache); except on e: Exception do Result:=HandleException(e); @@ -861,9 +923,9 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.AddUnitToMainUsesSection A ',Code.Filename,' NewUnitName=',NewUnitName); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - Result:=FCodeTool.AddUnitToMainUsesSection(NewUnitName, NewUnitInFile, + Result:=FCurCodeTool.AddUnitToMainUsesSection(NewUnitName, NewUnitInFile, SourceChangeCache); except on e: Exception do Result:=HandleException(e); @@ -877,9 +939,9 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.RemoveUnitFromAllUsesSections A ',Code.Filename,' UnitName=',AnUnitName); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - Result:=FCodeTool.RemoveUnitFromAllUsesSections(UpperCaseStr(AnUnitName), + Result:=FCurCodeTool.RemoveUnitFromAllUsesSections(UpperCaseStr(AnUnitName), SourceChangeCache); except on e: Exception do Result:=HandleException(e); @@ -895,10 +957,10 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.FindLFMFileName A ',Code.Filename); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try LinkIndex:=-1; - CurCode:=FCodeTool.FindNextIncludeInInitialization(LinkIndex); + CurCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex); while (CurCode<>nil) do begin if UpperCaseStr(ExtractFileExt(CurCode.Filename))='.LRS' then begin Result:=CurCode.Filename; @@ -906,7 +968,7 @@ writeln('TCodeToolManager.FindLFMFileName A ',Code.Filename); Result:=copy(Result,1,length(Result)-length(Ext))+'.lfm'; exit; end; - CurCode:=FCodeTool.FindNextIncludeInInitialization(LinkIndex); + CurCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex); end; except on e: Exception do HandleException(e); @@ -920,9 +982,9 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.FindNextResourceFile A ',Code.Filename); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - Result:=FCodeTool.FindNextIncludeInInitialization(LinkIndex); + Result:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex); except on e: Exception do HandleException(e); end; @@ -935,9 +997,9 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.FindLazarusResource A ',Code.Filename,' ResourceName=',ResourceName); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - Result:=FCodeTool.FindLazarusResource(ResourceName); + Result:=FCurCodeTool.FindLazarusResource(ResourceName); except on e: Exception do HandleException(e); end; @@ -952,15 +1014,15 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.AddLazarusResource A ',Code.Filename,' ResourceName=',ResourceName,' ',length(ResourceData)); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; {$IFDEF CTDEBUG} writeln('TCodeToolManager.AddLazarusResource B '); {$ENDIF} try LinkIndex:=-1; - ResCode:=FCodeTool.FindNextIncludeInInitialization(LinkIndex); + ResCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex); if ResCode=nil then exit; - Result:=FCodeTool.AddLazarusResource(Rescode,ResourceName,ResourceData, + Result:=FCurCodeTool.AddLazarusResource(Rescode,ResourceName,ResourceData, SourceChangeCache); except on e: Exception do Result:=HandleException(e); @@ -976,12 +1038,12 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.RemoveLazarusResource A ',Code.Filename,' ResourceName=',ResourceName); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try LinkIndex:=-1; - ResCode:=FCodeTool.FindNextIncludeInInitialization(LinkIndex); + ResCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex); if ResCode=nil then exit; - Result:=FCodeTool.RemoveLazarusResource(ResCode,ResourceName, + Result:=FCurCodeTool.RemoveLazarusResource(ResCode,ResourceName, SourceChangeCache); except on e: Exception do Result:=HandleException(e); @@ -996,11 +1058,11 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.RenameMainInclude A ',Code.Filename,' NewFilename=',NewFilename,' KeepPath=',KeepPath); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try LinkIndex:=-1; - if FCodeTool.FindNextIncludeInInitialization(LinkIndex)=nil then exit; - Result:=FCodeTool.RenameInclude(LinkIndex,NewFilename,KeepPath, + if FCurCodeTool.FindNextIncludeInInitialization(LinkIndex)=nil then exit; + Result:=FCurCodeTool.RenameInclude(LinkIndex,NewFilename,KeepPath, SourceChangeCache); except on e: Exception do Result:=HandleException(e); @@ -1018,9 +1080,9 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.FindCreateFormStatement A ',Code.Filename,' StartPos=',StartPos,' ',AClassName,':',AVarName); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - Result:=FCodeTool.FindCreateFormStatement(StartPos,UpperCaseStr(AClassName), + Result:=FCurCodeTool.FindCreateFormStatement(StartPos,UpperCaseStr(AClassName), UpperCaseStr(AVarName),PosAtom); if Result<>-1 then Position:=PosAtom.StartPos; @@ -1036,9 +1098,9 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.AddCreateFormStatement A ',Code.Filename,' ',AClassName,':',AVarName); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - Result:=FCodeTool.AddCreateFormStatement(AClassName,AVarName, + Result:=FCurCodeTool.AddCreateFormStatement(AClassName,AVarName, SourceChangeCache); except on e: Exception do Result:=HandleException(e); @@ -1052,9 +1114,9 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.RemoveCreateFormStatement A ',Code.Filename,' ',AVarName); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - Result:=FCodeTool.RemoveCreateFormStatement(UpperCaseStr(AVarName), + Result:=FCurCodeTool.RemoveCreateFormStatement(UpperCaseStr(AVarName), SourceChangeCache); except on e: Exception do Result:=HandleException(e); @@ -1068,9 +1130,9 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.ListAllCreateFormStatements A ',Code.Filename); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - Result:=FCodeTool.ListAllCreateFormStatements; + Result:=FCurCodeTool.ListAllCreateFormStatements; except on e: Exception do HandleException(e); end; @@ -1083,9 +1145,9 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.SetAllCreateFromStatements A ',Code.Filename); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - Result:=FCodeTool.SetAllCreateFromStatements(List,SourceChangeCache); + Result:=FCurCodeTool.SetAllCreateFromStatements(List,SourceChangeCache); except on e: Exception do Result:=HandleException(e); end; @@ -1098,9 +1160,9 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.PublishedVariableExists A ',Code.Filename,' ',AClassName,':',AVarName); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - Result:=FCodeTool.FindPublishedVariable(UpperCaseStr(AClassName), + Result:=FCurCodeTool.FindPublishedVariable(UpperCaseStr(AClassName), UpperCaseStr(AVarName))<>nil; except on e: Exception do Result:=HandleException(e); @@ -1114,9 +1176,9 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.AddPublishedVariable A ',Code.Filename,' ',AClassName,':',VarName); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - Result:=FCodeTool.AddPublishedVariable(UpperCaseStr(AClassName), + Result:=FCurCodeTool.AddPublishedVariable(UpperCaseStr(AClassName), VarName,VarType,SourceChangeCache); except on e: Exception do Result:=HandleException(e); @@ -1130,9 +1192,9 @@ begin {$IFDEF CTDEBUG} writeln('TCodeToolManager.RemovePublishedVariable A ',Code.Filename,' ',AClassName,':',AVarName); {$ENDIF} - if not InitCodeTool(Code) then exit; + if not InitCurCodeTool(Code) then exit; try - Result:=FCodeTool.RemovePublishedVariable(UpperCaseStr(AClassName), + Result:=FCurCodeTool.RemovePublishedVariable(UpperCaseStr(AClassName), UpperCaseStr(AVarName),SourceChangeCache); except on e: Exception do Result:=HandleException(e); @@ -1168,40 +1230,40 @@ procedure TCodeToolManager.SetCheckFilesOnDisk(NewValue: boolean); begin if NewValue=FCheckFilesOnDisk then exit; FCheckFilesOnDisk:=NewValue; - if FCodeTool<>nil then - FCodeTool.CheckFilesOnDisk:=NewValue; + if FCurCodeTool<>nil then + FCurCodeTool.CheckFilesOnDisk:=NewValue; end; procedure TCodeToolManager.SetIndentSize(NewValue: integer); begin if NewValue=FIndentSize then exit; FIndentSize:=NewValue; - if FCodeTool<>nil then - FCodeTool.IndentSize:=NewValue; + if FCurCodeTool<>nil then + FCurCodeTool.IndentSize:=NewValue; end; procedure TCodeToolManager.SetVisibleEditorLines(NewValue: integer); begin if NewValue=FVisibleEditorLines then exit; FVisibleEditorLines:=NewValue; - if FCodeTool<>nil then - FCodeTool.VisibleEditorLines:=NewValue; + if FCurCodeTool<>nil then + FCurCodeTool.VisibleEditorLines:=NewValue; end; procedure TCodeToolManager.SetJumpCentered(NewValue: boolean); begin if NewValue=FJumpCentered then exit; FJumpCentered:=NewValue; - if FCodeTool<>nil then - FCodeTool.JumpCentered:=NewValue; + if FCurCodeTool<>nil then + FCurCodeTool.JumpCentered:=NewValue; end; procedure TCodeToolManager.SetCursorBeyondEOL(NewValue: boolean); begin if NewValue=FCursorBeyondEOL then exit; FCursorBeyondEOL:=NewValue; - if FCodeTool<>nil then - FCodeTool.CursorBeyondEOL:=NewValue; + if FCurCodeTool<>nil then + FCurCodeTool.CursorBeyondEOL:=NewValue; end; procedure TCodeToolManager.BeforeApplyingChanges(var Abort: boolean); @@ -1216,13 +1278,78 @@ begin FOnAfterApplyChanges(Self); end; +function TCodeToolManager.FindCodeToolForSource(Code: TCodeBuffer + ): TCustomCodeTool; +var ANode: TAVLTreeNode; + CurSrc, SearchedSrc: integer; +begin + ANode:=FSourceTools.Root; + SearchedSrc:=integer(Code); + while (ANode<>nil) do begin + CurSrc:=integer(TCustomCodeTool(ANode.Data).Scanner.MainCode); + if CurSrc>SearchedSrc then + ANode:=ANode.Left + else if CurSrcCode) then begin + if ExceptionOnError then + raise Exception.Create('the source file "'+Code.Filename+'"' + +' is an include file of "'+Code.Filename+'"'); + exit; + end; + Result:=TCodeCompletionCodeTool.Create; + Result.Scanner:=Code.Scanner; + FSourceTools.Add(Result); + end; + Result.CheckFilesOnDisk:=FCheckFilesOnDisk; + Result.IndentSize:=FIndentSize; + Result.VisibleEditorLines:=FVisibleEditorLines; + Result.JumpCentered:=FJumpCentered; + Result.CursorBeyondEOL:=FCursorBeyondEOL; + TFindDeclarationTool(Result).OnGetCodeToolForBuffer:=@OnGetCodeToolForBuffer; +end; + +function TCodeToolManager.OnGetCodeToolForBuffer(Sender: TObject; + Code: TCodeBuffer): TFindDeclarationTool; +begin +{$IFDEF CTDEBUG} +writeln('[TCodeToolManager.OnGetCodeToolForBuffer]' + ,' Sender=',TCustomCodeTool(Sender).Scanner.MainSource.Filename + ,' Code=',Code.Filename); +{$ENDIF} + Result:=TFindDeclarationTool(GetCodeToolForSource(Code,true)); +end; + function TCodeToolManager.ConsistencyCheck: integer; // 0 = ok begin try Result:=0; - if FCodeTool<>nil then begin - Result:=FCodeTool.ConsistencyCheck; + if FCurCodeTool<>nil then begin + Result:=FCurCodeTool.ConsistencyCheck; if Result<>0 then begin dec(Result,1000); exit; end; @@ -1247,6 +1374,10 @@ begin if Result<>0 then begin dec(Result,6000); exit; end; + Result:=FSourceTools.ConsistencyCheck; + if Result<>0 then begin + dec(Result,7000); exit; + end; finally if (Result<>0) and (FCatchExceptions=false) then raise Exception.Create( @@ -1259,11 +1390,11 @@ procedure TCodeToolManager.WriteDebugReport(WriteTool, WriteDefPool, WriteDefTree, WriteCache, WriteGlobalValues: boolean); begin writeln('[TCodeToolManager.WriteDebugReport] Consistency=',ConsistencyCheck); - if FCodeTool<>nil then begin + if FCurCodeTool<>nil then begin if WriteTool then - FCodeTool.WriteDebugTreeReport + FCurCodeTool.WriteDebugTreeReport else - writeln(' FCodeTool.ConsistencyCheck=',FCodeTool.ConsistencyCheck); + writeln(' FCurCodeTool.ConsistencyCheck=',FCurCodeTool.ConsistencyCheck); end; if WriteDefPool then DefinePool.WriteDebugReport diff --git a/components/codetools/codetree.pas b/components/codetools/codetree.pas index 823775dae6..6d1c6bc364 100644 --- a/components/codetools/codetree.pas +++ b/components/codetools/codetree.pas @@ -121,12 +121,16 @@ const ctnIdentifier,ctnArrayType,ctnRecordType,ctnRecordCase,ctnRecordVariant, ctnProcedureType,ctnSetType,ctnRangeType,ctnEnumType,ctnLabelType, ctnTypeType,ctnFileType,ctnPointerType,ctnClassOfType]; + AllSourceTypes = + [ctnProgram,ctnPackage,ctnLibrary,ctnUnit]; + AllUsableSoureTypes = + [ctnUnit]; // CodeTreeNodeSubDescriptors - ctnsNone = 0; - ctnsForwardDeclaration = 1; - ctnsProcHeadNodesCreated = 2; + ctnsNone = 0; + ctnsForwardDeclaration = 1; + ctnsNeedJITParsing = 2; type TCodeTreeNode = class diff --git a/components/codetools/customcodetool.pas b/components/codetools/customcodetool.pas index 238509a065..2214ca48ac 100644 --- a/components/codetools/customcodetool.pas +++ b/components/codetools/customcodetool.pas @@ -94,6 +94,8 @@ type procedure BeginParsing(DeleteNodes, OnlyInterfaceNeeded: boolean); virtual; procedure MoveCursorToNodeStart(ANode: TCodeTreeNode); procedure MoveCursorToCleanPos(ACleanPos: integer); + procedure MoveCursorToCleanPos(ACleanPos: PChar); + function IsPCharInSrc(ACleanPos: PChar): boolean; function ReadTilSection(SectionType: TCodeTreeNodeDesc): boolean; function ReadTilBracketClose(ExceptionOnNotFound: boolean): boolean; function ReadBackTilBracketClose(ExceptionOnNotFound: boolean): boolean; @@ -125,6 +127,11 @@ type CleanStartPos1, CleanStartPos2: integer): boolean; function CompareSrcIdentifier(CleanStartPos: integer; const Identifier: string): boolean; + function CompareSrcIdentifiers(Identifier1, Identifier2: PChar): boolean; + function CompareSrcIdentifiers(CleanStartPos: integer; + AnIdentifier: PChar): boolean; + function GetIdentifier(Identifier: PChar): string; + function GetIdentifier(CleanStartPos: integer): string; procedure ReadPriorAtom; procedure CreateChildNode; @@ -139,7 +146,10 @@ type destructor Destroy; override; end; - ECodeToolError = class(Exception); + ECodeToolError = class(Exception) + Sender: TCustomCodeTool; + constructor Create(ASender: TCustomCodeTool; const AMessage: string); + end; implementation @@ -180,16 +190,19 @@ end; procedure TCustomCodeTool.RaiseException(const AMessage: string); var CaretXY: TCodeXYPosition; + CursorPos: integer; begin ErrorPosition.Code:=nil; - if (CleanPosToCaret(CurPos.StartPos,CaretXY)) + CursorPos:=CurPos.StartPos; + if (CursorPos>SrcLen) and (SrcLen>0) then CursorPos:=SrcLen; + if (CleanPosToCaret(CursorPos,CaretXY)) and (CaretXY.Code<>nil) then begin ErrorPosition:=CaretXY; end else if (Scanner<>nil) and (Scanner.MainCode<>nil) then begin ErrorPosition.Code:=TCodeBuffer(Scanner.MainCode); ErrorPosition.Y:=-1; end; - raise ECodeToolError.Create(AMessage); + raise ECodeToolError.Create(Self,AMessage); end; procedure TCustomCodeTool.SetScanner(NewScanner: TLinkScanner); @@ -215,18 +228,18 @@ begin Result:=''; case Desc of ctnProcedure: - case SubDesc of - // CodeTreeNodeSubDescriptors - ctnsForwardDeclaration : Result:='Forward'; + begin + if (SubDesc and ctnsForwardDeclaration)>0 then Result:='Forward'; + end; + ctnProcedureHead, ctnBeginBlock: + begin + if (SubDesc and ctnsNeedJITParsing)>0 then Result:='Unparsed'; end; ctnClass: - case SubDesc of - // CodeTreeNodeSubDescriptors - ctnsForwardDeclaration : Result:='Forward'; - end; - ctnProcedureHead: - case SubDesc of - ctnsProcHeadNodesCreated: Result:='Nodes Created'; + begin + Result:=''; + if (SubDesc and ctnsForwardDeclaration)>0 then Result:='Forward'; + if (SubDesc and ctnsNeedJITParsing)>0 then Result:=Result+'Unparsed'; end; end; end; @@ -380,14 +393,14 @@ begin else begin if ExceptionOnNotFound then RaiseException( - 'syntax error: identifier expected, but keyword '+GetAtom+' found') + 'identifier expected, but keyword '+GetAtom+' found') else Result:=false; end; end else begin if ExceptionOnNotFound then RaiseException( - 'syntax error: identifier expected, but '+GetAtom+' found') + 'identifier expected, but '+GetAtom+' found') else Result:=false; end; @@ -548,10 +561,22 @@ begin '''': begin inc(CurPos.EndPos); - while (CurPos.EndPos<=SrcLen) - and (Src[CurPos.EndPos]<>'''') do - inc(CurPos.EndPos); - inc(CurPos.EndPos); + while (CurPos.EndPos<=SrcLen) do begin + case Src[CurPos.EndPos] of + + '''': + begin + inc(CurPos.EndPos); + break; + end; + + #10,#13: + break; + + else + inc(CurPos.EndPos); + end; + end; end; else break; @@ -653,7 +678,8 @@ const ntIdentifier, ntCharConstant, ntFloat, ntFloatWithExponent]; var c1, c2: char; - CommentLvl, PrePos: integer; + CommentLvl, PrePos, OldPrePos: integer; + IsStringConstant: boolean; ForbiddenNumberTypes: TNumberTypes; begin if LastAtoms.Count>0 then begin @@ -663,9 +689,12 @@ begin // Skip all spaces and comments CommentLvl:=0; dec(CurPos.StartPos); + IsStringConstant:=false; + OldPrePos:=0; while CurPos.StartPos>=1 do begin if IsCommentEndChar[Src[CurPos.StartPos]] then begin case Src[CurPos.StartPos] of + '}': // pascal comment begin CommentLvl:=1; @@ -678,29 +707,89 @@ begin dec(CurPos.StartPos); end; end; + #10,#13: // possible Delphi comment begin - // read backwards till line start or comment start dec(CurPos.StartPos); if (CurPos.StartPos>=1) and (Src[CurPos.StartPos] in [#10,#13]) and (Src[CurPos.StartPos+1]<>Src[CurPos.StartPos]) then dec(CurPos.StartPos); + // read backwards till line start PrePos:=CurPos.StartPos; - while (PrePos>1) do begin + while (PrePos>=1) and (not (Src[PrePos] in [#10,#13])) do + dec(PrePos); + // read line forward to find out, + // if line ends in comment or string constant + repeat + inc(PrePos); case Src[PrePos] of + '/': - if Src[PrePos-1]='/' then begin + if Src[PrePos+1]='/' then begin // this was a delphi comment -> skip comment - CurPos.StartPos:=PrePos-2; + CurPos.StartPos:=PrePos-1; break; end; + + '{': + begin + // skip pascal comment + CommentLvl:=1; + inc(PrePos); + while (PrePos<=CurPos.StartPos) and (CommentLvl>0) do begin + case Src[PrePos] of + '{': if Scanner.NestedComments then inc(CommentLvl); + '}': dec(CommentLvl); + end; + inc(PrePos); + end; + end; + + '(': + begin + inc(PrePos); + if Src[PrePos]='*' then begin + // skip turbo pascal comment + inc(PrePos); + while (PrePos'*') or (Src[PrePos+1]<>')')) do + inc(PrePos); + inc(PrePos); + end; + end; + + '''': + begin + // a string constant -> skip it + OldPrePos:=PrePos; + repeat + inc(PrePos); + case Src[PrePos] of + + '''': + break; + + #10,#13: + begin + // string constant right border is the line end + // -> last atom of line found + IsStringConstant:=true; + break; + end; + + end; + until false; + if IsStringConstant then break; + end; + #10,#13: - // it was just a line break + // no comment and no string constant found break; + end; - dec(PrePos); - end; - end; + until PrePos>=CurPos.StartPos; + end; // end of possible Delphi comment + ')': // old turbo pascal comment if (CurPos.StartPos>1) and (Src[CurPos.StartPos-1]='*') then begin dec(CurPos.StartPos,3); @@ -710,6 +799,7 @@ begin dec(CurPos.StartPos); end else break; + end; end else if IsSpaceChar[Src[CurPos.StartPos]] then begin repeat @@ -725,6 +815,13 @@ begin if CurPos.StartPos<1 then exit; // read atom + if IsStringConstant then begin + CurPos.StartPos:=OldPrePos; + if (CurPos.StartPos>1) and (Src[CurPos.StartPos-1]='''') then begin + ReadStringConstantBackward; + end; + exit; + end; c2:=UpperSrc[CurPos.StartPos]; case c2 of '_','A'..'Z': @@ -901,7 +998,7 @@ begin end else begin if ExceptionOnNotFound then RaiseException( - 'syntax error: bracket open expected, but '+GetAtom+' found'); + 'bracket open expected, but '+GetAtom+' found'); exit; end; Start:=CurPos; @@ -913,7 +1010,7 @@ begin CurPos:=Start; if ExceptionOnNotFound then RaiseException( - 'syntax error: bracket '+CloseBracket+' not found'); + 'bracket '+CloseBracket+' not found'); exit; end; if (AtomIsChar('(')) or (AtomIsChar('[')) then begin @@ -939,7 +1036,7 @@ begin end else begin if ExceptionOnNotFound then RaiseException( - 'syntax error: bracket close expected, but '+GetAtom+' found'); + 'bracket close expected, but '+GetAtom+' found'); exit; end; Start:=CurPos; @@ -951,7 +1048,7 @@ begin CurPos:=Start; if ExceptionOnNotFound then RaiseException( - 'syntax error: bracket '+CloseBracket+' not found'); + 'bracket '+CloseBracket+' not found'); exit; end; if (AtomIsChar(')')) or (AtomIsChar(']')) then begin @@ -965,10 +1062,13 @@ procedure TCustomCodeTool.BeginParsing(DeleteNodes, OnlyInterfaceNeeded: boolean); begin Scanner.Scan(OnlyInterfaceNeeded,CheckFilesOnDisk); - Src:=Scanner.CleanedSrc; - FLastScannerChangeStep:=Scanner.ChangeStep; - UpperSrc:=UpperCaseStr(Src); - SrcLen:=length(Src); + if FLastScannerChangeStep<>Scanner.ChangeStep then begin + FLastScannerChangeStep:=Scanner.ChangeStep; + Src:=Scanner.CleanedSrc; + UpperSrc:=UpperCaseStr(Src); + SrcLen:=length(Src); + FForceUpdateNeeded:=true; + end; CurPos.StartPos:=1; CurPos.EndPos:=1; LastAtoms.Clear; @@ -992,6 +1092,28 @@ begin CurNode:=nil; end; +procedure TCustomCodeTool.MoveCursorToCleanPos(ACleanPos: PChar); +var NewPos: integer; +begin + if Src='' then + RaiseException('[TCustomCodeTool.MoveCursorToCleanPos - PChar] Src empty'); + NewPos:=Integer(ACleanPos)-Integer(@Src[1])+1; + if (NewPos<1) or (NewPos>SrcLen) then + RaiseException('[TCustomCodeTool.MoveCursorToCleanPos - PChar] ' + +'CleanPos not in Src'); + MoveCursorToCleanPos(NewPos); +end; + +function TCustomCodeTool.IsPCharInSrc(ACleanPos: PChar): boolean; +var NewPos: integer; +begin + Result:=false; + if Src='' then exit; + NewPos:=Integer(ACleanPos)-Integer(@Src[1])+1; + if (NewPos<1) or (NewPos>SrcLen) then exit; + Result:=true; +end; + procedure TCustomCodeTool.CreateChildNode; var NewNode: TCodeTreeNode; begin @@ -1229,5 +1351,74 @@ begin and ((CleanStartPos>Srclen) or (not IsIdentChar[Src[CleanStartPos]])); end; +function TCustomCodeTool.CompareSrcIdentifiers(Identifier1, Identifier2: PChar + ): boolean; +begin + Result:=false; + if (Identifier1=nil) or (Identifier2=nil) then exit; + while IsIdentChar[Identifier1[0]] do begin + if (UpChars[Identifier1[0]]=UpChars[Identifier2[0]]) then begin + inc(Identifier1); + inc(Identifier2); + end else + exit; + end; + Result:=(not IsIdentChar[Identifier2[0]]); +end; + +function TCustomCodeTool.CompareSrcIdentifiers(CleanStartPos: integer; + AnIdentifier: PChar): boolean; +begin + Result:=false; + if (AnIdentifier=nil) or (CleanStartPos<1) or (CleanStartPos>SrcLen) then + exit; + while IsIdentChar[AnIdentifier[0]] do begin + if (UpChars[AnIdentifier[0]]=UpperSrc[CleanStartPos]) then begin + inc(AnIdentifier); + inc(CleanStartPos); + if CleanStartPos>SrcLen then break; + end else + exit; + end; + Result:=(CleanStartPos>SrcLen) or (not IsIdentChar[Src[CleanStartPos]]); +end; + +function TCustomCodeTool.GetIdentifier(Identifier: PChar): string; +var len: integer; +begin + if Identifier<>nil then begin + len:=0; + while (IsIdentChar[Identifier[len]]) do inc(len); + SetLength(Result,len); + if len>0 then + Move(Identifier[0],Result[1],len); + end else + Result:=''; +end; + +function TCustomCodeTool.GetIdentifier(CleanStartPos: integer): string; +var len: integer; +begin + if (CleanStartPos>=1) then begin + len:=0; + while (CleanStartPos<=SrcLen) + and (IsIdentChar[Src[CleanStartPos+len]]) do + inc(len); + SetLength(Result,len); + if len>0 then + Move(Src[CleanStartPos],Result[1],len); + end else + Result:=''; +end; + + +{ ECodeToolError } + +constructor ECodeToolError.Create(ASender: TCustomCodeTool; + const AMessage: string); +begin + inherited Create(AMessage); + Sender:=ASender; +end; end. diff --git a/components/codetools/definetemplates.pas b/components/codetools/definetemplates.pas index c1a1012bc7..98dc3d3582 100644 --- a/components/codetools/definetemplates.pas +++ b/components/codetools/definetemplates.pas @@ -1323,8 +1323,7 @@ end; function TDefinePool.CreateFPCSrcTemplate( const FPCSrcDir, UnitSearchPath: string): TDefineTemplate; -var DefTempl, MainDir, - FCLDir, RTLDir, PackagesDir, CompilerDir: TDefineTemplate; +var Dir, TargetOS, SrcOS, TargetProcessor, UnitLinks, UnitLinkList, IncPathMacro: string; DS: char; @@ -1571,6 +1570,8 @@ var DefTempl, MainDir, // function TDefinePool.CreateFPCSrcTemplate( // const FPCSrcDir: string): TDefineTemplate; +var + DefTempl, MainDir, FCLDir, RTLDir, PackagesDir, CompilerDir: TDefineTemplate; begin Result:=nil; if (FPCSrcDir='') or (not DirectoryExists(FPCSrcDir)) then exit; @@ -1620,6 +1621,7 @@ begin +';'+Dir+'rtl/objpas/' +';'+Dir+'rtl/inc/' +';'+Dir+'rtl/'+TargetProcessor+'/' + +';'+Dir+'rtl/'+SrcOS+'/' ,da_DefineAll)); // fcl @@ -1663,8 +1665,10 @@ begin 'lcl;lcl'+ds+'interfaces'+ds+WidgetType+';'+SrcPath ,da_Define)); MainDir.AddChild(TDefineTemplate.Create('Component path addition', - 'adds designer and synedit to SrcPath',ExternalMacroStart+'SrcPath', - 'components'+ds+'synedit;components'+ds+'codetools;designer;'+SrcPath + 'adds designer, debugger, synedit and codetools to SrcPath', + ExternalMacroStart+'SrcPath', + 'components'+ds+'synedit;components'+ds+'codetools;designer;debugger;' + +SrcPath ,da_Define)); MainDir.AddChild(TDefineTemplate.Create('includepath addition', 'adds include to IncPath',ExternalMacroStart+'IncPath', @@ -1685,9 +1689,9 @@ begin DirTempl:=TDefineTemplate.Create('LCL','LCL Directory', '','lcl',da_Directory); DirTempl.AddChild(TDefineTemplate.Create('WidgetPath', - 'adds widget path to SrcPath' + 'adds abstract widget path to SrcPath' ,ExternalMacroStart+'SrcPath', - 'interfaces'+ds+WidgetType+';'+SrcPath + 'interfaces'+ds+'abstract'+ds+';'+SrcPath ,da_Define)); DirTempl.AddChild(TDefineTemplate.Create('IncludePath', 'adds include to IncPaty',ExternalMacroStart+'IncPath', @@ -1703,10 +1707,10 @@ begin DirTempl.AddChild(SubDirTempl); // components - DirTempl:=TDefineTemplate.Create('Components','Components Dircetory', + DirTempl:=TDefineTemplate.Create('Components','Components Directory', '','components',da_Directory); DirTempl.AddChild(TDefineTemplate.Create('LCL Path','adds lcl to SrcPath', - 'SrcPath', + ExternalMacroStart+'SrcPath', LazarusSrcDir+ds+'lcl' +';'+LazarusSrcDir+ds+'lcl'+ds+'interfaces'+ds+WidgetType +';'+SrcPath @@ -1714,7 +1718,15 @@ begin MainDir.AddChild(DirTempl); // tools - + DirTempl:=TDefineTemplate.Create('Tools','Tools Directory', + '','tools',da_Directory); + DirTempl.AddChild(TDefineTemplate.Create('LCL path addition', + 'adds lcl to SrcPath', + ExternalMacroStart+'SrcPath', + '..'+ds+'lcl;..'+ds+'lcl'+ds+'interfaces'+ds+WidgetType+';'+SrcPath + ,da_Define)); + MainDir.AddChild(DirTempl); + // include // designer diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index a6779ec388..39637bd143 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -53,7 +53,7 @@ maintain a list of all identifier ansistrings) Pos: Code+SrcPos 1. Source: TCodeTreeNode - 2. PPU, PPW, DFU, ...: + 2. PPU, PPW, DCU, ... } unit FindDeclarationTool; @@ -64,6 +64,8 @@ interface {$I codetools.inc} { $DEFINE CTDEBUG} +{ $DEFINE ShowTriedFiles} +{ $DEFINE ShowTriedContexts} uses {$IFDEF MEM_CHECK} @@ -74,8 +76,13 @@ uses PascalParserTool, FileProcs, DefineTemplates; type + TFindDeclarationTool = class; + // searchpath delimiter is semicolon - TOnGetSearchPath = function(Sender: TObject): string; + TOnGetSearchPath = function(Sender: TObject): string of object; + TOnGetCodeToolForBuffer = function(Sender: TObject; + Code: TCodeBuffer): TFindDeclarationTool of object; + TFindDeclarationFlag = ( fdfSearchInParentNodes, // if identifier not found in current context, @@ -87,41 +94,51 @@ type fdfIgnoreUsedUnits, // stay in current source fdfSearchForward, // instead of searching in prior nodes, search in // next nodes (successors) + fdfIgnoreClassVisibility,//find inaccessible private+protected fields fdfClassPublished,fdfClassPublic,fdfClassProtected,fdfClassPrivate); TFindDeclarationFlags = set of TFindDeclarationFlag; TFindDeclarationInput = record Flags: TFindDeclarationFlags; - IdentifierStartPos: integer; - IdentifierEndPos: integer; + Identifier: PChar; ContextNode: TCodeTreeNode; end; + + TFindDeclarationParams = class; + + TFindContext = record + Node: TCodeTreeNode; + Tool: TFindDeclarationTool; + end; TFindDeclarationParams = class(TObject) public Flags: TFindDeclarationFlags; - IdentifierStartPos: integer; - IdentifierEndPos: integer; + Identifier: PChar; ContextNode: TCodeTreeNode; NewNode: TCodeTreeNode; NewCleanPos: integer; - NewCodeTool: TCustomCodeTool; + NewCodeTool: TFindDeclarationTool; NewPos: TCodeXYPosition; NewTopLine: integer; constructor Create; procedure Clear; procedure Save(var Input: TFindDeclarationInput); procedure Load(var Input: TFindDeclarationInput); - procedure SetResult(ANewCodeTool: TCustomCodeTool; ANewNode: TCodeTreeNode); - procedure SetResult(ANewCodeTool: TCustomCodeTool; ANewNode: TCodeTreeNode; - ANewCleanPos: integer); + procedure SetResult(AFindContext: TFindContext); + procedure SetResult(ANewCodeTool: TFindDeclarationTool; + ANewNode: TCodeTreeNode); + procedure SetResult(ANewCodeTool: TFindDeclarationTool; + ANewNode: TCodeTreeNode; ANewCleanPos: integer); procedure ConvertResultCleanPosToCaretPos; procedure ClearResult; + procedure ClearInput; end; TFindDeclarationTool = class(TPascalParserTool) private FOnGetUnitSourceSearchPath: TOnGetSearchPath; + FOnGetCodeToolForBuffer: TOnGetCodeToolForBuffer; {$IFDEF CTDEBUG} DebugPrefix: string; procedure IncPrefix; @@ -136,23 +153,40 @@ type // sub methods for FindIdentifierInContext function FindIdentifierInProcContext(ProcContextNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean; + function FindIdentifierInClassOfMethod(ProcContextNode: TCodeTreeNode; + Params: TFindDeclarationParams): boolean; function FindIdentifierInWithVarContext(WithVarNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean; function FindIdentifierInAncestors(ClassNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean; + function FindIdentifierInUsesSection(UsesNode: TCodeTreeNode; + Params: TFindDeclarationParams): boolean; + function FindIdentifierInHiddenUsedUnits( + Params: TFindDeclarationParams): boolean; + function FindIdentifierInUsedUnit(const AnUnitName: string; + Params: TFindDeclarationParams): boolean; protected function FindDeclarationOfIdentifier( Params: TFindDeclarationParams): boolean; - function FindContextNodeAtCursor(Params: TFindDeclarationParams): TCodeTreeNode; + function FindContextNodeAtCursor( + Params: TFindDeclarationParams): TFindContext; function FindIdentifierInContext(Params: TFindDeclarationParams): boolean; function FindBaseTypeOfNode(Params: TFindDeclarationParams; - Node: TCodeTreeNode): TCodeTreeNode; + Node: TCodeTreeNode): TFindContext; function FindClassOfMethod(ProcNode: TCodeTreeNode; Params: TFindDeclarationParams; FindClassContext: boolean): boolean; function FindForwardIdentifier(Params: TFindDeclarationParams; var IsForward: boolean): boolean; function FindExpressionResultType(Params: TFindDeclarationParams; - StartPos, EndPos: integer): TCodeTreeNode; + StartPos, EndPos: integer): TFindContext; + function FindCodeToolForUsedUnit(UnitNameAtom, + UnitInFileAtom: TAtomPosition; + ExceptionOnNotFound: boolean): TFindDeclarationTool; + function FindIdentifierInInterface(AskingTool: TFindDeclarationTool; + Params: TFindDeclarationParams): boolean; + function CompareNodeIdentifier(Node: TCodeTreeNode; + Params: TFindDeclarationParams): boolean; + function GetInterfaceNode: TCodeTreeNode; public function FindDeclaration(CursorPos: TCodeXYPosition; var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean; @@ -160,6 +194,8 @@ type AnUnitInFilename: string): TCodeBuffer; property OnGetUnitSourceSearchPath: TOnGetSearchPath read FOnGetUnitSourceSearchPath write FOnGetUnitSourceSearchPath; + property OnGetCodeToolForBuffer: TOnGetCodeToolForBuffer + read FOnGetCodeToolForBuffer write FOnGetCodeToolForBuffer; end; @@ -168,9 +204,26 @@ implementation const fdfAllClassVisibilities = [fdfClassPublished,fdfClassPublic,fdfClassProtected, - fdfClassPrivate]; + fdfClassPrivate]; fdfGlobals = [fdfExceptionOnNotFound, fdfIgnoreUsedUnits]; + +{ TFindContext } + +function CreateFindContext(NewTool: TFindDeclarationTool; + NewNode: TCodeTreeNode): TFindContext; +begin + Result.Node:=NewNode; + Result.Tool:=NewTool; +end; + +function CreateFindContext(Params: TFindDeclarationParams): TFindContext; +begin + Result.Node:=Params.NewNode; + Result.Tool:=TFindDeclarationTool(Params.NewCodeTool); +end; + + { TFindDeclarationTool } function TFindDeclarationTool.FindDeclaration(CursorPos: TCodeXYPosition; @@ -212,7 +265,7 @@ writeln('TFindDeclarationTool.FindDeclaration D CursorNode=',NodeDescriptionAsSt ClassNode:=ClassNode.Parent; if ClassNode<>nil then begin // cursor is in class/object definition - if ClassNode.SubDesc<>ctnsForwardDeclaration then begin + if (ClassNode.SubDesc and ctnsForwardDeclaration)=0 then begin // parse class and build CodeTreeNodes for all properties/methods BuildSubTreeForClass(ClassNode); CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true); @@ -234,8 +287,7 @@ writeln('TFindDeclarationTool.FindDeclaration D CursorNode=',NodeDescriptionAsSt Params:=TFindDeclarationParams.Create; try Params.ContextNode:=CursorNode; - Params.IdentifierStartPos:=CurPos.StartPos; - Params.IdentifierEndPos:=CurPos.EndPos; + Params.Identifier:=@Src[CurPos.StartPos]; Params.Flags:=[fdfSearchInAncestors,fdfSearchInParentNodes, fdfExceptionOnNotFound]; Result:=FindDeclarationOfIdentifier(Params); @@ -268,7 +320,7 @@ writeln('TFindDeclarationTool.FindDeclarationInUsesSection A'); MoveCursorToNodeStart(UsesNode); ReadNextAtom; if not UpAtomIs('USES') then - RaiseException('syntax error: expected uses, but '+GetAtom+' found'); + RaiseException('expected uses, but '+GetAtom+' found'); repeat ReadNextAtom; // read name if CurPos.StartPos>CleanPos then break; @@ -280,7 +332,7 @@ writeln('TFindDeclarationTool.FindDeclarationInUsesSection A'); ReadNextAtom; if not AtomIsStringConstant then RaiseException( - 'syntax error: string constant expected, but '+GetAtom+' found'); + 'string constant expected, but '+GetAtom+' found'); UnitInFilePos:=CurPos; ReadNextAtom; end else @@ -305,8 +357,7 @@ writeln('TFindDeclarationTool.FindDeclarationInUsesSection A'); end; if AtomIsChar(';') then break; if not AtomIsChar(',') then - RaiseException( - 'syntax error: ; expected, but '+GetAtom+' found') + RaiseException('; expected, but '+GetAtom+' found') until (CurPos.StartPos>SrcLen); {$IFDEF CTDEBUG} writeln('TFindDeclarationTool.FindDeclarationInUsesSection END cursor not on unitname'); @@ -319,7 +370,7 @@ function TFindDeclarationTool.FindUnitSource(const AnUnitName, function LoadFile(const ExpandedFilename: string; var NewCode: TCodeBuffer): boolean; begin -{$IFDEF CTDEBUG} +{$IFDEF ShowTriedFiles} writeln('TFindDeclarationTool.FindUnitSource.LoadFile ',ExpandedFilename); {$ENDIF} NewCode:=TCodeBuffer(Scanner.OnLoadSource(Self,ExpandedFilename)); @@ -390,8 +441,8 @@ writeln('TFindDeclarationTool.FindUnitSource.LoadFile ',ExpandedFilename); begin Result:=nil; UnitLinks:=Scanner.Values[ExternalMacroStart+'UnitLinks']; -{$IFDEF CTDEBUG} -writeln('TFindDeclarationTool.FindUnitSource.SearchUnitInUnitLinks'); +{$IFDEF ShowTriedFiles} +//writeln('TFindDeclarationTool.FindUnitSource.SearchUnitInUnitLinks'); {$ENDIF} UnitLinkStart:=1; while UnitLinkStart<=length(UnitLinks) do begin @@ -403,8 +454,8 @@ writeln('TFindDeclarationTool.FindUnitSource.SearchUnitInUnitLinks'); do inc(UnitLinkEnd); if UnitLinkEnd>UnitLinkStart then begin -{$IFDEF CTDEBUG} -writeln(' unit "',copy(UnitLinks,UnitLinkStart,UnitLinkEnd-UnitLinkStart),'"'); +{$IFDEF ShowTriedFiles} +//writeln(' unit "',copy(UnitLinks,UnitLinkStart,UnitLinkEnd-UnitLinkStart),'"'); {$ENDIF} if AnsiCompareText(TheUnitName, copy(UnitLinks,UnitLinkStart,UnitLinkEnd-UnitLinkStart))=0 @@ -512,7 +563,7 @@ function TFindDeclarationTool.FindDeclarationOfIdentifier( identifier Params: - IdentifierStartPos, IdentifierEndPos + Identifier in clean source ContextNode // = DeepestNode at Cursor Result: @@ -521,31 +572,42 @@ function TFindDeclarationTool.FindDeclarationOfIdentifier( For example: A^.B().C[].Identifier } -var NewContextNode, OldContextNode: TCodeTreeNode; +var OldContextNode: TCodeTreeNode; + NewContext: TFindContext; begin {$IFDEF CTDEBUG} writeln('[TFindDeclarationTool.FindDeclarationOfIdentifier] Identifier=', - copy(Src,Params.IdentifierStartPos,Params.IdentifierEndPos-Params.IdentifierStartPos), + GetIdentifier(Params.Identifier), ' ContextNode=',NodeDescriptionAsString(Params.ContextNode.Desc)); {$ENDIF} Result:=false; - MoveCursorToCleanPos(Params.IdentifierStartPos); + MoveCursorToCleanPos(Params.Identifier); OldContextNode:=Params.ContextNode; - NewContextNode:=FindContextNodeAtCursor(Params); + NewContext:=FindContextNodeAtCursor(Params); Params.Flags:=[fdfSearchInAncestors] +fdfAllClassVisibilities+(fdfGlobals*Params.Flags); - if NewContextNode=OldContextNode then begin + if NewContext.Node=OldContextNode then begin Params.Flags:=Params.Flags+[fdfSearchInParentNodes,fdfIgnoreCurContextNode]; end; + if NewContext.Tool<>Self then begin + // search in used unit + Exclude(Params.Flags,fdfClassPrivate); + if NewContext.Node.Desc=ctnClass then begin + // ToDo: if context node is not the class of the method the + // search started, remove fdfClassProtected from Flags + + end; + end; if (OldContextNode.Desc=ctnTypeDefinition) and (OldContextNode.FirstChild<>nil) and (OldContextNode.FirstChild.Desc=ctnClass) - and (OldContextNode.FirstChild.SubDesc=ctnsForwardDeclaration) + and ((OldContextNode.FirstChild.SubDesc and ctnsForwardDeclaration)>0) then Include(Params.Flags,fdfSearchForward); - Params.ContextNode:=NewContextNode; - Result:=FindIdentifierInContext(Params); + Params.ContextNode:=NewContext.Node; + + Result:=NewContext.Tool.FindIdentifierInContext(Params); end; function TFindDeclarationTool.FindIdentifierInContext( @@ -554,7 +616,7 @@ function TFindDeclarationTool.FindIdentifierInContext( It does not care about code in front of the identifier like 'a.Identifer'. Params: - IdentifierStartPos, IdentifierEndPos + Identifier ContextNode // = DeepestNode at Cursor Result: @@ -567,11 +629,6 @@ begin StartContextNode:=ContextNode; Result:=false; - if ContextNode.Desc=ctnClass then begin - // just-in-time parsing for class node - BuildSubTreeForClass(ContextNode); - end; - if (fdfSearchForward in Params.Flags) then begin // ToDo: check for circles @@ -580,12 +637,13 @@ begin if ContextNode<>nil then begin repeat -{$IFDEF CTDEBUG} +{$IFDEF ShowTriedContexts} writeln('[TFindDeclarationTool.FindIdentifierInContext] A Ident=', -copy(Src,Params.IdentifierStartPos,Params.IdentifierEndPos-Params.IdentifierStartPos), +GetIdentifier(Params.Identifier), ' Context=',ContextNode.DescAsString,' "',copy(Src,ContextNode.StartPos,8),'"', -' ParentsAllowed=',fdfSearchInParentNodes in Params.Flags, -' AncestorsAllowed=',fdfSearchInAncestors in Params.Flags +' P=',fdfSearchInParentNodes in Params.Flags, +' A=',fdfSearchInAncestors in Params.Flags, +' IUU=',fdfIgnoreUsedUnits in Params.Flags ); if (ContextNode.Desc=ctnClass) then writeln(' ContextNode.LastChild=',ContextNode.LastChild<>nil); @@ -600,20 +658,25 @@ if (ContextNode.Desc=ctnClass) then ctnClass, ctnRecordType, ctnRecordCase, ctnRecordVariant, ctnParameterList: - if (ContextNode.LastChild<>nil) then begin - if not (fdfSearchForward in Params.Flags) then - ContextNode:=ContextNode.LastChild - else - ContextNode:=ContextNode.FirstChild; + begin + if ContextNode.Desc=ctnClass then begin + // just-in-time parsing for class node + BuildSubTreeForClass(ContextNode); + end; + if (ContextNode.LastChild<>nil) then begin + if not (fdfSearchForward in Params.Flags) then + ContextNode:=ContextNode.LastChild + else + ContextNode:=ContextNode.FirstChild; + end; end; ctnTypeDefinition, ctnVarDefinition, ctnConstDefinition, ctnEnumType: begin - if CompareSrcIdentifiers(Params.IdentifierStartPos, - ContextNode.StartPos) then - begin -{$IFDEF CTDEBUG} -writeln(' Definition Identifier found=',copy(Src,ContextNode.StartPos,Params.IdentifierEndPos-Params.IdentifierStartPos)); + if CompareSrcIdentifiers(ContextNode.StartPos,Params.Identifier) + then begin +{$IFDEF ShowTriedContexts} +writeln(' Definition Identifier found=',GetIdentifier(Params.Identifier)); {$ENDIF} // identifier found Result:=true; @@ -644,33 +707,35 @@ writeln(' Definition Identifier found=',copy(Src,ContextNode.StartPos,Params.Id MoveCursorToNodeStart(ContextNode); ReadNextAtom; // read keyword ReadNextAtom; // read name - if CompareSrcIdentifiers(Params.IdentifierStartPos,CurPos.StartPos) - then begin + if CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier) then + begin // identifier found -{$IFDEF CTDEBUG} -writeln(' Source Name Identifier found=',copy(Src,CurPos.StartPos,Params.IdentifierEndPos-Params.IdentifierStartPos)); +{$IFDEF ShowTriedContexts} +writeln(' Source Name Identifier found=',GetIdentifier(Params.Identifier)); {$ENDIF} Result:=true; Params.SetResult(Self,ContextNode,CurPos.StartPos); exit; end; + Result:=FindIdentifierInHiddenUsedUnits(Params); + if Result then exit; end; ctnProperty: begin - if (Src[Params.IdentifierStartPos]<>'[') then begin + if (Params.Identifier[0]<>'[') then begin MoveCursorToNodeStart(ContextNode); ReadNextAtom; // read keyword 'property' ReadNextAtom; // read name - if CompareSrcIdentifiers(Params.IdentifierStartPos,CurPos.StartPos) - then begin + if CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier) then + begin // identifier found // ToDo: identifiers after 'read', 'write' are procs with // special parameter lists -{$IFDEF CTDEBUG} -writeln(' Property Identifier found=',copy(Src,CurPos.StartPos,Params.IdentifierEndPos-Params.IdentifierStartPos)); +{$IFDEF ShowTriedContexts} +writeln(' Property Identifier found=',GetIdentifier(Params.Identifier)); {$ENDIF} Result:=true; Params.SetResult(Self,ContextNode,CurPos.StartPos); @@ -685,11 +750,8 @@ writeln(' Property Identifier found=',copy(Src,CurPos.StartPos,Params.Identifie ctnUsesSection: begin - // search backwards through the uses section - // compare first the unit name then load the unit and search there - - // ToDo: - + Result:=FindIdentifierInUsesSection(ContextNode,Params); + if Result then exit; end; ctnWithVariable: @@ -709,7 +771,7 @@ writeln(' Property Identifier found=',copy(Src,CurPos.StartPos,Params.Identifie end; end else begin Exclude(Params.Flags,fdfIgnoreCurContextNode); -{$IFDEF CTDEBUG} +{$IFDEF ShowTriedContexts} writeln('[TFindDeclarationTool.FindIdentifierInContext] IgnoreCurContext'); {$ENDIF} end; @@ -724,7 +786,7 @@ writeln('[TFindDeclarationTool.FindIdentifierInContext] IgnoreCurContext'); // even searching in ancestors contexts is not permitted // -> there is no prior context accessible any more // -> identifier not found -{$IFDEF CTDEBUG} +{$IFDEF ShowTriedContexts} writeln('[TFindDeclarationTool.FindIdentifierInContext] no prior node accessible ContextNode=',ContextNode.DescAsString); {$ENDIF} exit; @@ -734,7 +796,7 @@ writeln('[TFindDeclarationTool.FindIdentifierInContext] no prior node accessible repeat // search for prior node -{$IFDEF CTDEBUG} +{$IFDEF ShowTriedContexts} //writeln('[TFindDeclarationTool.FindIdentifierInContext] Searching prior node of ',ContextNode.DescAsString); {$ENDIF} if (ContextNode.Desc=ctnClass) @@ -747,13 +809,14 @@ writeln('[TFindDeclarationTool.FindIdentifierInContext] no prior node accessible if ((not (fdfSearchForward in Params.Flags)) and (ContextNode.PriorBrother<>nil)) or ((fdfSearchForward in Params.Flags) - and (ContextNode.NextBrother<>nil)) then + and (ContextNode.NextBrother<>nil) + and (ContextNode.NextBrother.Desc<>ctnImplementation)) then begin if not (fdfSearchForward in Params.Flags) then ContextNode:=ContextNode.PriorBrother else ContextNode:=ContextNode.NextBrother; -{$IFDEF CTDEBUG} +{$IFDEF ShowTriedContexts} writeln('[TFindDeclarationTool.FindIdentifierInContext] Searching in PriorBrother ContextNode=',ContextNode.DescAsString); {$ENDIF} // it is not always allowed to search in every node on the same lvl: @@ -769,7 +832,7 @@ writeln('[TFindDeclarationTool.FindIdentifierInContext] Searching in PriorBrothe end; end else if ContextNode.Parent<>nil then begin ContextNode:=ContextNode.Parent; -{$IFDEF CTDEBUG} +{$IFDEF ShowTriedContexts} writeln('[TFindDeclarationTool.FindIdentifierInContext] Searching in Parent ContextNode=',ContextNode.DescAsString); {$ENDIF} case ContextNode.Desc of @@ -789,6 +852,12 @@ writeln('[TFindDeclarationTool.FindIdentifierInContext] Searching in Parent Con // do not search again in this node, go on ... ; + ctnProcedure: + begin + Result:=FindIdentifierInClassOfMethod(ContextNode,Params); + if Result then exit; + end; + else break; end; @@ -803,9 +872,9 @@ writeln('[TFindDeclarationTool.FindIdentifierInContext] Searching in Parent Con // DeepestNode=nil -> ignore end; if fdfExceptionOnNotFound in Params.Flags then begin - MoveCursorToCleanPos(Params.IdentifierStartPos); - RaiseException('Identifier not found '+copy(Src,Params.IdentifierStartPos, - Params.IdentifierEndPos-Params.IdentifierStartPos)); + if IsPCharInSrc(Params.Identifier) then + MoveCursorToCleanPos(Params.Identifier); + RaiseException('Identifier not found '+GetIdentifier(Params.Identifier)); end; end; @@ -814,7 +883,7 @@ function TFindDeclarationTool.FindEnumInContext( { search all subnodes for ctnEnumType Params: - IdentifierStartPos, IdentifierEndPos + Identifier ContextNode // = DeepestNode at Cursor Result: @@ -831,8 +900,7 @@ begin Params.ContextNode:=Params.ContextNode.FirstChild; while Params.ContextNode<>nil do begin if (Params.ContextNode.Desc in [ctnEnumType]) - and CompareSrcIdentifiers(Params.IdentifierStartPos, - Params.ContextNode.StartPos) + and CompareSrcIdentifiers(Params.ContextNode.StartPos,Params.Identifier) then begin // identifier found Result:=true; @@ -849,7 +917,7 @@ begin end; function TFindDeclarationTool.FindContextNodeAtCursor( - Params: TFindDeclarationParams): TCodeTreeNode; + Params: TFindDeclarationParams): TFindContext; { searches for the context node for a specific cursor pos Params.Context should contain the deepest node at cursor if there is no special context, then result is equal to Params.Context @@ -883,16 +951,21 @@ function TFindDeclarationTool.FindContextNodeAtCursor( type TAtomType = (atNone, atSpace, atIdentifier, atPoint, atAS, atINHERITED, atUp, atRoundBracketOpen, atRoundBracketClose, - atEdgedBracketOpen, atEdgedBracketClose); + atEdgedBracketOpen, atEdgedBracketClose, + atRead, atWrite); const AtomTypeNames: array[TAtomType] of string = ('','Space','Ident','Point','AS','INHERITED','Up^', - 'Bracket(','Bracket)','Bracket[','Bracket]'); + 'Bracket(','Bracket)','Bracket[','Bracket]','READ','WRITE'); function GetCurrentAtomType: TAtomType; begin if (CurPos.StartPos=CurPos.EndPos) then Result:=atSpace + else if UpAtomIs('READ') then + Result:=atRead + else if UpAtomIs('WRITE') then + Result:=atWrite else if AtomIsIdentifier(false) then Result:=atIdentifier else if (CurPos.StartPos>=1) and (CurPos.StartPos<=SrcLen) @@ -906,7 +979,8 @@ const ']': Result:=atEdgedBracketClose; else Result:=atNone; end; - end else if UpAtomIs('INHERITED') then + end + else if UpAtomIs('INHERITED') then Result:=atINHERITED else if UpAtomIs('AS') then Result:=atAS @@ -926,8 +1000,15 @@ begin ReadPriorAtom; CurAtom:=CurPos; CurAtomType:=GetCurrentAtomType; +write('[TFindDeclarationTool.FindContextNodeAtCursor] A ', + ' Context=',Params.ContextNode.DescAsString, + ' CurAtom=',AtomTypeNames[CurAtomType], + ' "',copy(Src,CurAtom.StartPos,CurAtom.EndPos-CurAtom.StartPos),'"', + ' NextAtom=',AtomTypeNames[NextAtomType] + ); +writeln(''); if not (CurAtomType in [atIdentifier,atPoint,atUp,atAs,atEdgedBracketClose, - atRoundBracketClose]) + atRoundBracketClose,atRead,atWrite]) then begin // no special context found -> the context node is the deepest node at // cursor, and this should already be in Params.ContextNode @@ -936,23 +1017,23 @@ begin begin MoveCursorToCleanPos(NextAtom.StartPos); ReadNextAtom; - RaiseException('syntax error: identifier expected, but ' + RaiseException('identifier expected, but ' +GetAtom+' found'); end; - Result:=Params.ContextNode; + Result:=CreateFindContext(Self,Params.ContextNode); exit; end; if (CurAtomType in [atRoundBracketClose,atEdgedBracketClose]) then begin ReadBackTilBracketClose(true); CurAtom.StartPos:=CurPos.StartPos; end; - if CurAtomType<>atAS then + if not (CurAtomType in [atAS,atRead,atWrite]) then Result:=FindContextNodeAtCursor(Params) else - Result:=Params.ContextNode; - if Result=nil then exit; + Result:=CreateFindContext(Self,Params.ContextNode); + if Result.Node=nil then exit; - // coming back the left side has been parsed and + // the left side has been parsed and // now the parsing goes from left to right {$IFDEF CTDEBUG} @@ -962,7 +1043,7 @@ write('[TFindDeclarationTool.FindContextNodeAtCursor] B ', ' "',copy(Src,CurAtom.StartPos,CurAtom.EndPos-CurAtom.StartPos),'"', ' NextAtom=',AtomTypeNames[NextAtomType], ' Result='); -if Result<>nil then write(Result.DescAsString) else write('NIL'); +if Result.Node<>nil then write(Result.Node.DescAsString) else write('NIL'); writeln(''); {$ENDIF} @@ -976,9 +1057,9 @@ writeln(''); begin MoveCursorToCleanPos(NextAtom.StartPos); ReadNextAtom; - RaiseException('syntax error: "'+GetAtom+'" found'); + RaiseException('illegal qualifier "'+GetAtom+'" found'); end; - if (Result=Params.ContextNode) then begin + if (Result.Node=Params.ContextNode) then begin if CompareSrcIdentifier(CurAtom.StartPos,'SELF') then begin // SELF in a method is the object itself // -> check if in a proc @@ -986,8 +1067,8 @@ writeln(''); while (ProcNode<>nil) do begin if (ProcNode.Desc=ctnProcedure) then begin // in a proc -> find the class context - if FindClassOfMethod(ProcNode,Params,true) then begin - Result:=Params.NewNode; + if Result.Tool.FindClassOfMethod(ProcNode,Params,true) then begin + Result:=CreateFindContext(Params); exit; end; end; @@ -999,14 +1080,8 @@ writeln(''); ProcNode:=Params.ContextNode; while (ProcNode<>nil) do begin if (ProcNode.Desc=ctnProcedure) then begin - MoveCursorToNodeStart(ProcNode); - ReadNextAtom; - if UpAtomIs('CLASS') then ReadNextAtom; - if UpAtomIs('FUNCTION') then begin - // in a function -> find the result type - Result:=FindBaseTypeOfNode(Params,ProcNode); - exit; - end; + Result:=Result.Tool.FindBaseTypeOfNode(Params,ProcNode); + exit; end; ProcNode:=ProcNode.Parent; end; @@ -1018,34 +1093,45 @@ writeln(''); Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound] +fdfAllClassVisibilities +(fdfGlobals*Params.Flags); -//writeln(' ',Result=Params.ContextNode,' ',Result.DescAsString,',',Params.ContextNode.DescAsString); - if Result=Params.ContextNode then begin +//writeln(' AAA ',Result.Node=Params.ContextNode,' ',Result.Node.DescAsString,',',Params.ContextNode.DescAsString); + if Result.Node=Params.ContextNode then begin // there is no special context -> also search in parent contexts Params.Flags:=Params.Flags +[fdfSearchInParentNodes,fdfIgnoreCurContextNode]; end else - Params.ContextNode:=Result; - Params.IdentifierStartPos:=CurAtom.StartPos; - Params.IdentifierEndPos:=CurAtom.EndPos; - FindIdentifierInContext(Params); - Result:=Params.NewNode; + // special context + Params.ContextNode:=Result.Node; + Params.Identifier:=@Src[CurAtom.StartPos]; + Result.Tool.FindIdentifierInContext(Params); + Result:=CreateFindContext(Params); finally Params.Load(OldInput); end; - Result:=FindBaseTypeOfNode(Params,Result); + Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node); end; atPoint: begin // for example 'A.B' + if Result.Node=Params.ContextNode then begin + MoveCursorToCleanPos(CurAtom.StartPos); + RaiseException('identifier expected, but . found'); + end; if (not (NextAtomType in [atSpace,atIdentifier])) then begin MoveCursorToCleanPos(NextAtom.StartPos); ReadNextAtom; - RaiseException('syntax error: identifier expected, but ' - +GetAtom+' found'); + RaiseException('identifier expected, but '+GetAtom+' found'); end; - // there is nothing special to do here, because the '.' will only change - // from an identifier to its type context. But this is always done. + if (Result.Node.Desc in AllUsableSoureTypes) then begin + // identifier in front of the point is a unit name + if Result.Tool<>Self then begin + Result.Node:=Result.Tool.GetInterfaceNode; + end else begin + Result:=CreateFindContext(Self,Params.ContextNode); + end; + end; + // there is no special left to do, since Result already points to + // the type context node. end; atAS: @@ -1054,10 +1140,10 @@ writeln(''); if (not (NextAtomType in [atSpace,atIdentifier])) then begin MoveCursorToCleanPos(NextAtom.StartPos); ReadNextAtom; - RaiseException('syntax error: identifier expected, but ' - +GetAtom+' found'); + RaiseException('identifier expected, but '+GetAtom+' found'); end; - // 'as' is a type cast, so the left side is irrelevant + // 'as' is a type cast, so the left side is irrelevant and was already + // ignored in the code at the start of this proc // -> context is default context end; @@ -1071,22 +1157,22 @@ writeln(''); begin MoveCursorToCleanPos(NextAtom.StartPos); ReadNextAtom; - RaiseException('syntax error: "'+GetAtom+'" found'); + RaiseException('illegal qualifier "'+GetAtom+'" found'); end; - if Result<>Params.ContextNode then begin + if Result.Node<>Params.ContextNode then begin // left side of expression has defined a special context // => this '^' is a dereference if (not (NextAtomType in [atSpace,atPoint,atAS,atUP])) then begin MoveCursorToCleanPos(NextAtom.StartPos); ReadNextAtom; - RaiseException('syntax error: . expected, but '+GetAtom+' found'); + RaiseException('. expected, but '+GetAtom+' found'); end; - if Result.Desc<>ctnPointerType then begin + if Result.Node.Desc<>ctnPointerType then begin MoveCursorToCleanPos(CurAtom.StartPos); RaiseException('illegal qualifier ^'); end; - Result:=FindBaseTypeOfNode(Params,Result.FirstChild); - end else if NodeHasParentOfType(Result,ctnPointerType) then begin + Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node.FirstChild); + end else if NodeHasParentOfType(Result.Node,ctnPointerType) then begin // this is a pointer type definition // -> the default context is ok end; @@ -1105,32 +1191,34 @@ writeln(''); begin MoveCursorToCleanPos(NextAtom.StartPos); ReadNextAtom; - RaiseException('syntax error: illegal qualifier'); + RaiseException('illegal qualifier'); end; - if Result<>Params.ContextNode then begin - case Result.Desc of + if Result.Node<>Params.ContextNode then begin + case Result.Node.Desc of ctnArrayType: // the array type is the last child node - Result:=FindBaseTypeOfNode(Params,Result.LastChild); + Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node.LastChild); ctnPointerType: // the pointer type is the only child node - Result:=FindBaseTypeOfNode(Params,Result.FirstChild); + Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node.FirstChild); ctnClass: begin + // search default property in class Params.Save(OldInput); Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound] +fdfGlobals*Params.Flags; - Params.IdentifierStartPos:=CurAtom.StartPos; - Params.IdentifierEndPos:=CurAtom.StartPos+1; - Params.ContextNode:=Result; - FindIdentifierInContext(Params); - Result:=FindBaseTypeOfNode(Params,Params.NewNode); + Params.Identifier:='['; // special identifier for default property + Params.ContextNode:=Result.Node; + Result.Tool.FindIdentifierInContext(Params); + Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); Params.Load(OldInput); end; - + + // ToDo string, ansistring, widestring, shortstring + else MoveCursorToCleanPos(CurAtom.StartPos); RaiseException('illegal qualifier'); @@ -1150,12 +1238,12 @@ writeln(''); begin MoveCursorToCleanPos(NextAtom.StartPos); ReadNextAtom; - RaiseException('syntax error: illegal qualifier'); + RaiseException('illegal qualifier'); end; - if Result<>Params.ContextNode then begin + if Result.Node<>Params.ContextNode then begin // typecast or function - // ToDo + // ToDo: proc overloading, if parameter types incompatible search next end else begin // expression @@ -1164,7 +1252,7 @@ writeln(''); end; end; - // ToDo: atINHERITED, atRoundBracketClose + // ToDo: atINHERITED else // expression start found @@ -1174,10 +1262,8 @@ writeln(''); begin MoveCursorToCleanPos(NextAtom.StartPos); ReadNextAtom; - RaiseException('syntax error: identifier expected, but ' - +GetAtom+' found'); + RaiseException('identifier expected, but '+GetAtom+' found'); end; - Result:=Params.ContextNode; end; end; @@ -1185,129 +1271,136 @@ writeln(''); write('[TFindDeclarationTool.FindContextNodeAtCursor] END ', Params.ContextNode.DescAsString,' CurAtom=',AtomTypeNames[CurAtomType], ' NextAtom=',AtomTypeNames[NextAtomType],' Result='); -if Result<>nil then write(Result.DescAsString) else write('NIL'); +if Result.Node<>nil then write(Result.Node.DescAsString) else write('NIL'); writeln(''); {$ENDIF} end; function TFindDeclarationTool.FindBaseTypeOfNode(Params: TFindDeclarationParams; - Node: TCodeTreeNode): TCodeTreeNode; + Node: TCodeTreeNode): TFindContext; var OldInput: TFindDeclarationInput; ClassIdentNode: TCodeTreeNode; begin - Result:=Node; - while (Result<>nil) do begin + Result.Node:=Node; + Result.Tool:=Self; + while (Result.Node<>nil) do begin // ToDo: check for circles -{$IFDEF CTDEBUG} -//writeln('[TFindDeclarationTool.FindBaseTypeOfNode] A Result=',Result.DescAsString); +{$IFDEF ShowTriedContexts} +writeln('[TFindDeclarationTool.FindBaseTypeOfNode] A Result=',Result.Node.DescAsString); {$ENDIF} - if (Result.Desc in AllIdentifierDefinitions) then begin + if (Result.Node.Desc in AllIdentifierDefinitions) then begin // instead of variable/const/type definition, return the type - Result:=FindTypeNodeOfDefinition(Result); + Result.Node:=FindTypeNodeOfDefinition(Result.Node); end else - if (Result.Desc=ctnClass) and (Result.SubDesc=ctnsForwardDeclaration) then + if (Result.Node.Desc=ctnClass) + and ((Result.Node.SubDesc and ctnsForwardDeclaration)>0) then begin // search the real class - ClassIdentNode:=Result.Parent; + ClassIdentNode:=Result.Node.Parent; if (ClassIdentNode=nil) or (not (ClassIdentNode.Desc=ctnTypeDefinition)) then begin - MoveCursorToCleanPos(Result.StartPos); + MoveCursorToCleanPos(Result.Node.StartPos); RaiseException('[TFindDeclarationTool.FindBaseTypeOfNode] ' +'forward class node without name'); end; Params.Save(OldInput); try - Params.IdentifierStartPos:=ClassIdentNode.StartPos; - Params.IdentifierEndPos:=ClassIdentNode.EndPos; - Params.Flags:=[fdfSearchInParentNodes,fdfSearchForward] - +(fdfGlobals*Params.Flags) - +[fdfExceptionOnNotFound]; + Params.Identifier:=@Src[ClassIdentNode.StartPos]; + Params.Flags:=[fdfSearchInParentNodes,fdfSearchForward, + fdfIgnoreUsedUnits,fdfExceptionOnNotFound] + +(fdfGlobals*Params.Flags); Params.ContextNode:=ClassIdentNode; FindIdentifierInContext(Params); - if Params.NewNode.Desc<>ctnTypeDefinition then begin - MoveCursorToCleanPos(Result.StartPos); + if (Params.NewNode.Desc<>ctnTypeDefinition) + or (Params.NewCodeTool<>Self) then begin + MoveCursorToCleanPos(Result.Node.StartPos); RaiseException('Forward class definition not resolved: ' +copy(Src,ClassIdentNode.StartPos, ClassIdentNode.EndPos-ClassIdentNode.StartPos)); end; + Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); + exit; finally Params.Load(OldInput); end; end else - if (Result.Desc=ctnIdentifier) then begin + if (Result.Node.Desc=ctnIdentifier) then begin // this type is just an alias for another type // -> search the basic type - if Result.Parent=nil then + if Result.Node.Parent=nil then break; Params.Save(OldInput); try - Params.IdentifierStartPos:=Result.StartPos; - Params.IdentifierEndPos:=Result.EndPos; + Params.Identifier:=@Src[Result.Node.StartPos]; Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound] +(fdfGlobals*Params.Flags); - Params.ContextNode:=Result.Parent; + Params.ContextNode:=Result.Node.Parent; if Params.ContextNode.Desc=ctnParameterList then Params.ContextNode:=Params.ContextNode.Parent; if Params.ContextNode.Desc=ctnProcedureHead then Params.ContextNode:=Params.ContextNode.Parent; FindIdentifierInContext(Params); - Result:=Params.NewNode; + Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); + exit; finally Params.Load(OldInput); end; end else - if (Result.Desc=ctnProperty) then begin + if (Result.Node.Desc=ctnProperty) then begin // this is a property -> search the type definition of the property - ReadTilTypeOfProperty(Result); + ReadTilTypeOfProperty(Result.Node); Params.Save(OldInput); try - Params.IdentifierStartPos:=CurPos.StartPos; - Params.IdentifierEndPos:=CurPos.EndPos; + Params.Identifier:=@Src[CurPos.StartPos]; Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound] +(fdfGlobals*Params.Flags); - Params.ContextNode:=Result.Parent; + Params.ContextNode:=Result.Node.Parent; FindIdentifierInContext(Params); - if Result.HasAsParent(Params.NewNode) then - break - else - Result:=Params.NewNode; + if Result.Node.HasAsParent(Params.NewNode) then + break; + Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); + exit; finally Params.Load(OldInput); end; end else - if (Result.Desc in [ctnProcedure,ctnProcedureHead]) then begin + if (Result.Node.Desc in [ctnProcedure,ctnProcedureHead]) then begin // a proc -> if this is a function return the result type - if Result.Desc=ctnProcedureHead then Result:=Result.Parent; - MoveCursorToNodeStart(Result); + if Result.Node.Desc=ctnProcedureHead then + Result.Node:=Result.Node.Parent; + MoveCursorToNodeStart(Result.Node); ReadNextAtom; if UpAtomIs('CLASS') then ReadNextAtom; if UpAtomIs('FUNCTION') then begin // in a function -> find the result type - BuildSubTreeForProcHead(Result); - Result:=Result.FirstChild.FirstChild; - if Result.Desc=ctnParameterList then - Result:=Result.NextBrother; + // build nodes for parameter list and result type + BuildSubTreeForProcHead(Result.Node); + // a proc node contains has as FirstChild a proc-head node + // and a proc-head node has as childs the parameterlist and the result + Result.Node:=Result.Node.FirstChild.FirstChild; + if Result.Node.Desc=ctnParameterList then + Result.Node:=Result.Node.NextBrother; end else break; end else - if (Result.Desc=ctnTypeType) then begin + if (Result.Node.Desc=ctnTypeType) then begin // a TypeType is for example 'MyInt = type integer;' // the context is not the 'type' keyword, but the identifier after it. - Result:=Result.FirstChild; + Result.Node:=Result.Node.FirstChild; end else break; end; - if (Result=nil) and (fdfExceptionOnNotFound in Params.Flags) then begin - MoveCursorToCleanPos(Params.IdentifierStartPos); + if (Result.Node=nil) and (fdfExceptionOnNotFound in Params.Flags) then begin + MoveCursorToCleanPos(Params.Identifier); RaiseException('base type not found'); end; {$IFDEF CTDEBUG} write('[TFindDeclarationTool.FindBaseTypeOfNode] END Node='); if Node<>nil then write(Node.DescAsString) else write('NIL'); write(' Result='); -if Result<>nil then write(Result.DescAsString) else write('NIL'); +if Result.Node<>nil then write(Result.Node.DescAsString) else write('NIL'); writeln(''); {$ENDIF} end; @@ -1316,10 +1409,45 @@ function TFindDeclarationTool.FindIdentifierInProcContext( ProcContextNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean; { this function is internally used by FindIdentifierInContext } +var + NameAtom: TAtomPosition; +begin + Result:=false; + // if proc is a method, search in class + // -> find class name + MoveCursorToNodeStart(ProcContextNode); + ReadNextAtom; // read keyword + ReadNextAtom; // read name + NameAtom:=CurPos; + ReadNextAtom; + if AtomIsChar('.') then begin + // proc is a method + // -> proceed the search normally ... + end else begin + // proc is not a method + if CompareSrcIdentifiers(NameAtom.StartPos,Params.Identifier) then + begin + // proc identifier found +{$IFDEF CTDEBUG} +writeln('[TFindDeclarationTool.FindIdentifierInProcContext] Proc Identifier found=',GetIdentifier(Params.Identifier)); +{$ENDIF} + Result:=true; + Params.SetResult(Self,ProcContextNode,NameAtom.StartPos); + exit; + end else begin + // proceed the search normally ... + end; + end; +end; + +function TFindDeclarationTool.FindIdentifierInClassOfMethod( + ProcContextNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean; +{ this function is internally used by FindIdentifierInContext +} var ClassNameAtom: TAtomPosition; OldInput: TFindDeclarationInput; - ClassContextNode: TCodeTreeNode; + ClassContext: TFindContext; begin Result:=false; // if proc is a method, search in class @@ -1331,8 +1459,7 @@ begin ReadNextAtom; if AtomIsChar('.') then begin // proc is a method - if CompareSrcIdentifiers(ClassNameAtom.StartPos, - Params.IdentifierStartPos) then + if CompareSrcIdentifiers(ClassNameAtom.StartPos,Params.Identifier) then begin // the class itself is searched // -> proceed the search normally ... @@ -1343,32 +1470,31 @@ begin try Params.Flags:=[fdfIgnoreCurContextNode,fdfSearchInParentNodes] +(fdfGlobals*Params.Flags) - +[fdfExceptionOnNotFound]; + +[fdfExceptionOnNotFound,fdfIgnoreUsedUnits]; Params.ContextNode:=ProcContextNode; - Params.IdentifierStartPos:=ClassNameAtom.StartPos; - Params.IdentifierEndPos:=ClassNameAtom.EndPos; + Params.Identifier:=@Src[ClassNameAtom.StartPos]; {$IFDEF CTDEBUG} -writeln(' searching class of method class="',copy(Src,ClassNameAtom.StartPos,ClassNameAtom.EndPos-ClassNameAtom.StartPos),'"'); +writeln('[TFindDeclarationTool.FindIdentifierInProcContext] Proc="',copy(src,ProcContextNode.StartPos,30),'" searching class of method class="',GetIdentifier(ClassNameAtom.StartPos),'"'); {$ENDIF} FindIdentifierInContext(Params); - ClassContextNode:=FindBaseTypeOfNode(Params,Params.NewNode); - if (ClassContextNode=nil) - or (ClassContextNode.Desc<>ctnClass) then begin + ClassContext:=Params.NewCodeTool.FindBaseTypeOfNode( + Params,Params.NewNode); + if (ClassContext.Node=nil) + or (ClassContext.Node.Desc<>ctnClass) then begin MoveCursorToCleanPos(ClassNameAtom.StartPos); RaiseException('class identifier expected'); end; - // class of method found - BuildSubTreeForClass(ClassContextNode); - // class context found -> search identifier + // class context found + // 2. -> search identifier in class Params.Load(OldInput); Params.Flags:=[fdfSearchInAncestors]+fdfAllClassVisibilities +(fdfGlobals*Params.Flags) -[fdfExceptionOnNotFound]; - Params.ContextNode:=ClassContextNode; + Params.ContextNode:=ClassContext.Node; {$IFDEF CTDEBUG} -writeln(' searching identifier in class of method'); +writeln('[TFindDeclarationTool.FindIdentifierInProcContext] searching identifier in class of method'); {$ENDIF} - Result:=FindIdentifierInContext(Params); + Result:=ClassContext.Tool.FindIdentifierInContext(Params); if Result then exit; finally Params.Load(OldInput); @@ -1376,11 +1502,11 @@ writeln(' searching identifier in class of method'); end; end else begin // proc is not a method - if CompareSrcIdentifiers(Params.IdentifierStartPos,ClassNameAtom.StartPos) - then begin + if CompareSrcIdentifiers(ClassNameAtom.StartPos,Params.Identifier) then + begin // proc identifier found {$IFDEF CTDEBUG} -writeln(' Proc Identifier found=',copy(Src,ClassNameAtom.StartPos,Params.IdentifierEndPos-Params.IdentifierStartPos)); +writeln('[TFindDeclarationTool.FindIdentifierInProcContext] Proc Identifier found=',GetIdentifier(Params.Identifier)); {$ENDIF} Result:=true; Params.SetResult(Self,ProcContextNode,ClassNameAtom.StartPos); @@ -1396,9 +1522,10 @@ function TFindDeclarationTool.FindClassOfMethod(ProcNode: TCodeTreeNode; var ClassNameAtom: TAtomPosition; OldInput: TFindDeclarationInput; + ClassContext: TFindContext; begin {$IFDEF CTDEBUG} -writeln('[TFindDeclarationTool.FindClassOfMethod] A'); +writeln('[TFindDeclarationTool.FindClassOfMethod] A '); {$ENDIF} Result:=false; MoveCursorToNodeStart(ProcNode); @@ -1412,26 +1539,28 @@ writeln('[TFindDeclarationTool.FindClassOfMethod] A'); Params.Save(OldInput); try Params.Flags:=[fdfIgnoreCurContextNode,fdfSearchInParentNodes] - +(fdfGlobals*Params.Flags) - -[fdfExceptionOnNotFound]; + +(fdfGlobals*Params.Flags); Params.ContextNode:=ProcNode; - Params.IdentifierStartPos:=ClassNameAtom.StartPos; - Params.IdentifierEndPos:=ClassNameAtom.EndPos; + Params.Identifier:=@Src[ClassNameAtom.StartPos]; {$IFDEF CTDEBUG} -writeln(' searching class of method class="',copy(Src,ClassNameAtom.StartPos,ClassNameAtom.EndPos-ClassNameAtom.StartPos),'"'); +writeln('[TFindDeclarationTool.FindClassOfMethod] searching class of method class="',GetIdentifier(ClassNameAtom.StartPos),'"'); {$ENDIF} FindIdentifierInContext(Params); if FindClassContext then begin // parse class and return class node - Params.NewNode:=FindBaseTypeOfNode(Params,Params.NewNode); - if (Params.NewNode=nil) - or (Params.NewNode.Desc<>ctnClass) then begin + ClassContext:=FindBaseTypeOfNode(Params,Params.NewNode); + if (ClassContext.Node=nil) + or (ClassContext.Node.Desc<>ctnClass) then begin MoveCursorToCleanPos(ClassNameAtom.StartPos); RaiseException('class identifier expected'); end; // class of method found + Params.SetResult(ClassContext); // parse class and return class node - BuildSubTreeForClass(Params.NewNode); + + // ToDo: do no JIT parsing for PPU, PPW, DCU files + + ClassContext.Tool.BuildSubTreeForClass(ClassContext.Node); end; Result:=true; finally @@ -1450,17 +1579,15 @@ var OldInput: TFindDeclarationInput; begin Params.Save(OldInput); - try - Exclude(Params.Flags,fdfExceptionOnNotFound); + Exclude(Params.Flags,fdfExceptionOnNotFound); + Result:=FindIdentifierInContext(Params); + if not Result then begin + Params.Load(OldInput); + Include(Params.Flags,fdfSearchForward); Result:=FindIdentifierInContext(Params); - if not Result then begin - Params.Load(OldInput); - Include(Params.Flags,fdfSearchForward); - Result:=FindIdentifierInContext(Params); - IsForward:=true; - end else - IsForward:=false; - finally + IsForward:=true; + end else begin + IsForward:=false; Params.Load(OldInput); end; end; @@ -1470,12 +1597,12 @@ function TFindDeclarationTool.FindIdentifierInWithVarContext( { this function is internally used by FindIdentifierInContext } var - WithVarContextNode: TCodeTreeNode; + WithVarContext: TFindContext; OldInput: TFindDeclarationInput; begin {$IFDEF CTDEBUG} writeln('[TFindDeclarationTool.FindIdentifierInWithVarContext] ', -copy(Src,Params.IdentifierStartPos,Params.IdentifierEndPos-Params.IdentifierStartPos) +GetIdentifier(Params.Identifier) ); {$ENDIF} Result:=false; @@ -1492,26 +1619,23 @@ copy(Src,Params.IdentifierStartPos,Params.IdentifierEndPos-Params.IdentifierStar MoveCursorToCleanPos(WithVarNode.EndPos); end; Params.Save(OldInput); - try - Params.ContextNode:=WithVarNode; - Include(Params.Flags,fdfExceptionOnNotFound); - WithVarContextNode:=FindContextNodeAtCursor(Params); - if (WithVarContextNode=nil) or (WithVarContextNode=OldInput.ContextNode) - or (not (WithVarContextNode.Desc in [ctnClass,ctnRecordType])) then begin - MoveCursorToCleanPos(WithVarNode.StartPos); - RaiseException('expression type must be class or record type'); - end; - // search identifier in with context - Params.Load(OldInput); - Exclude(Params.Flags,fdfExceptionOnNotFound); - Params.ContextNode:=WithVarContextNode; - if FindIdentifierInContext(Params) then begin - // identifier found in with context - Result:=true; - end; - finally - Params.Load(OldInput); + Params.ContextNode:=WithVarNode; + Include(Params.Flags,fdfExceptionOnNotFound); + WithVarContext:=FindContextNodeAtCursor(Params); + if (WithVarContext.Node=nil) or (WithVarContext.Node=OldInput.ContextNode) + or (not (WithVarContext.Node.Desc in [ctnClass,ctnRecordType])) then begin + MoveCursorToCleanPos(WithVarNode.StartPos); + RaiseException('expression type must be class or record type'); end; + // search identifier in with context + Params.Load(OldInput); + Exclude(Params.Flags,fdfExceptionOnNotFound); + Params.ContextNode:=WithVarContext.Node; + if WithVarContext.Tool.FindIdentifierInContext(Params) then begin + // identifier found in with context + Result:=true; + end else + Params.Load(OldInput); end; function TFindDeclarationTool.FindIdentifierInAncestors( @@ -1520,7 +1644,9 @@ function TFindDeclarationTool.FindIdentifierInAncestors( } var AncestorAtom: TAtomPosition; OldInput: TFindDeclarationInput; - AncestorContextNode, AncestorNode: TCodeTreeNode; + AncestorNode, ClassIdentNode: TCodeTreeNode; + SearchTObject: boolean; + AncestorContext: TFindContext; begin if (ClassNode=nil) or (ClassNode.Desc<>ctnClass) then RaiseException('[TFindDeclarationTool.FindIdentifierInAncestors] ' @@ -1529,21 +1655,31 @@ begin if not (fdfSearchInAncestors in Params.Flags) then exit; // search the ancestor name MoveCursorToNodeStart(ClassNode); - ReadNextAtom; + ReadNextAtom; // read keyword 'class', 'object', 'interface', 'dispinterface' if UpAtomIs('PACKED') then ReadNextAtom; ReadNextAtom; if not AtomIsChar('(') then begin - - // ToDo: search the default class ancestor 'TObject' - exit; - + // no ancestor class specified + // check class name + ClassIdentNode:=ClassNode.Parent; + if (ClassIdentNode=nil) or (ClassIdentNode.Desc<>ctnTypeDefinition) then + begin + MoveCursorToNodeStart(ClassNode); + RaiseException('class without name'); + end; + // if this class is not TObject, TObject is class ancestor + SearchTObject:=not CompareSrcIdentifier(ClassIdentNode.StartPos,'TObject'); + if not SearchTObject then exit; + end else begin + ReadNextAtom; + if not AtomIsIdentifier(false) then exit; + // ancestor name found + AncestorAtom:=CurPos; + SearchTObject:=false; end; - ReadNextAtom; - if not AtomIsIdentifier(false) then exit; - // ancestor name found - AncestorAtom:=CurPos; {$IFDEF CTDEBUG} writeln('[TFindDeclarationTool.FindIdentifierInAncestors] ', +' Ident=',GetIdentifier(Params.Identifier), ' search ancestor class = ',GetAtom); {$ENDIF} // search ancestor class context @@ -1553,16 +1689,27 @@ writeln('[TFindDeclarationTool.FindIdentifierInAncestors] ', Params.Flags:=[fdfSearchInParentNodes,fdfIgnoreCurContextNode, fdfExceptionOnNotFound] +fdfGlobals*Params.Flags; - Params.IdentifierStartPos:=AncestorAtom.StartPos; - Params.IdentifierEndPos:=AncestorAtom.EndPos; + if not SearchTObject then + Params.Identifier:=@Src[AncestorAtom.StartPos] + else begin + Params.Identifier:='TObject'; + Exclude(Params.Flags,fdfExceptionOnNotFound); + end; Params.ContextNode:=ClassNode; - FindIdentifierInContext(Params); + if not FindIdentifierInContext(Params) then begin + MoveCursorToNodeStart(ClassNode); +//writeln(' AQ*** ',TCodeBuffer(Scanner.MainCode).Filename,' ',CurPos.StartPos); + RaiseException('default class ancestor TObject not found'); + end; AncestorNode:=Params.NewNode; - AncestorContextNode:=FindBaseTypeOfNode(Params,AncestorNode); + AncestorContext:=Params.NewCodeTool.FindBaseTypeOfNode(Params,AncestorNode); Params.Load(OldInput); Exclude(Params.Flags,fdfExceptionOnNotFound); - Params.ContextNode:=AncestorContextNode; - Result:=FindIdentifierInContext(Params); + Params.ContextNode:=AncestorContext.Node; + if (AncestorContext.Tool<>Self) + and (not (fdfIgnoreClassVisibility in Params.Flags)) then + Params.Flags:=Params.Flags-[fdfClassPrivate]; + Result:=AncestorContext.Tool.FindIdentifierInContext(Params); finally Params.Load(OldInput); end; @@ -1581,17 +1728,335 @@ end; {$ENDIF} function TFindDeclarationTool.FindExpressionResultType( - Params: TFindDeclarationParams; StartPos, EndPos: integer): TCodeTreeNode; + Params: TFindDeclarationParams; StartPos, EndPos: integer): TFindContext; begin // ToDo: operators // ToDo: operator overloading + // ToDo: internal types. e.g. String[] is of type char + + // ToDo: constant types: e.g. 1 is constnumber, #1 is constchar, + // '1' is conststring, 1.0 is constreal + // ToDo: set types: [], A * B // This is a quick hack: Just return the type of the last variable. MoveCursorToCleanPos(EndPos); Result:=FindContextNodeAtCursor(Params); end; +function TFindDeclarationTool.FindIdentifierInUsesSection( + UsesNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean; +{ this function is internally used by FindIdentifierInContext + + search backwards through the uses section + compare first the unit name, then load the unit and search there + +} +var InAtom, UnitNameAtom: TAtomPosition; + NewCodeTool: TFindDeclarationTool; + OldInput: TFindDeclarationInput; +begin + Result:=false; + if (UsesNode=nil) or (UsesNode.Desc<>ctnUsesSection) then + RaiseException('[TFindDeclarationTool.FindIdentifierInUsesSection] ' + +'internal error: invalid UsesNode'); + // search backwards through the uses section + MoveCursorToCleanPos(UsesNode.EndPos); + ReadPriorAtom; // read ';' + if not AtomIsChar(';') then + RaiseException('; expected, but '+GetAtom+' found'); + repeat + ReadPriorAtom; // read unitname + if AtomIsStringConstant then begin + InAtom:=CurPos; + ReadPriorAtom; // read 'in' + if not UpAtomIs('IN') then + RaiseException('keyword "in" expected, but '+GetAtom+' found'); + ReadPriorAtom; // read unitname + end else + InAtom.StartPos:=-1; + AtomIsIdentifier(true); + UnitNameAtom:=CurPos; + if (fdfIgnoreUsedUnits in Params.Flags) then begin + if CompareSrcIdentifiers(UnitNameAtom.StartPos,Params.Identifier) then + begin + // the searched identifier was a uses unitname, but since the unit should + // not be opened, point to identifier in the uses section + Result:=true; + Params.SetResult(Self,UsesNode,UnitNameAtom.StartPos); + exit; + end else begin + // identifier not found + end; + end else begin + // open the unit and search the identifier in the interface + NewCodeTool:=FindCodeToolForUsedUnit(UnitNameAtom,InAtom,false); + if NewCodeTool=nil then begin + MoveCursorToCleanPos(UnitNameAtom.StartPos); + RaiseException('unit not found: '+copy(Src,UnitNameAtom.StartPos, + UnitNameAtom.EndPos-UnitNameAtom.StartPos)); + end else if NewCodeTool=Self then begin + MoveCursorToCleanPos(UnitNameAtom.StartPos); + RaiseException('illegal circle using unit: '+copy(Src, + UnitNameAtom.StartPos,UnitNameAtom.EndPos-UnitNameAtom.StartPos)); + end; + // search the identifier in the interface of the used unit + Params.Save(OldInput); + Params.Flags:=[fdfIgnoreUsedUnits]+(fdfGlobals*Params.Flags) + -[fdfExceptionOnNotFound]; + Result:=NewCodeTool.FindIdentifierInInterface(Self,Params); + if Result then exit; + Params.Load(OldInput); + // restore the cursor + MoveCursorToCleanPos(UnitNameAtom.StartPos); + end; + ReadPriorAtom; // read keyword 'uses' or comma + until not AtomIsChar(','); +end; + +function TFindDeclarationTool.FindCodeToolForUsedUnit(UnitNameAtom, + UnitInFileAtom: TAtomPosition; + ExceptionOnNotFound: boolean): TFindDeclarationTool; +var AnUnitName, AnUnitInFilename: string; + NewCode: TCodeBuffer; +begin + Result:=nil; + if (UnitNameAtom.StartPos<1) or (UnitNameAtom.EndPos<=UnitNameAtom.StartPos) + or (UnitNameAtom.EndPos>SrcLen+1) then + RaiseException('[TFindDeclarationTool.FindCodeToolForUsedUnit] ' + +'internal error: invalid UnitNameAtom'); + AnUnitName:=copy(Src,UnitNameAtom.StartPos, + UnitNameAtom.EndPos-UnitNameAtom.StartPos); + if UnitInFileAtom.StartPos>=1 then begin + if (UnitInFileAtom.StartPos<1) + or (UnitInFileAtom.EndPos<=UnitInFileAtom.StartPos) + or (UnitInFileAtom.EndPos>SrcLen+1) then + RaiseException('[TFindDeclarationTool.FindCodeToolForUsedUnit] ' + +'internal error: invalid UnitInFileAtom'); + AnUnitInFilename:=copy(Src,UnitInFileAtom.StartPos, + UnitInFileAtom.EndPos-UnitInFileAtom.StartPos); + end else + AnUnitInFilename:=''; + NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename); + if (NewCode=nil) then begin + // no source found + if ExceptionOnNotFound then + RaiseException('unit '+AnUnitName+' not found'); + end else begin + // source found -> get codetool for it +{$IFDEF CTDEBUG} +writeln('[TFindDeclarationTool.FindCodeToolForUsedUnit] ', +' This source is=',TCodeBuffer(Scanner.MainCode).Filename, +' NewCode=',NewCode.Filename); +{$ENDIF} + if Assigned(FOnGetCodeToolForBuffer) then + Result:=FOnGetCodeToolForBuffer(Self,NewCode) + else if NewCode=TCodeBuffer(Scanner.MainCode) then + Result:=Self; + end; +end; + +function TFindDeclarationTool.FindIdentifierInInterface( + AskingTool: TFindDeclarationTool; Params: TFindDeclarationParams): boolean; +var InterfaceNode: TCodeTreeNode; + SrcIsUsable: boolean; + OldInput: TFindDeclarationInput; +begin + Result:=false; + // build code tree +{$IFDEF CTDEBUG} +writeln(DebugPrefix,'TFindDeclarationTool.FindIdentifierInInterface', +' Ident=',GetIdentifier(Params.Identifier), +' IgnoreUsedUnits=',fdfIgnoreUsedUnits in Params.Flags, +' Self=',TCodeBuffer(Scanner.MainCode).Filename +); +{$ENDIF} + + // ToDo: build codetree for ppu, ppw, dcu files + + // build tree for pascal source + BuildTree(true); + + // check source name + MoveCursorToNodeStart(Tree.Root); + ReadNextAtom; // read keyword for source type, e.g. 'unit' + SrcIsUsable:=UpAtomIs('UNIT'); + if not SrcIsUsable then + RaiseException('source is not unit'); + ReadNextAtom; // read source name + if CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier) then begin + // identifier is source name + Params.SetResult(Self,Tree.Root,CurPos.StartPos); + Result:=true; + exit; + end; + + // search identifier in interface + InterfaceNode:=FindInterfaceNode; + if InterfaceNode=nil then + RaiseException('interface section not found'); + Params.Save(OldInput); + try + Params.Flags:=(fdfGlobals*Params.Flags) + -[fdfExceptionOnNotFound,fdfSearchInParentNodes]; + Params.ContextNode:=InterfaceNode; + Result:=FindIdentifierInContext(Params); + finally + Params.Load(OldInput); + end; +end; + +function TFindDeclarationTool.CompareNodeIdentifier(Node: TCodeTreeNode; + Params: TFindDeclarationParams): boolean; +begin + Result:=false; + if Node=nil then exit; + if Node.Desc in AllSourceTypes then begin + MoveCursorToNodeStart(Node); + ReadNextAtom; + ReadNextAtom; + Result:=CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier); + end else if (Node.Desc in AllIdentifierDefinitions) + or (Node.Desc=ctnIdentifier) then begin + Result:=CompareSrcIdentifiers(Node.StartPos,Params.Identifier); + end; +end; + +function TFindDeclarationTool.GetInterfaceNode: TCodeTreeNode; +begin + Result:=Tree.Root; + if Result=nil then begin + CurPos.StartPos:=-1; + RaiseException('[TFindDeclarationTool.GetInterfaceNode] no code tree found'); + end; + if not (Tree.Root.Desc in AllUsableSoureTypes) then begin + CurPos.StartPos:=-1; + RaiseException('used unit is not an pascal unit'); + end; + Result:=FindInterfaceNode; + if Result=nil then begin + CurPos.StartPos:=-1; + RaiseException('no interface section found'); + end; +end; + +function TFindDeclarationTool.FindIdentifierInUsedUnit( + const AnUnitName: string; Params: TFindDeclarationParams): boolean; +{ this function is internally used by FindIdentifierInUsesSection + for hidden used units, like the system unit or the objpas unit +} +var + NewCode: TCodeBuffer; + NewCodeTool: TFindDeclarationTool; + OldInput: TFindDeclarationInput; +begin + Result:=false; + // open the unit and search the identifier in the interface + NewCode:=FindUnitSource(AnUnitName,''); + if (NewCode=nil) then begin + // no source found + CurPos.StartPos:=-1; + RaiseException('unit '+AnUnitName+' not found'); + end else begin + // source found -> get codetool for it +{$IFDEF CTDEBUG} +writeln('[TFindDeclarationTool.FindIdentifierInUsedUnit] ', +' This source is=',TCodeBuffer(Scanner.MainCode).Filename, +' NewCode=',NewCode.Filename,' IgnoreUsedUnits=',fdfIgnoreUsedUnits in Params.Flags); +{$ENDIF} + if Assigned(FOnGetCodeToolForBuffer) then begin + NewCodeTool:=FOnGetCodeToolForBuffer(Self,NewCode); + if NewCodeTool=nil then begin + CurPos.StartPos:=-1; + RaiseException('unit '+AnUnitName+' not found'); + end; + end else if NewCode=TCodeBuffer(Scanner.MainCode) then begin + NewCodeTool:=Self; + CurPos.StartPos:=-1; + RaiseException('illegal circle using unit: '+AnUnitName); + end; + // search the identifier in the interface of the used unit + Params.Save(OldInput); + Params.Flags:=[fdfIgnoreUsedUnits]+(fdfGlobals*Params.Flags) + -[fdfExceptionOnNotFound]; + Result:=NewCodeTool.FindIdentifierInInterface(Self,Params); + if Result then exit; + Params.Load(OldInput); + end; +end; + +function TFindDeclarationTool.FindIdentifierInHiddenUsedUnits( + Params: TFindDeclarationParams): boolean; +const + sutSystem = 1; + sutObjPas = 2; + sutLineInfo = 3; + sutHeapTrc = 4; + sutNone = 5; +var + OldInput: TFindDeclarationInput; + SystemUnitName: string; + SpecialUnitType: integer; +begin + Result:=false; +{$IFDEF CTDEBUG} +writeln('[TFindDeclarationTool.FindIdentifierInHiddenUsedUnits] ', +GetIdentifier(Params.Identifier),' IgnoreUsedUnits=',fdfIgnoreUsedUnits in Params.Flags); +{$ENDIF} + if (Tree.Root<>nil) and (not (fdfIgnoreUsedUnits in Params.Flags)) then begin + // check, if this is a special unit + MoveCursorToNodeStart(Tree.Root); + ReadNextAtom; + ReadNextAtom; + if Scanner.InitialValues.IsDefined('LINUX') then + SystemUnitName:='SYSLINUX' + else + // ToDo: other OS than linux + SystemUnitName:='SYSTEM'; + if UpAtomIs(SystemUnitName) then + SpecialUnitType:=sutSystem + else if UpAtomIs('OBJPAS') then + SpecialUnitType:=sutObjPas + else if UpAtomIs('LINEINFO') then + SpecialUnitType:=sutLineInfo + else if UpAtomIs('HEAPTRC') then + SpecialUnitType:=sutHeapTrc + else + SpecialUnitType:=sutNone; + // try hidden units + if (SpecialUnitType>sutHeapTrc) + and Scanner.InitialValues.IsDefined(ExternalMacroStart+'UseHeapTrcUnit') + then begin + // try hidden used unit 'heaptrc' + Result:=FindIdentifierInUsedUnit('HeapTrc',Params); + if Result then exit; + end; + if (SpecialUnitType>sutLineInfo) + and Scanner.InitialValues.IsDefined(ExternalMacroStart+'UseLineInfo') + then begin + // try hidden used unit 'lineinfo' + Result:=FindIdentifierInUsedUnit('LineInfo',Params); + if Result then exit; + end; + if (SpecialUnitType>sutObjPas) + and (Scanner.CompilerMode in [cmDELPHI,cmOBJFPC]) then begin + // try hidden used unit 'objpas' + Result:=FindIdentifierInUsedUnit('ObjPas',Params); + if Result then exit; + end; + // try hidden used unit 'system' + if (SpecialUnitType>sutSystem) + and CompareSrcIdentifiers(Params.Identifier,PChar(SystemUnitName)) then begin + // the system unit name itself is searched -> rename searched identifier + Params.Save(OldInput); + Params.Identifier:=PChar(SystemUnitName); + Result:=FindIdentifierInUsedUnit(SystemUnitName,Params); + Params.Load(OldInput); + end else + Result:=FindIdentifierInUsedUnit(SystemUnitName,Params); + if Result then exit; + end; +end; { TFindDeclarationParams } @@ -1604,26 +2069,21 @@ end; procedure TFindDeclarationParams.Clear; begin - Flags:=[]; - IdentifierStartPos:=-1; - IdentifierEndPos:=-1; - ContextNode:=nil; + ClearInput; ClearResult; end; procedure TFindDeclarationParams.Load(var Input: TFindDeclarationInput); begin Flags:=Input.Flags; - IdentifierStartPos:=Input.IdentifierStartPos; - IdentifierEndPos:=Input.IdentifierEndPos; + Identifier:=Input.Identifier; ContextNode:=Input.ContextNode; end; procedure TFindDeclarationParams.Save(var Input: TFindDeclarationInput); begin Input.Flags:=Flags; - Input.IdentifierStartPos:=IdentifierStartPos; - Input.IdentifierEndPos:=IdentifierEndPos; + Input.Identifier:=Identifier; Input.ContextNode:=ContextNode; end; @@ -1638,7 +2098,7 @@ begin NewCodeTool:=nil; end; -procedure TFindDeclarationParams.SetResult(ANewCodeTool: TCustomCodeTool; +procedure TFindDeclarationParams.SetResult(ANewCodeTool: TFindDeclarationTool; ANewNode: TCodeTreeNode); begin ClearResult; @@ -1646,7 +2106,7 @@ begin NewNode:=ANewNode; end; -procedure TFindDeclarationParams.SetResult(ANewCodeTool: TCustomCodeTool; +procedure TFindDeclarationParams.SetResult(ANewCodeTool: TFindDeclarationTool; ANewNode: TCodeTreeNode; ANewCleanPos: integer); begin ClearResult; @@ -1668,6 +2128,21 @@ begin end; end; +procedure TFindDeclarationParams.ClearInput; +begin + Flags:=[]; + Identifier:=nil; + ContextNode:=nil; +end; + +procedure TFindDeclarationParams.SetResult(AFindContext: TFindContext); +begin + ClearResult; + NewCodeTool:=AFindContext.Tool; + NewNode:=AFindContext.Node; +end; + + end. diff --git a/components/codetools/keywordfunclists.pas b/components/codetools/keywordfunclists.pas index 31092db433..4f48f06d79 100644 --- a/components/codetools/keywordfunclists.pas +++ b/components/codetools/keywordfunclists.pas @@ -73,12 +73,16 @@ var IsKeyWordMethodSpecifier, IsKeyWordProcedureSpecifier, IsKeyWordProcedureTypeSpecifier, + IsKeyWordProcedureBracketSpecifier, IsKeyWordSection, IsKeyWordInConstAllowed, WordIsKeyWord, IsKeyWordBuiltInFunc, WordIsTermOperator, - WordIsPropertySpecifier: TKeyWordFunctionList; + WordIsPropertySpecifier, + WordIsBlockKeyWord, + WordIsLogicalBlockStart, + UnexpectedKeyWordInBeginBlock: TKeyWordFunctionList; UpChars: array[char] of char; function UpperCaseStr(const s: string): string; @@ -377,6 +381,8 @@ end; //----------------------------------------------------------------------------- +var KeyWordLists: TList; + procedure InternalInit; var c: char; begin @@ -388,7 +394,9 @@ begin end; UpChars[c]:=upcase(c); end; + KeyWordLists:=TList.Create; IsKeyWordMethodSpecifier:=TKeyWordFunctionList.Create; + KeyWordLists.Add(IsKeyWordMethodSpecifier); with IsKeyWordMethodSpecifier do begin Add('STDCALL' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('REGISTER',{$ifdef FPC}@{$endif}AllwaysTrue); @@ -403,6 +411,7 @@ begin Add('MESSAGE' ,{$ifdef FPC}@{$endif}AllwaysTrue); end; IsKeyWordProcedureSpecifier:=TKeyWordFunctionList.Create; + KeyWordLists.Add(IsKeyWordProcedureSpecifier); with IsKeyWordProcedureSpecifier do begin Add('STDCALL' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('REGISTER',{$ifdef FPC}@{$endif}AllwaysTrue); @@ -414,8 +423,21 @@ begin Add('FORWARD' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('PASCAL' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('ASSEMBLER',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('SAVEREGISTERS',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('[' ,{$ifdef FPC}@{$endif}AllwaysTrue); + end; + IsKeyWordProcedureBracketSpecifier:=TKeyWordFunctionList.Create; + KeyWordLists.Add(IsKeyWordProcedureBracketSpecifier); + with IsKeyWordProcedureBracketSpecifier do begin + Add('ALIAS' ,{$ifdef FPC}@{$endif}AllwaysTrue); + Add('PUBLIC' ,{$ifdef FPC}@{$endif}AllwaysTrue); + Add('INTERNPROC' ,{$ifdef FPC}@{$endif}AllwaysTrue); + Add('INTERNCONST' ,{$ifdef FPC}@{$endif}AllwaysTrue); + Add('SAVEREGISTERS',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('IOCHECK' ,{$ifdef FPC}@{$endif}AllwaysTrue); end; IsKeyWordProcedureTypeSpecifier:=TKeyWordFunctionList.Create; + KeyWordLists.Add(IsKeyWordProcedureTypeSpecifier); with IsKeyWordProcedureTypeSpecifier do begin Add('STDCALL' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('REGISTER',{$ifdef FPC}@{$endif}AllwaysTrue); @@ -424,6 +446,7 @@ begin Add('PASCAL' ,{$ifdef FPC}@{$endif}AllwaysTrue); end; IsKeyWordSection:=TKeyWordFunctionList.Create; + KeyWordLists.Add(IsKeyWordSection); with IsKeyWordSection do begin Add('PROGRAM',{$ifdef FPC}@{$endif}AllwaysTrue); Add('UNIT',{$ifdef FPC}@{$endif}AllwaysTrue); @@ -435,7 +458,9 @@ begin Add('FINALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue); end; IsKeyWordInConstAllowed:=TKeyWordFunctionList.Create; + KeyWordLists.Add(IsKeyWordInConstAllowed); with IsKeyWordInConstAllowed do begin + Add('NOT',{$ifdef FPC}@{$endif}AllwaysTrue); Add('OR',{$ifdef FPC}@{$endif}AllwaysTrue); Add('AND',{$ifdef FPC}@{$endif}AllwaysTrue); Add('XOR',{$ifdef FPC}@{$endif}AllwaysTrue); @@ -449,6 +474,7 @@ begin Add('ORD',{$ifdef FPC}@{$endif}AllwaysTrue); end; WordIsKeyWord:=TKeyWordFunctionList.Create; + KeyWordLists.Add(WordIsKeyWord); with WordIsKeyWord do begin Add('ABSOLUTE',{$ifdef FPC}@{$endif}AllwaysTrue); Add('AS',{$ifdef FPC}@{$endif}AllwaysTrue); @@ -470,7 +496,6 @@ begin Add('END',{$ifdef FPC}@{$endif}AllwaysTrue); Add('EXCEPT',{$ifdef FPC}@{$endif}AllwaysTrue); Add('EXPORTS',{$ifdef FPC}@{$endif}AllwaysTrue); - Add('FILE',{$ifdef FPC}@{$endif}AllwaysTrue); Add('FINALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue); Add('FINALLY',{$ifdef FPC}@{$endif}AllwaysTrue); Add('FOR',{$ifdef FPC}@{$endif}AllwaysTrue); @@ -517,12 +542,14 @@ begin Add('XOR',{$ifdef FPC}@{$endif}AllwaysTrue); end; IsKeyWordBuiltInFunc:=TKeyWordFunctionList.Create; + KeyWordLists.Add(IsKeyWordBuiltInFunc); with IsKeyWordBuiltInFunc do begin Add('LOW',{$ifdef FPC}@{$endif}AllwaysTrue); Add('HIGH',{$ifdef FPC}@{$endif}AllwaysTrue); Add('ORD',{$ifdef FPC}@{$endif}AllwaysTrue); end; WordIsTermOperator:=TKeyWordFunctionList.Create; + KeyWordLists.Add(WordIsTermOperator); with WordIsTermOperator do begin Add('+',{$ifdef FPC}@{$endif}AllwaysTrue); Add('-',{$ifdef FPC}@{$endif}AllwaysTrue); @@ -532,11 +559,14 @@ begin Add('OR',{$ifdef FPC}@{$endif}AllwaysTrue); Add('AND',{$ifdef FPC}@{$endif}AllwaysTrue); Add('XOR',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('NOT',{$ifdef FPC}@{$endif}AllwaysTrue); Add('SHL',{$ifdef FPC}@{$endif}AllwaysTrue); Add('SHR',{$ifdef FPC}@{$endif}AllwaysTrue); Add('AS',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('IN',{$ifdef FPC}@{$endif}AllwaysTrue); end; WordIsPropertySpecifier:=TKeyWordFunctionList.Create; + KeyWordLists.Add(WordIsPropertySpecifier); with WordIsPropertySpecifier do begin Add('INDEX',{$ifdef FPC}@{$endif}AllwaysTrue); Add('READ',{$ifdef FPC}@{$endif}AllwaysTrue); @@ -546,30 +576,95 @@ begin Add('DEFAULT',{$ifdef FPC}@{$endif}AllwaysTrue); Add('NODEFAULT',{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsBlockKeyWord:=TKeyWordFunctionList.Create; + KeyWordLists.Add(WordIsBlockKeyWord); + with WordIsBlockKeyWord do begin + Add('BEGIN',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('ASM',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('TRY',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('CASE',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('REPEAT',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('CLASS',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('OBJECT',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('INTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('DISPINTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('END',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('UNTIL',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('FINALLY',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('EXCEPT',{$ifdef FPC}@{$endif}AllwaysTrue); + end; + UnexpectedKeyWordInBeginBlock:=TKeyWordFunctionList.Create; + KeyWordLists.Add(UnexpectedKeyWordInBeginBlock); + with UnexpectedKeyWordInBeginBlock do begin + Add('CLASS',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('CONST',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('CONSTRUCTOR',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('DESTRUCTOR',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('FINALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('INITIALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('INTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('IMPLEMENTATION',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('LIBRARY',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('PACKAGE',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('PROGRAM',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('RESOURCESTRING',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('PROCEDURE',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('SET',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('TYPE',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('UNIT',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('VAR',{$ifdef FPC}@{$endif}AllwaysTrue); + end; + WordIsLogicalBlockStart:=TKeyWordFunctionList.Create; + KeyWordLists.Add(WordIsLogicalBlockStart); + with WordIsLogicalBlockStart do begin + Add('BEGIN',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('CASE',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('ASM',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('TRY',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('REPEAT',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('[',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('{',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('(',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('PROCEDURE',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('FUNCTION',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('CONSTRUCTOR',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('DESTRUCTOR',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('CLASS',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('OBJECT',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('INTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('DISPINTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('PRIVATE',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('PUBLISHED',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('PUBLIC',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('PROTECTED',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('PROGRAM',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('UNIT',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('LIBRARY',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('PACKAGE',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('IMPLEMENTATION',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('INITIALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue); + Add('FINALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue); + end; end; +procedure InternalFinal; +var i: integer; +begin + for i:=0 to KeyWordLists.Count-1 do + TKeyWordFunctionList(KeyWordLists[i]).Free; + KeyWordLists.Free; + KeyWordLists:=nil; +end; + + initialization InternalInit; finalization - IsKeyWordMethodSpecifier.Free; - IsKeyWordMethodSpecifier:=nil; - IsKeyWordProcedureSpecifier.Free; - IsKeyWordProcedureSpecifier:=nil; - IsKeyWordProcedureTypeSpecifier.Free; - IsKeyWordProcedureTypeSpecifier:=nil; - IsKeyWordSection.Free; - IsKeyWordSection:=nil; - IsKeyWordInConstAllowed.Free; - IsKeyWordInConstAllowed:=nil; - WordIsKeyWord.Free; - WordIsKeyWord:=nil; - IsKeyWordBuiltInFunc.Free; - IsKeyWordBuiltInFunc:=nil; - WordIsTermOperator.Free; - WordIsTermOperator:=nil; - WordIsPropertySpecifier.Free; - WordIsPropertySpecifier:=nil; - + InternalFinal; + end. diff --git a/components/codetools/linkscanner.pas b/components/codetools/linkscanner.pas index 7605bf66d6..fb165d9c69 100644 --- a/components/codetools/linkscanner.pas +++ b/components/codetools/linkscanner.pas @@ -141,6 +141,7 @@ type FIncludeStack: TList; // list of TSourceLink FSkippingTillEndif: boolean; FSkipIfLevel: integer; + FCompilerMode: TCompilerMode; procedure SkipTillEndifElse; function SkipIfDirective: boolean; function IfdefDirective: boolean; @@ -210,6 +211,7 @@ type read FInitValues write FInitValues; property MainCode: pointer read FMainCode write SetMainCode; property NestedComments: boolean read FNestedComments; + property CompilerMode: TCompilerMode read FCompilerMode write FCompilerMode; property ScanTillInterfaceEnd: boolean read FScanTillInterfaceEnd write SetScanTillInterfaceEnd; procedure Scan(TillInterfaceEnd, CheckFilesOnDisk: boolean); @@ -588,6 +590,7 @@ writeln('TLinkScanner.Scan C ',SrcLen); EndOfSourceFound:=false; CommentStyle:=CommentNone; CommentLevel:=0; + CompilerMode:=cmFPC; IfLevel:=0; FSkippingTillEndif:=false; if Assigned(FOnGetInitValues) then @@ -991,12 +994,17 @@ begin // undefine all mode macros for AMode:=Low(TCompilerMode) to High(TCompilerMode) do Values.Undefine('FPC_'+CompilerModeNames[AMode]); + CompilerMode:=cmFPC; // define new mode macro if (ValueStr='DEFAULT') then begin + + // ToDo: set mode to cmdline mode + end else begin ModeValid:=false; for AMode:=Low(TCompilerMode) to High(TCompilerMode) do if CompilerModeNames[AMode]=ValueStr then begin + CompilerMode:=AMode; Values.Variables['FPC_'+CompilerModeNames[AMode]]:='1'; ModeValid:=true; break; @@ -1320,7 +1328,7 @@ begin Expr:=UpperCaseStr(copy(Src,SrcPos,CommentInnerEndPos-SrcPos)); ResultStr:=Values.Eval(Expr); if Values.ErrorPosition>=0 then - raise ELinkScannerError.Create('syntax error in directive expression ') + raise ELinkScannerError.Create('in directive expression ') else if ResultStr='0' then SkipTillEndifElse else diff --git a/components/codetools/methodjumptool.pas b/components/codetools/methodjumptool.pas index 41f08b8774..5b7f34b8ae 100644 --- a/components/codetools/methodjumptool.pas +++ b/components/codetools/methodjumptool.pas @@ -195,7 +195,7 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint C ',NodeDescriptionAsString(Cursor {$IFDEF CTDEBUG} writeln('TMethodJumpingCodeTool.FindJumpPoint C2 ',NodeDescriptionAsString(ClassNode.Desc)); {$ENDIF} - if ClassNode.SubDesc=ctnsForwardDeclaration then exit; + if (ClassNode.SubDesc and ctnsForwardDeclaration)>0 then exit; // parse class and build CodeTreeNodes for all properties/methods {$IFDEF CTDEBUG} writeln('TMethodJumpingCodeTool.FindJumpPoint D ',CleanCursorPos,', |',copy(Src,CleanCursorPos,8)); @@ -291,7 +291,7 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint N ',DiffTxtPos); writeln('TMethodJumpingCodeTool.FindJumpPoint 2A ',ProcNode<>nil); {$ENDIF} if ProcNode<>nil then begin - if ProcNode.SubDesc=ctnsForwardDeclaration then begin + if (ProcNode.SubDesc and ctnsForwardDeclaration)>0 then begin // forward declaration -> search procedure {$IFDEF CTDEBUG} writeln('TMethodJumpingCodeTool.FindJumpPoint 2B '); @@ -494,7 +494,7 @@ begin //writeln('[TMethodJumpingCodeTool.GatherProcNodes] A ',NodeDescriptionAsString(ANode.Desc)); if ANode.Desc=ctnProcedure then begin if (not ((phpIgnoreForwards in Attr) - and (ANode.SubDesc=ctnsForwardDeclaration))) + and ((ANode.SubDesc and ctnsForwardDeclaration)>0))) and (not ((phpIgnoreProcsWithBody in Attr) and (FindProcBody(ANode)<>nil))) then begin diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index af4420bb53..769732633f 100644 --- a/components/codetools/pascalparsertool.pas +++ b/components/codetools/pascalparsertool.pas @@ -100,7 +100,7 @@ type procedure ExtractNextAtom(AddAtom: boolean; Attr: TProcHeadAttributes); // sections function KeyWordFuncSection: boolean; - function KeyWordFuncEnd: boolean; + function KeyWordFuncEndPoint: boolean; // type/var/const/resourcestring function KeyWordFuncType: boolean; function KeyWordFuncVar: boolean; @@ -117,6 +117,7 @@ type function KeyWordFuncTypeFile: boolean; function KeyWordFuncTypePointer: boolean; function KeyWordFuncTypeRecord: boolean; + function KeyWordFuncTypeRecordCase: boolean; function KeyWordFuncTypeDefault: boolean; // procedures/functions/methods function KeyWordFuncProc: boolean; @@ -144,7 +145,7 @@ type procedure BuildBlockStatementStartKeyWordFuncList; virtual; function UnexpectedKeyWord: boolean; // read functions - function ReadTilProcedureHeadEnd(IsMethod, IsFunction, IsType, + function ReadTilProcedureHeadEnd(IsMethod, IsFunction, IsType, IsOperator, CreateNodes: boolean; var HasForwardModifier: boolean): boolean; function ReadConstant(ExceptionOnError, Extract: boolean; @@ -216,10 +217,9 @@ type constructor Create; destructor Destroy; override; end; + - - implementation @@ -337,7 +337,8 @@ begin Add('INITIALIZATION',{$ifdef FPC}@{$endif}KeyWordFuncSection); Add('FINALIZATION',{$ifdef FPC}@{$endif}KeyWordFuncSection); - Add('END',{$ifdef FPC}@{$endif}KeyWordFuncEnd); + Add('END',{$ifdef FPC}@{$endif}KeyWordFuncEndPoint); + Add('.',{$ifdef FPC}@{$endif}KeyWordFuncEndPoint); Add('TYPE',{$ifdef FPC}@{$endif}KeyWordFuncType); Add('VAR',{$ifdef FPC}@{$endif}KeyWordFuncVar); @@ -461,12 +462,13 @@ end; function TPascalParserTool.UnexpectedKeyWord: boolean; begin Result:=false; - RaiseException('syntax error: unexpected word "'+GetAtom+'"'); + RaiseException('unexpected word "'+GetAtom+'"'); end; procedure TPascalParserTool.BuildTree(OnlyInterfaceNeeded: boolean); begin -writeln('TPascalParserTool.BuildTree A OnlyInterfaceNeeded=',OnlyInterfaceNeeded); +writeln('TPascalParserTool.BuildTree A OnlyInterfaceNeeded=',OnlyInterfaceNeeded, + TcodeBuffer(Scanner.MainCode).Filename); {$IFDEF MEM_CHECK} CheckHeap('TBasicCodeTool.BuildTree A '+IntToStr(GetMem_Cnt)); {$ENDIF} @@ -490,21 +492,21 @@ writeln('TPascalParserTool.BuildTree B'); CurSection:=ctnLibrary else RaiseException( - 'syntax error: no pascal code found (first token is '+GetAtom+')'); + 'no pascal code found (first token is '+GetAtom+')'); CreateChildNode; CurNode.Desc:=CurSection; ReadNextAtom; // read source name AtomIsIdentifier(true); ReadNextAtom; // read ';' if not AtomIsChar(';') then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); + RaiseException('; expected, but '+GetAtom+' found'); if CurSection=ctnUnit then begin ReadNextAtom; CurNode.EndPos:=CurPos.StartPos; EndChildNode; if not UpAtomIs('INTERFACE') then RaiseException( - 'syntax error: ''interface'' expected, but '+GetAtom+' found'); + '''interface'' expected, but '+GetAtom+' found'); CreateChildNode; CurSection:=ctnInterface; CurNode.Desc:=CurSection; @@ -537,7 +539,8 @@ begin if ClassNode=nil then RaiseException( 'TPascalParserTool.BuildSubTreeForClass: Classnode=nil'); - if ClassNode.FirstChild<>nil then + if (ClassNode.FirstChild<>nil) + or ((ClassNode.SubDesc and ctnsNeedJITParsing)=0) then // class already parsed exit; if ClassNode.Desc<>ctnClass then @@ -604,6 +607,7 @@ begin finally CurKeyWordFuncList:=DefaultKeyWordFuncList; end; + ClassNode.SubDesc:=ClassNode.SubDesc and (not ctnsNeedJITParsing); end; procedure TPascalParserTool.BuildSubTreeForBeginBlock(BeginNode: TCodeTreeNode); @@ -618,7 +622,8 @@ begin RaiseException( 'TPascalParserTool.BuildSubTreeForBeginBlock: BeginNode.Desc=' +BeginNode.DescAsString); - if BeginNode.FirstChild<>nil then + if (BeginNode.FirstChild<>nil) + or ((BeginNode.SubDesc and ctnsNeedJITParsing)=0) then // block already parsed exit; // set CursorPos on 'begin' @@ -640,6 +645,7 @@ begin // ToDo end; until (CurPos.StartPos>=MaxPos); + BeginNode.SubDesc:=ctnNone; end; function TPascalParserTool.GetSourceType: TCodeTreeNodeDesc; @@ -705,45 +711,9 @@ begin ReadNextAtom; end; if not AtomIsChar(':') then - RaiseException('syntax error: : expected, but '+GetAtom+' found'); + RaiseException(': expected, but '+GetAtom+' found'); // read type ReadVariableType; -{ ReadNextAtom; - if (CurPos.StartPos>SrcLen) then - RaiseException('syntax error: variable type definition not found'); - // create type body node - CreateChildNode; - CurNode.Desc:=ctnTypeDefinition; - // parse type body - if AtomIsChar('^') then begin - // parse pointer type - ReadNextAtom; - AtomIsIdentifier(true); - end else if (Src[CurPos.StartPos] in ['(','-','+']) or AtomIsNumber then begin - // parse enum or range type - while (CurPos.StartPos<=SrcLen) do begin - if Src[CurPos.StartPos] in ['(','['] then - ReadTilBracketClose(true); - if AtomIsChar(';') or UpAtomIs('END') then begin - UndoReadNextAtom; - break; - end; - ReadNextAtom; - end; - end else - Result:=ClassVarTypeKeyWordFuncList.DoItUpperCase(UpperSrc, - CurPos.StartPos,CurPos.EndPos-CurPos.StartPos); - ReadNextAtom; - if (UpAtomIs('END')) then - UndoReadNextAtom - else if not AtomIsChar(';') then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); - // end type body - CurNode.EndPos:=CurPos.EndPos; - EndChildNode; - // end variable definition - CurNode.EndPos:=CurPos.EndPos; - EndChildNode;} Result:=true; end; @@ -751,7 +721,7 @@ function TPascalParserTool.KeyWordFuncClassVarTypeClass: boolean; // class and object as type are not allowed, because they would have no name begin RaiseException( - 'syntax error: Anonym '+GetAtom+' definitions are not allowed'); + 'Anonym '+GetAtom+' definitions are not allowed'); Result:=false; end; @@ -762,7 +732,7 @@ begin if UpAtomIs('RECORD') then Result:=KeyWordFuncClassVarTypeRecord else begin - RaiseException('syntax error: ''record'' expected, but '+GetAtom+' found'); + RaiseException(' ''record'' expected, but '+GetAtom+' found'); Result:=true; end; end; @@ -795,7 +765,7 @@ begin else if UpAtomIs('END') then dec(Level); end; if CurPos.StartPos>SrcLen then - RaiseException('syntax error: end for record not found.'); + RaiseException('end for record not found.'); Result:=true; end; @@ -813,7 +783,7 @@ begin ReadNextAtom; end; if not UpAtomIs('OF') then - RaiseException('syntax error: [ expected, but '+GetAtom+' found'); + RaiseException('[ expected, but '+GetAtom+' found'); ReadNextAtom; //writeln('TPascalParserTool.KeyWordFuncClassVarTypeArray ',GetAtom); Result:=ClassVarTypeKeyWordFuncList.DoItUpperCase(UpperSrc, @@ -830,10 +800,10 @@ function TPascalParserTool.KeyWordFuncClassVarTypeSet: boolean; begin ReadNextAtom; if not UpAtomIs('OF') then - RaiseException('syntax error: ''of'' expected, but '+GetAtom+' found'); + RaiseException('''of'' expected, but '+GetAtom+' found'); ReadNextAtom; if CurPos.StartPos>SrcLen then - RaiseException('syntax error: missing enum list'); + RaiseException('missing enum list'); if UpperSrc[CurPos.StartPos] in ['A'..'Z','_'] then // set of identifier else if AtomIsChar('(') then @@ -856,7 +826,7 @@ begin IsFunction:=UpAtomIs('FUNCTION'); ReadNextAtom; HasForwardModifier:=false; - ReadTilProcedureHeadEnd(true,IsFunction,true,false,HasForwardModifier); + ReadTilProcedureHeadEnd(true,IsFunction,true,false,false,HasForwardModifier); Result:=true; end; @@ -864,11 +834,11 @@ function TPascalParserTool.KeyWordFuncClassVarTypeIdent: boolean; // read variable type begin if CurPos.StartPos>SrcLen then - RaiseException('syntax error: missing type identifier'); + RaiseException('missing type identifier'); if UpperSrc[CurPos.StartPos] in ['A'..'Z','_'] then // identifier else - RaiseException('syntax error: missing type identifier'); + RaiseException('missing type identifier'); Result:=true; end; @@ -919,7 +889,7 @@ begin ReadNextAtom; if (not UpAtomIs('PROCEDURE')) and (not UpAtomIs('FUNCTION')) then begin RaiseException( - 'syntax error: procedure or function expected, but '+GetAtom+' found'); + 'procedure or function expected, but '+GetAtom+' found'); end; end; IsFunction:=UpAtomIs('FUNCTION'); @@ -929,13 +899,13 @@ begin if (CurPos.StartPos>SrcLen) or (not (UpperSrc[CurPos.StartPos] in ['A'..'Z','_'])) then - RaiseException('syntax error: method name expected, but '+GetAtom+' found'); + RaiseException('method name expected, but '+GetAtom+' found'); // create node for procedure head CreateChildNode; CurNode.Desc:=ctnProcedureHead; // read rest ReadNextAtom; - ReadTilProcedureHeadEnd(true,IsFunction,false,false,HasForwardModifier); + ReadTilProcedureHeadEnd(true,IsFunction,false,false,false,HasForwardModifier); // close procedure header CurNode.EndPos:=CurPos.EndPos; EndChildNode; @@ -1025,13 +995,13 @@ begin if (CurPos.StartPos>SrcLen) then if ExceptionOnError then RaiseException( - 'syntax error: '+CloseBracket+' expected, but '+GetAtom+' found') + ''+CloseBracket+' expected, but '+GetAtom+' found') else exit; if (Src[CurPos.StartPos] in [')',']']) then break; if (Src[CurPos.StartPos]<>';') then if ExceptionOnError then RaiseException( - 'syntax error: '+CloseBracket+' expected, but '+GetAtom+' found') + ''+CloseBracket+' expected, but '+GetAtom+' found') else exit; if not Extract then ReadNextAtom @@ -1042,7 +1012,7 @@ begin if Src[CurPos.StartPos]<>CloseBracket then if ExceptionOnError then RaiseException( - 'syntax error: '+CloseBracket+' expected, but '+GetAtom+' found') + ''+CloseBracket+' expected, but '+GetAtom+' found') else exit; if (phpCreateNodes in Attr) then begin CurNode.EndPos:=CurPos.EndPos; @@ -1069,7 +1039,7 @@ begin if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr); if not UpAtomIs('OF') then if ExceptionOnError then - RaiseException('syntax error: ''of'' expected, but '+GetAtom+' found') + RaiseException('''of'' expected, but '+GetAtom+' found') else exit; ReadNextAtom; if UpAtomIs('CONST') then begin @@ -1101,14 +1071,14 @@ begin end else begin if ExceptionOnError then RaiseException( - 'syntax error: identifier expected, but '+GetAtom+' found') + 'identifier expected, but '+GetAtom+' found') else exit; end; Result:=true; end; function TPascalParserTool.ReadTilProcedureHeadEnd( - IsMethod, IsFunction, IsType, CreateNodes: boolean; + IsMethod, IsFunction, IsType, IsOperator, CreateNodes: boolean; var HasForwardModifier: boolean): boolean; { parse parameter list, result type, of object, method specifiers @@ -1145,10 +1115,21 @@ begin Include(Attr,phpCreateNodes); ReadParamList(true,false,Attr); end; - if IsFunction then begin + if IsOperator and (not AtomIsChar(':')) then begin + // read operator result identifier + AtomIsIdentifier(true); + if CreateNodes then begin + CreateChildNode; + CurNode.Desc:=ctnVarDefinition; + CurNode.EndPos:=CurPos.EndPos; + EndChildNode; + end; + ReadNextAtom; + end; + if IsFunction or IsOperator then begin // read function result type if not AtomIsChar(':') then - RaiseException('syntax error: : expected, but '+GetAtom+' found'); + RaiseException(': expected, but '+GetAtom+' found'); ReadNextAtom; AtomIsIdentifier(true); if CreateNodes then begin @@ -1163,10 +1144,10 @@ begin // read 'of object' if not IsType then RaiseException( - 'syntax error: expected ;, but '+GetAtom+' found'); + '; expected, but '+GetAtom+' found'); ReadNextAtom; if not UpAtomIs('OBJECT') then - RaiseException('syntax error: "object" expected, but '+GetAtom+' found'); + RaiseException('"object" expected, but '+GetAtom+' found'); ReadNextAtom; end; // read procedures/method specifiers @@ -1175,9 +1156,9 @@ begin exit; end; if not AtomIsChar(';') then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); + RaiseException('; expected, but '+GetAtom+' found'); if (CurPos.StartPos>SrcLen) then - RaiseException('syntax error: semicolon not found'); + RaiseException('semicolon not found'); repeat ReadNextAtom; if IsMethod then @@ -1189,6 +1170,8 @@ begin if IsSpecifier then begin // read specifier if UpAtomIs('MESSAGE') or UpAtomIs('EXTERNAL') then begin + if UpAtomIs('EXTERNAL') then + HasForwardModifier:=true; repeat ReadNextAtom; if UpAtomIs('END') then begin @@ -1196,16 +1179,31 @@ begin exit; end; until (CurPos.Startpos>SrcLen) or AtomIsChar(';'); - end else if AtomIsChar(';') then begin - // read assembler alias [alias: 'alternative name'] - if not ReadNextUpAtomIs('ALIAS') then - RaiseException('alias keyword expected, but '+GetAtom+' found'); - if not ReadNextAtomIsChar(':') then - RaiseException('; expected, but '+GetAtom+' found'); - ReadNextAtom; - if not AtomIsStringConstant then - RaiseException('string constant expected, but '+GetAtom+' found'); - if not ReadNextAtomIsChar(']') then + end else if AtomIsChar('[') then begin + // read assembler alias [public,alias: 'alternative name'] + repeat + ReadNextAtom; + if not AtomIsWord then + RaiseException('keyword expected, but '+GetAtom+' found'); + if not IsKeyWordProcedureBracketSpecifier.DoItUppercase(UpperSrc, + CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) + then + RaiseException('keyword (e.g. alias) expected, but '+GetAtom+' found'); + if UpAtomIs('INTERNPROC') then + HasForwardModifier:=true; + ReadNextAtom; + if AtomIsChar(':') or AtomIsChar(']') then + break; + if not AtomIsChar(',') then + RaiseException(': expected, but '+GetAtom+' found'); + until false; + if AtomIsChar(':') then begin + ReadNextAtom; + if (not AtomIsStringConstant) and (not AtomIsIdentifier(false)) then + RaiseException('string constant expected, but '+GetAtom+' found'); + ReadConstant(true,false,[]); + end; + if not AtomIsChar(']') then RaiseException('] expected, but '+GetAtom+' found'); ReadNextAtom; if UpAtomIs('END') then begin @@ -1222,7 +1220,7 @@ begin end; end; if not AtomIsChar(';') then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); + RaiseException('; expected, but '+GetAtom+' found'); end else begin // current atom does not belong to procedure/method declaration UndoReadNextAtom; @@ -1242,7 +1240,7 @@ begin if AtomIsKeyWord and (not IsKeyWordInConstAllowed.DoItUppercase(UpperSrc, CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)) then begin if ExceptionOnError then - RaiseException('syntax error: unexpected keyword '+GetAtom+' found') + RaiseException('unexpected keyword '+GetAtom+' found') else exit; end; if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr); @@ -1260,11 +1258,11 @@ begin if not ReadConstant(ExceptionOnError,Extract,Attr) then exit; if (c='(') and (not AtomIsChar(')')) then if ExceptionOnError then - RaiseException('syntax error: ( expected, but '+GetAtom+' found') + RaiseException('( expected, but '+GetAtom+' found') else exit; if (c='[') and (not AtomIsChar(']')) then if ExceptionOnError then - RaiseException('syntax error: [ expected, but '+GetAtom+' found') + RaiseException('[ expected, but '+GetAtom+' found') else exit; if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr); end; @@ -1291,12 +1289,12 @@ begin if (c='(') and (not AtomIsChar(')')) then if ExceptionOnError then RaiseException( - 'syntax error: ( expected, but '+GetAtom+' found') + '( expected, but '+GetAtom+' found') else exit; if (c='[') and (not AtomIsChar(']')) then if ExceptionOnError then RaiseException( - 'syntax error: [ expected, but '+GetAtom+' found') + '[ expected, but '+GetAtom+' found') else exit; if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr); if WordIsTermOperator.DoItUpperCase(UpperSrc, @@ -1317,14 +1315,14 @@ begin else if ExceptionOnError then RaiseException( - 'syntax error: constant expected, but '+GetAtom+' found') + 'constant expected, but '+GetAtom+' found') else exit; end; end else // syntax error if ExceptionOnError then RaiseException( - 'syntax error: constant expected, but '+GetAtom+' found') + 'constant expected, but '+GetAtom+' found') else exit; end; Result:=true; @@ -1351,7 +1349,7 @@ begin if not AtomIsStringConstant then if ExceptionOnError then RaiseException( - 'syntax error: string constant expected, but '+GetAtom+' found') + 'string constant expected, but '+GetAtom+' found') else exit; ReadNextAtom; end; @@ -1359,7 +1357,7 @@ begin if not AtomIsChar(',') then if ExceptionOnError then RaiseException( - 'syntax error: ; expected, but '+GetAtom+' found') + '; expected, but '+GetAtom+' found') else exit; until (CurPos.StartPos>SrcLen); CurNode.EndPos:=CurPos.EndPos; @@ -1385,7 +1383,7 @@ begin or AtomIsChar(':') then break; if AtomIs('..') then begin if RangeOpFound then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); + RaiseException('; expected, but '+GetAtom+' found'); RangeOpFound:=true; end else if AtomIsChar('(') or AtomIsChar('[') then ReadTilBracketClose(ExceptionOnError); @@ -1429,11 +1427,11 @@ begin ReadNextAtom; if UpAtomIs('DEFAULT') then begin if not ReadNextAtomIsChar(';') then - RaiseException('syntax error: ; expected after "default" property ' + RaiseException('; expected after "default" property ' +'specifier, but '+GetAtom+' found'); end else if UpAtomIs('NODEFAULT') then begin if not ReadNextAtomIsChar(';') then - RaiseException('syntax error: ; expected after "nodefault" property ' + RaiseException('; expected after "nodefault" property ' +'specifier, but '+GetAtom+' found'); end else UndoReadNextAtom; @@ -1469,7 +1467,7 @@ begin exit; end; if not ((CurSection=ctnInterface) and UpAtomIs('IMPLEMENTATION')) then - RaiseException('syntax error: unexpected keyword '+GetAtom+' found'); + RaiseException('unexpected keyword '+GetAtom+' found'); // close interface section node CurNode.EndPos:=CurPos.StartPos; EndChildNode; @@ -1487,7 +1485,7 @@ begin ctnImplementation: begin if not (UpAtomIs('INITIALIZATION') or UpAtomIs('FINALIZATION')) then - RaiseException('syntax error: unexpected keyword '+GetAtom+' found'); + RaiseException('unexpected keyword '+GetAtom+' found'); // close implementation section node CurNode.EndPos:=CurPos.StartPos; EndChildNode; @@ -1508,7 +1506,7 @@ begin CurNode.Desc:=ctnFinalization; CurSection:=CurNode.Desc; end else if UpAtomIs('END') then begin - Result:=KeyWordFuncEnd; + Result:=KeyWordFuncEndPoint; break; end; until (CurPos.StartPos>SrcLen); @@ -1516,22 +1514,37 @@ begin end; else begin - RaiseException('syntax error: unexpected keyword '+GetAtom+' found'); + RaiseException('unexpected keyword '+GetAtom+' found'); Result:=false; end; end; end; -function TPascalParserTool.KeyWordFuncEnd: boolean; -// keyword 'end' (source end.) +function TPascalParserTool.KeyWordFuncEndPoint: boolean; +// keyword 'end' or '.' (source end.) begin - if LastAtomIs(0,'@') then - RaiseException('syntax error: identifier expected but keyword end found'); - if LastAtomIs(0,'@@') then begin - // for Delphi compatibility @@end is allowed - Result:=true; - exit; - end; + if AtomIsChar('.') then begin + if not LastUpAtomIs(0,'END') then + RaiseException('illegal qualifier'); + UndoReadNextAtom; + if CurNode.Desc in [ctnInterface] then + RaiseException('implementation expected, but '+GetAtom+' found'); + if not (CurNode.Desc in [ctnImplementation,ctnInitialization, + ctnFinalization,ctnProgram]) + then begin + ReadNextAtom; + RaiseException('unexpected end of source'); + end; + end else if UpAtomIs('END') then begin + if LastAtomIs(0,'@') then + RaiseException('identifier expected but keyword end found'); + if LastAtomIs(0,'@@') then begin + // for Delphi compatibility @@end is allowed + Result:=true; + exit; + end; + end else + RaiseException('[TPascalParserTool.KeyWordFuncEndPoint] internal error'); if CurNode.Desc in [ctnImplementation,ctnInterface] then CurNode.EndPos:=CurPos.StartPos else @@ -1547,19 +1560,19 @@ end; function TPascalParserTool.KeyWordFuncProc: boolean; // procedure, function, constructor, destructor, operator var ChildCreated: boolean; - IsFunction, HasForwardModifier, IsClassProc: boolean; + IsFunction, HasForwardModifier, IsClassProc, IsOperator: boolean; ProcNode: TCodeTreeNode; begin if UpAtomIs('CLASS') then begin if CurSection<>ctnImplementation then RaiseException( - 'syntax error: identifier expected, but '+GetAtom+' found'); + 'identifier expected, but '+GetAtom+' found'); ReadNextAtom; if UpAtomIs('PROCEDURE') or UpAtomIs('FUNCTION') then IsClassProc:=true else RaiseException( - 'syntax error: "procedure" expected, but '+GetAtom+' found'); + '"procedure" expected, but '+GetAtom+' found'); end else IsClassProc:=false; ChildCreated:=true; @@ -1574,12 +1587,14 @@ begin ProcNode.SubDesc:=ctnsForwardDeclaration; end; IsFunction:=UpAtomIs('FUNCTION'); + IsOperator:=UpAtomIs('OPERATOR'); ReadNextAtom;// read first atom of head (= name + parameterlist + resulttype;) - AtomIsIdentifier(true); + if not IsOperator then AtomIsIdentifier(true); if ChildCreated then begin // create node for procedure head CreateChildNode; CurNode.Desc:=ctnProcedureHead; + CurNode.SubDesc:=ctnsNeedJITParsing; end; ReadNextAtom; if (CurSection<>ctnInterface) and (AtomIsChar('.')) then begin @@ -1590,7 +1605,8 @@ begin end; // read rest of procedure head HasForwardModifier:=false; - ReadTilProcedureHeadEnd(false,IsFunction,false,false,HasForwardModifier); + ReadTilProcedureHeadEnd(false,IsFunction,false,IsOperator,false, + HasForwardModifier); if ChildCreated then begin if HasForwardModifier then ProcNode.SubDesc:=ctnsForwardDeclaration; @@ -1598,7 +1614,7 @@ begin CurNode.EndPos:=CurPos.EndPos; EndChildNode; end; - if ChildCreated and (ProcNode.SubDesc=ctnsForwardDeclaration) then begin + if ChildCreated and ((ProcNode.SubDesc and ctnsForwardDeclaration)>0) then begin // close method CurNode.EndPos:=CurPos.EndPos; EndChildNode; @@ -1611,6 +1627,25 @@ function TPascalParserTool.ReadTilBlockEnd( // after reading cursor will be on the keyword ending the block (e.g. 'end') var BlockType: TEndBlockType; TryType: TTryType; + BlockStartPos: integer; + + procedure RaiseExceptionWithBlockStartHint(const AMessage: string); + var CaretXY: TCodeXYPosition; + begin + if (CleanPosToCaret(BlockStartPos,CaretXY)) + and (CaretXY.Code<>nil) then begin + if CaretXY.Code=TCodeBuffer(Scanner.MainCode) then + RaiseException(AMessage+'. start at ' + +'('+IntToStr(CaretXY.Y)+','+IntToStr(CaretXY.X)+')') + else + RaiseException(AMessage+'. start at ' + +TCodeBuffer(CaretXY.Code).Filename + +'('+IntToStr(CaretXY.Y)+','+IntToStr(CaretXY.X)+')'); + end else if (Scanner<>nil) and (Scanner.MainCode<>nil) then begin + RaiseException(AMessage); + end; + end; + begin Result:=true; TryType:=ttNone; @@ -1629,47 +1664,65 @@ begin else RaiseException('internal codetool error in ' +'TPascalParserTool.ReadTilBlockEnd: unkown block type'); + BlockStartPos:=CurPos.StartPos; repeat ReadNextAtom; if (CurPos.StartPos>SrcLen) then begin - RaiseException('syntax error: "end" not found.') + RaiseExceptionWithBlockStartHint('"end" not found') end else if (UpAtomIs('END')) then begin if BlockType=ebtRepeat then - RaiseException( - 'syntax error: "until" expected, but "'+GetAtom+'" found'); + RaiseExceptionWithBlockStartHint( + '"until" expected, but "'+GetAtom+'" found'); if (BlockType=ebtTry) and (TryType=ttNone) then - RaiseException( - 'syntax error: "finally" expected, but "'+GetAtom+'" found'); + RaiseExceptionWithBlockStartHint( + '"finally" expected, but "'+GetAtom+'" found'); + ReadNextAtom; + if AtomIsChar('.') + and (BlockType<>ebtBegin) then begin + RaiseExceptionWithBlockStartHint('; expected, but . found'); + end; + UndoReadNextAtom; break; end else if EndKeyWordFuncList.DoItUppercase(UpperSrc,CurPos.StartPos, CurPos.EndPos-CurPos.StartPos) or UpAtomIs('REPEAT') then begin if BlockType=ebtAsm then - RaiseException('syntax error: unexpected keyword "'+GetAtom+'" found'); + RaiseException('unexpected keyword "'+GetAtom+'" found'); if (BlockType<>ebtRecord) or (not UpAtomIs('CASE')) then ReadTilBlockEnd(false,CreateNodes); end else if UpAtomIs('UNTIL') then begin if BlockType=ebtRepeat then break; - RaiseException( - 'syntax error: "end" expected, but "'+GetAtom+'" found'); + RaiseExceptionWithBlockStartHint( + '"end" expected, but "'+GetAtom+'" found'); end else if UpAtomIs('FINALLY') then begin if (BlockType=ebtTry) and (TryType=ttNone) then begin if StopOnBlockMiddlePart then break; TryType:=ttFinally; end else - RaiseException( - 'syntax error: "end" expected, but "'+GetAtom+'" found'); + RaiseExceptionWithBlockStartHint( + '"end" expected, but "'+GetAtom+'" found'); end else if UpAtomIs('EXCEPT') then begin if (BlockType=ebtTry) and (TryType=ttNone) then begin if StopOnBlockMiddlePart then break; TryType:=ttExcept; end else - RaiseException( - 'syntax error: "end" expected, but "'+GetAtom+'" found'); + RaiseExceptionWithBlockStartHint( + '"end" expected, but "'+GetAtom+'" found'); end else if CreateNodes and UpAtomIs('WITH') then begin ReadWithStatement(true,CreateNodes); + end else begin + // check for unexpected keywords + case BlockType of + + ebtBegin,ebtAsm,ebtTry,ebtCase,ebtRepeat: + if UnexpectedKeyWordInBeginBlock.DoItUppercase(UpperSrc, + CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) + then + RaiseException('unexpected keyword '+GetAtom+' found'); + + end; end; until false; end; @@ -1684,19 +1737,20 @@ var BlockType: TEndBlockType; begin case BlockType of ebtBegin: - RaiseException('syntax error: "begin" expected, but "' + RaiseException('"begin" expected, but "' +GetAtom+'" found'); ebtTry: - RaiseException('syntax error: "try" expected, but "' + RaiseException('"try" expected, but "' +GetAtom+'" found'); ebtRepeat: - RaiseException('syntax error: "repeat" expected, but "' + RaiseException('"repeat" expected, but "' +GetAtom+'" found'); else - RaiseException('syntax error: unexpected keyword "'+GetAtom+'" found'); + RaiseException('unexpected keyword "'+GetAtom+'" found'); end; end; +var OldAtom: TAtomPosition; begin Result:=true; if UpAtomIs('END') then @@ -1711,33 +1765,82 @@ begin repeat ReadPriorAtom; if (CurPos.StartPos<1) then begin - RaiseException('syntax error: "begin" not found.') - end else if UpAtomIs('END') or (UpAtomIs('UNTIL')) then begin - ReadBackTilBlockEnd(false); - end else if UpAtomIs('BEGIN') or UpAtomIs('CASE') or UpAtomIs('ASM') - or UpAtomIs('RECORD') then + RaiseException('"begin" not found.') + end else if WordIsBlockKeyWord.DoItUpperCase(UpperSrc,CurPos.StartPos, + CurPos.EndPos-CurPos.StartPos) then begin - // Todo: case could also be in a record, then it should not close the block - if BlockType=ebtBegin then - break - else - RaiseBlockError; - end else if UpAtomIs('REPEAT') then begin - if BlockType=ebtRepeat then - break - else - RaiseBlockError; - end else if UpAtomIs('FINALLY') or UpAtomIs('EXCEPT') then begin - if BlockType=ebtBegin then begin - if StopOnBlockMiddlePart then break; - BlockType:=ebtTry; - end else - RaiseBlockError; - end else if UpAtomIs('TRY') then begin - if BlockType=ebtTry then - break - else - RaiseBlockError; + if UpAtomIs('END') or (UpAtomIs('UNTIL')) then begin + ReadBackTilBlockEnd(false); + end else if UpAtomIs('BEGIN') or UpAtomIs('ASM') or UpAtomIs('RECORD') + then begin + if BlockType=ebtBegin then + break + else + RaiseBlockError; + end else if UpAtomIs('OBJECT') then begin + if BlockType=ebtBegin then begin + // could also be 'of object' + OldAtom:=CurPos; + ReadPriorAtom; + if not UpAtomIs('OF') then begin + CurPos:=OldAtom; + break; + end; + end else + RaiseBlockError; + end else if UpAtomIs('CLASS') then begin + ReadNextAtom; + if UpAtomIs('FUNCTION') or UpAtomIs('PROCEDURE') or AtomIsChar(';') + or UpAtomIs('OF') then + UndoReadNextAtom + else begin + UndoReadNextAtom; + break; + end; + end else if UpAtomIs('CASE') then begin + // case could also be in a record, then it should not close the block + if BlockType=ebtBegin then begin + // check if case in a record + OldAtom:=CurPos; + repeat + ReadPriorAtom; + if WordIsBlockKeyWord.DoItUpperCase(UpperSrc,CurPos.StartPos, + CurPos.EndPos-CurPos.StartPos) then + begin + if UpAtomIs('CASE') then begin + // could be another variant record, -> read further ... + end else if UpAtomIs('RECORD') then begin + // record start found -> the case is a variant record + // block start found + break; + end else begin + // this is not a variant record + MoveCursorToCleanPos(OldAtom.StartPos); + CurPos.EndPos:=OldAtom.EndPos; + break; + end; + end; + until (CurPos.StartPos<1); + break; + end else + RaiseBlockError; + end else if UpAtomIs('REPEAT') then begin + if BlockType=ebtRepeat then + break + else + RaiseBlockError; + end else if UpAtomIs('FINALLY') or UpAtomIs('EXCEPT') then begin + if BlockType=ebtBegin then begin + if StopOnBlockMiddlePart then break; + BlockType:=ebtTry; + end else + RaiseBlockError; + end else if UpAtomIs('TRY') then begin + if BlockType=ebtTry then + break + else + RaiseBlockError; + end; end; until false; end; @@ -1820,7 +1923,7 @@ begin end; if not UpAtomIs('DO') then begin if ExceptionOnError then - RaiseException('syntax error: do expected, but '+GetAtom+' found') + RaiseException('do expected, but '+GetAtom+' found') else begin Result:=false; exit; @@ -1860,34 +1963,75 @@ begin if AtomIsWord and (not IsKeyWordInConstAllowed.DoItUppercase(UpperSrc, CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)) and (UpAtomIs('END') or AtomIsKeyWord) then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); + RaiseException('; expected, but '+GetAtom+' found'); until AtomIsChar(';'); end; // read ; if not AtomIsChar(';') then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); - if not ReadNextUpAtomIs('CVAR') then - UndoReadNextAtom - else + RaiseException('; expected, but '+GetAtom+' found'); + ReadNextAtom; + if UpAtomIs('CVAR') then begin + // for example: 'var a: char; cvar;' if not ReadNextAtomIsChar(';') then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); + RaiseException('; expected, but '+GetAtom+' found'); + end else if UpAtomIs('PUBLIC') or UpAtomIs('EXTERNAL') then begin + if NodeHasParentOfType(CurNode,ctnClass) then + // class visibility keyword 'public' + UndoReadNextAtom + else begin + // for example 'var a: char; public;' + ReadNextAtom; + if UpAtomIs('NAME') then begin + // for example 'var a: char; public name 'b' ;' + ReadNextAtom; + if not AtomIsStringConstant then + RaiseException('string constant expected, but ' + +GetAtom+' found'); + ReadConstant(true,false,[]); + UndoReadNextAtom; + end; + if not ReadNextAtomIsChar(';') then + RaiseException('; expected, but '+GetAtom+' found'); + end; + end else + UndoReadNextAtom; CurNode.EndPos:=CurPos.EndPos; EndChildNode; end; function TPascalParserTool.KeyWordFuncBeginEnd: boolean; // Keyword: begin, asm -var BeginKeyWord: shortstring; + + procedure RaiseExceptionWithHint; + var CaretXY: TCodeXYPosition; + AMessage: string; + begin + AMessage:='; expected, but . found'; + if (CleanPosToCaret(CurNode.StartPos,CaretXY)) + and (CaretXY.Code<>nil) then begin + if CaretXY.Code=TCodeBuffer(Scanner.MainCode) then + RaiseException(AMessage+'. Hint: proc start at ' + +'('+IntToStr(CaretXY.Y)+','+IntToStr(CaretXY.X)+')') + else + RaiseException(AMessage+'. Hint: proc start at ' + +TCodeBuffer(CaretXY.Code).Filename + +'('+IntToStr(CaretXY.Y)+','+IntToStr(CaretXY.X)+')'); + end else if (Scanner<>nil) and (Scanner.MainCode<>nil) then begin + RaiseException(AMessage); + end; + end; + +var ChildNodeCreated: boolean; begin - BeginKeyWord:=GetUpAtom; - ChildNodeCreated:=(BeginKeyWord='BEGIN') or (BeginKeyWord='ASM'); + ChildNodeCreated:=UpAtomIs('BEGIN') or UpAtomIs('ASM'); if ChildNodeCreated then begin CreateChildNode; - if BeginKeyWord='BEGIN' then + if UpAtomIs('BEGIN') then CurNode.Desc:=ctnBeginBlock else CurNode.Desc:=ctnAsmBlock; + CurNode.SubDesc:=ctnsNeedJITParsing; end; // search "end" ReadTilBlockEnd(false,false); @@ -1900,11 +2044,15 @@ begin and (CurNode<>nil) and (CurNode.Desc=ctnProcedure) then begin // close procedure CurNode.EndPos:=CurPos.EndPos; + ReadNextAtom; + if AtomIsChar('.') then + RaiseExceptionWithHint; + UndoReadNextAtom; EndChildNode; - end else if (CurNode.Desc in [ctnProgram]) then begin + end else if (CurNode.Desc in [ctnProgram,ctnImplementation]) then begin ReadNextAtom; if not AtomIsChar('.') then - RaiseException('syntax error: missing . after program end'); + RaiseException('missing . after end'); // close program CurNode.EndPos:=CurPos.EndPos; EndChildNode; @@ -1927,7 +2075,7 @@ function TPascalParserTool.KeyWordFuncType: boolean; } begin if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then - RaiseException('syntax error: unexpected keyword '+GetAtom); + RaiseException('unexpected keyword '+GetAtom); CreateChildNode; CurNode.Desc:=ctnTypeSection; // read all type definitions Name = Type; @@ -1937,14 +2085,14 @@ begin CreateChildNode; CurNode.Desc:=ctnTypeDefinition; if not ReadNextAtomIsChar('=') then - RaiseException('syntax error: = expected, but '+GetAtom+' found'); + RaiseException('= expected, but '+GetAtom+' found'); // read type ReadNextAtom; TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos, CurPos.EndPos-CurPos.StartPos); // read ; if not AtomIsChar(';') then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); + RaiseException('; expected, but '+GetAtom+' found'); CurNode.EndPos:=CurPos.EndPos; EndChildNode; end else begin @@ -1964,6 +2112,7 @@ function TPascalParserTool.KeyWordFuncVar: boolean; interface var a:b; a:b; cvar; + a:b; public name 'string constant'; implementation @@ -1973,10 +2122,10 @@ function TPascalParserTool.KeyWordFuncVar: boolean; } begin if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then - RaiseException('syntax error: unexpected keyword '+GetAtom); + RaiseException('unexpected keyword '+GetAtom); CreateChildNode; CurNode.Desc:=ctnVarSection; - // read all variable definitions Name : Type; [cvar;] + // read all variable definitions Name : Type; [cvar;] [public [name '']] repeat ReadNextAtom; // name if AtomIsIdentifier(false) then begin @@ -1994,7 +2143,7 @@ begin ReadNextAtom; end; if not AtomIsChar(':') then - RaiseException('syntax error: : expected, but '+GetAtom+' found'); + RaiseException(': expected, but '+GetAtom+' found'); // read type ReadVariableType; end else begin @@ -2021,7 +2170,7 @@ function TPascalParserTool.KeyWordFuncConst: boolean; } begin if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then - RaiseException('syntax error: unexpected keyword '+GetAtom); + RaiseException('unexpected keyword '+GetAtom); CreateChildNode; CurNode.Desc:=ctnConstSection; // read all constants Name = ; or Name : type = ; @@ -2038,7 +2187,7 @@ begin CurPos.EndPos-CurPos.StartPos); end; if not AtomIsChar('=') then - RaiseException('syntax error: = expected, but '+GetAtom+' found'); + RaiseException('= expected, but '+GetAtom+' found'); // read constant repeat ReadNextAtom; @@ -2047,7 +2196,7 @@ begin if AtomIsWord and (not IsKeyWordInConstAllowed.DoItUppercase(UpperSrc, CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)) and (UpAtomIs('END') or AtomIsKeyWord) then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); + RaiseException('; expected, but '+GetAtom+' found'); until AtomIsChar(';'); CurNode.EndPos:=CurPos.EndPos; EndChildNode; @@ -2075,7 +2224,7 @@ function TPascalParserTool.KeyWordFuncResourceString: boolean; } begin if not (CurSection in [ctnProgram,ctnInterface,ctnImplementation]) then - RaiseException('syntax error: unexpected keyword '+GetAtom); + RaiseException('unexpected keyword '+GetAtom); CreateChildNode; CurNode.Desc:=ctnResStrSection; // read all string constants Name = 'abc'; @@ -2085,15 +2234,15 @@ begin CreateChildNode; CurNode.Desc:=ctnConstDefinition; if not ReadNextAtomIsChar('=') then - RaiseException('syntax error: = expected, but '+GetAtom+' found'); + RaiseException('= expected, but '+GetAtom+' found'); // read string constant ReadNextAtom; if not AtomIsStringConstant then RaiseException( - 'syntax error: string constant expected, but '+GetAtom+' found'); + 'string constant expected, but '+GetAtom+' found'); // read ; if not ReadNextAtomIsChar(';') then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); + RaiseException('; expected, but '+GetAtom+' found'); CurNode.EndPos:=CurPos.EndPos; EndChildNode; end else begin @@ -2111,7 +2260,7 @@ begin ReadNextAtom; if not PackedTypesKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos, CurPos.EndPos-CurPos.StartPos) then - RaiseException('syntax error: ''record'' expected, but '+GetAtom+' found'); + RaiseException('''record'' expected, but '+GetAtom+' found'); Result:=TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos, CurPos.EndPos-CurPos.StartPos); end; @@ -2127,14 +2276,14 @@ var Level: integer; begin if CurNode.Desc<>ctnTypeDefinition then - RaiseException('syntax error: anonym classes are forbidden'); + RaiseException('anonym classes are forbidden'); if (LastUpAtomIs(0,'PACKED')) then begin if not LastAtomIs(1,'=') then - RaiseException('syntax error: anonym classes are not allowed'); + RaiseException('anonym classes are not allowed'); ClassAtomPos:=LastAtoms.GetValueAt(1); end else begin if not LastAtomIs(0,'=') then - RaiseException('syntax error: anonym classes are not allowed'); + RaiseException('anonym classes are not allowed'); ClassAtomPos:=CurPos; end; // class start found @@ -2150,17 +2299,18 @@ begin ReadNextAtom; AtomIsIdentifier(true); if not ReadNextAtomIsChar(';') then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); + RaiseException('; expected, but '+GetAtom+' found'); if ChildCreated then CurNode.Desc:=ctnClassOfType; end else if AtomIsChar('(') then begin // read inheritage brackets ReadTilBracketClose(true); ReadNextAtom; end; + CurNode.SubDesc:=ctnsNeedJITParsing; // will not create sub nodes now if AtomIsChar(';') then begin if ChildCreated and (CurNode.Desc=ctnClass) then begin // forward class definition found - CurNode.SubDesc:=ctnsForwardDeclaration; + CurNode.SubDesc:=CurNode.SubDesc+ctnsForwardDeclaration; end; end else begin Level:=1; @@ -2172,7 +2322,7 @@ begin ReadNextAtom; end; if (CurPos.StartPos>SrcLen) then - RaiseException('syntax error: "end" for class/object not found'); + RaiseException('"end" for class/object not found'); end; if ChildCreated then begin // close class @@ -2203,12 +2353,12 @@ begin EndChildNode; if AtomIsChar(']') then break; if not AtomIsChar(',') then - RaiseException('syntax error: ] expected, but '+GetAtom+' found'); + RaiseException('] expected, but '+GetAtom+' found'); until false; ReadNextAtom; end; if not UpAtomIs('OF') then - RaiseException('syntax error: ''of'' expected, but '+GetAtom+' found'); + RaiseException('''of'' expected, but '+GetAtom+' found'); ReadNextAtom; Result:=TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos, CurPos.EndPos-CurPos.StartPos); @@ -2238,7 +2388,7 @@ begin end; if IsFunction then begin if not AtomIsChar(':') then - RaiseException('syntax error: : expected, but '+GetAtom+' found'); + RaiseException(': expected, but '+GetAtom+' found'); ReadNextAtom; AtomIsIdentifier(true); ReadNextAtom; @@ -2246,23 +2396,27 @@ begin if UpAtomIs('OF') then begin if not ReadNextUpAtomIs('OBJECT') then RaiseException( - 'syntax error: ''object'' expected, but '+GetAtom+' found'); + '''object'' expected, but '+GetAtom+' found'); ReadNextAtom; end; - if not AtomIsChar(';') then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); - // read modifiers - repeat - ReadNextAtom; - if not IsKeyWordProcedureTypeSpecifier.DoItUpperCase(UpperSrc,CurPos.StartPos, - CurPos.EndPos-CurPos.StartPos) then begin - UndoReadNextAtom; - break; - end else begin - if not ReadNextAtomIsChar(';') then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); - end; - until false; + if AtomIsChar('=') and NodeHasParentOfType(CurNode,ctnConstDefinition) then + begin + end else begin + if not AtomIsChar(';') then + RaiseException('; expected, but '+GetAtom+' found'); + // read modifiers + repeat + ReadNextAtom; + if not IsKeyWordProcedureTypeSpecifier.DoItUpperCase(UpperSrc,CurPos.StartPos, + CurPos.EndPos-CurPos.StartPos) then begin + UndoReadNextAtom; + break; + end else begin + if not ReadNextAtomIsChar(';') then + RaiseException('; expected, but '+GetAtom+' found'); + end; + until false; + end; CurNode.EndPos:=CurPos.StartPos; EndChildNode; Result:=true; @@ -2278,7 +2432,7 @@ begin CreateChildNode; CurNode.Desc:=ctnSetType; if not ReadNextUpAtomIs('OF') then - RaiseException('syntax error: ''of'' expected, but '+GetAtom+' found'); + RaiseException('''of'' expected, but '+GetAtom+' found'); ReadNextAtom; Result:=KeyWordFuncTypeDefault; CurNode.EndPos:=CurPos.EndPos; @@ -2301,7 +2455,7 @@ function TPascalParserTool.KeyWordFuncTypeType: boolean; // 'type identifier' begin if not LastAtomIs(0,'=') then - RaiseException('syntax error: identfier expected, but ''type'' found'); + RaiseException('identfier expected, but ''type'' found'); CreateChildNode; CurNode.Desc:=ctnTypeType; ReadNextAtom; @@ -2331,7 +2485,7 @@ function TPascalParserTool.KeyWordFuncTypePointer: boolean; // '^Identfier' begin if not (LastAtomIs(0,'=') or LastAtomIs(0,':')) then - RaiseException('syntax error: identifier expected, but ^ found'); + RaiseException('identifier expected, but ^ found'); CreateChildNode; CurNode.Desc:=ctnPointerType; ReadNextAtom; @@ -2365,7 +2519,7 @@ var SubRangeOperatorFound: boolean; else if AtomIs('..') then begin if SubRangeOperatorFound then RaiseException( - 'syntax error: unexpected subrange operator ''..'' found'); + 'unexpected subrange operator ''..'' found'); SubRangeOperatorFound:=true; end; ReadNextAtom; @@ -2398,7 +2552,7 @@ begin CurNode.Desc:=ctnRangeType; ReadTillTypeEnd; if not SubRangeOperatorFound then - RaiseException('syntax error: invalid subrange'); + RaiseException('invalid subrange'); CurNode.EndPos:=CurPos.StartPos; end; end else begin @@ -2431,19 +2585,19 @@ begin break else if AtomIsKeyWord then RaiseException( - 'syntax error: unexpected keyword '+GetAtom+' found'); + 'unexpected keyword '+GetAtom+' found'); until CurPos.StartPos>SrcLen; CurNode.EndPos:=CurPos.StartPos; end; EndChildNode; // close enum node if AtomIsChar(')') then break; if not AtomIsChar(',') then - RaiseException('syntax error: ) expected, but '+GetAtom+' found'); + RaiseException(') expected, but '+GetAtom+' found'); until false; CurNode.EndPos:=CurPos.EndPos; ReadNextAtom; end else - RaiseException('syntax error: invalid type'); + RaiseException('invalid type'); end; end; EndChildNode; @@ -2458,7 +2612,7 @@ function TPascalParserTool.KeyWordFuncTypeRecord: boolean; i: packed record j: integer; k: record end; - case integer of + case y: integer of 0: (a: integer); 1,2,3: (b: array[char] of char; c: char); 3: ( d: record @@ -2466,9 +2620,14 @@ function TPascalParserTool.KeyWordFuncTypeRecord: boolean; 10: (i: integer; ); 11: (y: byte); end; ); + 4: (e: integer; + case z of + 8: (f: integer) + ); end; end; } +// function TPascalParserTool.KeyWordFuncTypeRecord: boolean; begin CreateChildNode; CurNode.Desc:=ctnRecordType; @@ -2479,70 +2638,7 @@ begin ReadNextAtom; if UpAtomIs('END') then break; if UpAtomIs('CASE') then begin - CreateChildNode; - CurNode.Desc:=ctnRecordCase; - ReadNextAtom; // read ordinal type - AtomIsIdentifier(true); - if not ReadNextUpAtomIs('OF') then // read 'of' - RaiseException('syntax error: ''of'' expected, but '+GetAtom+' found'); - // read all variants - repeat - ReadNextAtom; // read constant (variant identifier) - if UpAtomIs('END') then break; - CreateChildNode; - CurNode.Desc:=ctnRecordVariant; - repeat - ReadNextAtom; // read till ':' - if AtomIsChar(':') then break - else if AtomIsChar('(') or AtomIsChar('[') then - ReadTilBracketClose(true) - else if UpAtomIs('END') or AtomIsChar(')') or AtomIsKeyWord then - RaiseException('syntax error: : expected, but '+GetAtom+' found'); - until false; - ReadNextAtom; // read '(' - if not AtomIsChar('(') then - RaiseException('syntax error: ( expected, but '+GetAtom+' found'); - // read all variables - ReadNextAtom; // read first variable name - repeat - if AtomIsChar(')') then break; - repeat - AtomIsIdentifier(true); - CreateChildNode; - CurNode.Desc:=ctnVarDefinition; - CurNode.EndPos:=CurPos.EndPos; - ReadNextAtom; - if AtomIsChar(':') then break; - if not AtomIsChar(',') then - RaiseException( - 'syntax error: '','' expected, but '+GetAtom+' found'); - EndChildNode; - ReadNextAtom; // read next variable name - until false; - ReadNextAtom; // read type - Result:=TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos, - CurPos.EndPos-CurPos.StartPos); - if not Result then exit; - CurNode.EndPos:=CurPos.EndPos; - EndChildNode; // close variable definition - if AtomIsChar(')') then break; - if not AtomIsChar(';') then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); - ReadNextAtom; - until false; - ReadNextAtom; - if UpAtomIs('END') then begin - CurNode.EndPos:=CurPos.StartPos; - EndChildNode; // close variant - break; - end; - if not AtomIsChar(';') then - RaiseException('syntax error: ; expected, but '+GetAtom+' found'); - CurNode.EndPos:=CurPos.EndPos; - EndChildNode; // close variant - until false; - CurNode.EndPos:=CurPos.EndPos; - EndChildNode; // close case + KeyWordFuncTypeRecordCase; break; end else begin // read variable names @@ -2554,7 +2650,7 @@ begin ReadNextAtom; if AtomIsChar(':') then break; if not AtomIsChar(',') then - RaiseException('syntax error: : expected, but '+GetAtom+' found'); + RaiseException(': expected, but '+GetAtom+' found'); EndChildNode; // close variable ReadNextAtom; // read next variable name until false; @@ -2564,6 +2660,7 @@ begin if not Result then exit; CurNode.EndPos:=CurPos.EndPos; EndChildNode; // close variable + if UpAtomIs('END') then break; end; until false; CurNode.EndPos:=CurPos.EndPos; @@ -2572,6 +2669,96 @@ begin Result:=true; end; +function TPascalParserTool.KeyWordFuncTypeRecordCase: boolean; +begin + if not UpAtomIs('CASE') then + RaiseException('[TPascalParserTool.KeyWordFuncTypeRecordCase] ' + +'internal error'); + CreateChildNode; + CurNode.Desc:=ctnRecordCase; + ReadNextAtom; // read ordinal type + AtomIsIdentifier(true); + ReadNextAtom; + if AtomIsChar(':') then begin + ReadNextAtom; + AtomIsIdentifier(true); + ReadNextAtom; + end; + if not UpAtomIs('OF') then // read 'of' + RaiseException('''of'' expected, but '+GetAtom+' found'); + // read all variants + repeat + ReadNextAtom; // read constant (variant identifier) + if UpAtomIs('END') then break; + CreateChildNode; + CurNode.Desc:=ctnRecordVariant; + repeat + ReadNextAtom; // read till ':' + if AtomIsChar(':') then break + else if AtomIsChar('(') or AtomIsChar('[') then + ReadTilBracketClose(true) + else if UpAtomIs('END') or AtomIsChar(')') or AtomIsKeyWord then + RaiseException(': expected, but '+GetAtom+' found'); + until false; + ReadNextAtom; // read '(' + if not AtomIsChar('(') then + RaiseException('( expected, but '+GetAtom+' found'); + // read all variables + ReadNextAtom; // read first variable name + repeat + if AtomIsChar(')') then begin + // end of variant record + break; + end else if UpAtomIs('CASE') then begin + // sub record variant + KeyWordFuncTypeRecordCase(); + break; + end else begin + // sub identifier + repeat + AtomIsIdentifier(true); + CreateChildNode; + CurNode.Desc:=ctnVarDefinition; + CurNode.EndPos:=CurPos.EndPos; + ReadNextAtom; + if AtomIsChar(':') then break; + if not AtomIsChar(',') then + RaiseException( + ''','' expected, but '+GetAtom+' found'); + EndChildNode; + ReadNextAtom; // read next variable name + until false; + ReadNextAtom; // read type + Result:=TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos, + CurPos.EndPos-CurPos.StartPos); + if not Result then exit; + CurNode.EndPos:=CurPos.EndPos; + EndChildNode; // close variable definition + end; + if AtomIsChar(')') then break; + if not AtomIsChar(';') then + RaiseException('; expected, but '+GetAtom+' found'); + ReadNextAtom; + until false; + if not AtomIsChar(')') then + RaiseException(') expected, but '+GetAtom+' found'); + ReadNextAtom; + if UpAtomIs('END') or AtomIsChar(')') then begin + CurNode.EndPos:=CurPos.StartPos; + EndChildNode; // close variant + break; + end; + if not AtomIsChar(';') then + RaiseException('; expected, but '+GetAtom+' found'); + CurNode.EndPos:=CurPos.EndPos; + EndChildNode; // close variant + // read next variant + until false; + CurNode.EndPos:=CurPos.EndPos; + EndChildNode; // close case + Result:=true; +end; + function TPascalParserTool.ExtractPropName(PropNode: TCodeTreeNode; InUpperCase: boolean): string; begin @@ -2792,7 +2979,7 @@ begin //writeln('TPascalParserTool.FindProcNode A "',NodeDescriptionAsString(Result.Desc),'"'); if Result.Desc=ctnProcedure then begin if (not ((phpIgnoreForwards in Attr) - and (Result.SubDesc=ctnsForwardDeclaration))) + and ((Result.SubDesc and ctnsForwardDeclaration)>0))) and (not ((phpIgnoreProcsWithBody in Attr) and (FindProcBody(Result)<>nil))) then begin CurProcHead:=ExtractProcHead(Result,Attr); @@ -2902,9 +3089,10 @@ begin CurClassNode:=ANode.FirstChild; if (CurClassNode<>nil) and (CurClassNode.Desc=ctnClass) then begin if (not (IgnoreForwards - and (CurClassNode.SubDesc=ctnsForwardDeclaration))) + and ((CurClassNode.SubDesc and ctnsForwardDeclaration)>0))) and (not (IgnoreNonForwards - and (CurClassNode.SubDesc<>ctnsForwardDeclaration))) then begin + and ((CurClassNode.SubDesc and ctnsForwardDeclaration)=0))) + then begin MoveCursorToNodeStart(ANode); ReadNextAtom; CurClassName:=GetUpAtom; @@ -2977,11 +3165,13 @@ function TPascalParserTool.FindMainBeginEndNode: TCodeTreeNode; begin Result:=Tree.Root; if (Result=nil) then exit; - if (Result.Desc<>ctnProgram) then begin - Result:=nil; - exit; + if (Result.Desc=ctnProgram) then + Result:=Result.LastChild + else begin + Result:=FindImplementationNode; + if Result<>nil then + Result:=Result.LastChild; end; - Result:=Result.LastChild; if Result=nil then exit; if Result.Desc<>ctnBeginBlock then Result:=nil; end; @@ -3125,7 +3315,7 @@ begin ReadNextAtom; end; if not AtomIsChar(':') then - RaiseException('syntax error: : expected, but '+GetAtom+' found'); + RaiseException(': expected, but '+GetAtom+' found'); ReadNextAtom; // read type AtomIsIdentifier(true); end; @@ -3143,23 +3333,24 @@ begin end; procedure TPascalParserTool.BuildSubTreeForProcHead(ProcNode: TCodeTreeNode); -var HasForwardModifier, IsFunction: boolean; +var HasForwardModifier, IsFunction, IsOperator: boolean; begin if ProcNode.Desc=ctnProcedureHead then ProcNode:=ProcNode.Parent; if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) or (ProcNode.FirstChild=nil) then RaiseException('[TPascalParserTool.BuildSubTreeForProcHead] ' +'internal error: invalid ProcNode'); - if ProcNode.FirstChild.SubDesc=ctnsProcHeadNodesCreated then exit; + if (ProcNode.FirstChild.SubDesc and ctnsNeedJITParsing)=0 then exit; MoveCursorToNodeStart(ProcNode); ReadNextAtom; if UpAtomIs('CLASS') then ReadNextAtom; IsFunction:=UpAtomIs('FUNCTION'); + IsOperator:=UpAtomIs('OPERATOR'); // read procedure head (= name + parameterlist + resulttype;) CurNode:=ProcNode.FirstChild; ReadNextAtom;// read first atom of head - AtomIsIdentifier(true); + if not IsOperator then AtomIsIdentifier(true); ReadNextAtom; if AtomIsChar('.') then begin // read procedure name of a class method (the name after the . ) @@ -3169,8 +3360,9 @@ begin end; // read rest of procedure head and build nodes HasForwardModifier:=false; - ReadTilProcedureHeadEnd(false,IsFunction,false,true,HasForwardModifier); - ProcNode.FirstChild.SubDesc:=ctnsProcHeadNodesCreated; + ReadTilProcedureHeadEnd(false,IsFunction,false,IsOperator,true, + HasForwardModifier); + ProcNode.FirstChild.SubDesc:=ctnsNone; end; diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index 955c6cac6f..6e7f320181 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -52,8 +52,6 @@ uses type TStandardCodeTool = class(TFindDeclarationTool) private - BlockKeywordFuncList: TKeyWordFunctionList; - procedure BuildBlockKeyWordFuncList; function ReadTilGuessedUnclosedBlock(MinCleanPos: integer; ReadOnlyOneBlock: boolean): boolean; function ReadForwardTilAnyBracketClose: boolean; @@ -126,6 +124,8 @@ type // blocks (e.g. begin..end) function FindBlockCounterPart(CursorPos: TCodeXYPosition; var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean; + function FindBlockStart(CursorPos: TCodeXYPosition; + var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean; function GuessUnclosedBlock(CursorPos: TCodeXYPosition; var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean; end; @@ -133,6 +133,7 @@ type implementation + type TBlockKeyword = (bkwNone, bkwBegin, bkwAsm, bkwTry, bkwCase, bkwRepeat, bkwRecord, bkwClass, bkwObject, bkwInterface, @@ -146,6 +147,19 @@ const 'EXCEPT' ); +var + BlockKeywordFuncList: TKeyWordFunctionList; + +procedure BuildBlockKeyWordFuncList; +var BlockWord: TBlockKeyword; +begin + if BlockKeywordFuncList=nil then begin + BlockKeywordFuncList:=TKeyWordFunctionList.Create; + for BlockWord:=Low(TBlockKeyword) to High(TBlockKeyword) do + with BlockKeywordFuncList do + Add(BlockKeywords[BlockWord],{$ifdef FPC}@{$endif}AllwaysTrue); + end; +end; { TStandardCodeTool } @@ -229,11 +243,11 @@ begin SectionNode:=Tree.Root; while (SectionNode<>nil) and (SectionNode.Desc in [ctnProgram, ctnUnit, ctnPackage,ctnLibrary,ctnInterface,ctnImplementation]) do begin - if SectionNode.Desc in [ctnProgram, ctnPackage,ctnLibrary, ctnInterface, - ctnImplementation] then + if SectionNode.Desc in [ctnProgram, ctnInterface, ctnImplementation] then begin UsesNode:=SectionNode.FirstChild; - if FindUnitInUsesSection(UsesNode,UpperUnitName,NamePos,InPos) then begin + if (UsesNode.Desc=ctnUsesSection) + and FindUnitInUsesSection(UsesNode,UpperUnitName,NamePos,InPos) then begin Result:=true; exit; end; @@ -436,8 +450,8 @@ begin Result:=true; SectionNode:=Tree.Root; while (SectionNode<>nil) do begin - if (SectionNode.Desc in [ctnProgram,ctnPackage,ctnLibrary,ctnInterface, - ctnImplementation]) then begin + if (SectionNode.Desc in [ctnProgram,ctnInterface,ctnImplementation]) then + begin if RemoveUnitFromUsesSection(SectionNode.FirstChild,UpperUnitName, SourceChangeCache) then begin Result:=RemoveUnitFromAllUsesSections(UpperUnitName,SourceChangeCache); @@ -971,6 +985,8 @@ end; function TStandardCodeTool.FindBlockCounterPart(CursorPos: TCodeXYPosition; var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean; +// jump from bracket-open to bracket-close or 'begin' to 'end' +// or 'until' to 'repeat' ... var Dummy, CleanCursorPos: integer; begin Result:=false; @@ -1021,6 +1037,63 @@ writeln('TStandardCodeTool.FindBlockCounterPart C Word=',GetAtom); Result:=CleanPosToCaretAndTopLine(CurPos.StartPos,NewPos,NewTopLine); end; +function TStandardCodeTool.FindBlockStart(CursorPos: TCodeXYPosition; + var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean; +// jump to beginning of current block +// e.g. bracket open, 'begin', 'repeat', ... +var Dummy, CleanCursorPos: integer; +begin + Result:=false; + // scan code +{$IFDEF CTDEBUG} +writeln('TStandardCodeTool.FindBlockStart A CursorPos=',CursorPos.X,',',CursorPos.Y); +{$ENDIF} + if UpdateNeeded(false) then BeginParsing(true,false); + // find the CursorPos in cleaned source + Dummy:=CaretToCleanPos(CursorPos, CleanCursorPos); + if (Dummy<>0) and (Dummy<>-1) then + RaiseException('cursor pos outside of code'); + // read word at cursor + MoveCursorToCleanPos(CleanCursorPos); + while (CurPos.StartPos>2) and IsWordChar[Src[CurPos.StartPos-1]] do + dec(CurPos.StartPos); + while (CurPos.EndPos this is always a block start + CurPos.StartPos:=1; + Result:=true; + exit; + end + else if Src[CurPos.StartPos] in [')',']','}'] then begin + // jump backward to matching bracket + CurPos.EndPos:=CurPos.StartPos+1; + if not ReadBackwardTilAnyBracketClose then exit; + end + else if WordIsLogicalBlockStart.DoItUpperCase(UpperSrc, + CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) then + begin + // block start found + Result:=true; + exit; + end else if UpAtomIs('END') or UpAtomIs('FINALLY') or UpAtomIs('EXCEPT') + or UpAtomIs('UNTIL') then + begin + // read backward till BEGIN, CASE, ASM, RECORD, REPEAT + ReadBackTilBlockEnd(true); + end; + until false; + finally + if Result then begin + // CursorPos now contains the counter block keyword + Result:=CleanPosToCaretAndTopLine(CurPos.StartPos,NewPos,NewTopLine); + end; + end; +end; + function TStandardCodeTool.GuessUnclosedBlock(CursorPos: TCodeXYPosition; var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean; { search a block (e.g. begin..end) that looks unclosed, i.e. 'begin' @@ -1037,6 +1110,8 @@ function TStandardCodeTool.GuessUnclosedBlock(CursorPos: TCodeXYPosition; if expr then begin // first char in line is relevant, not the block keyword end + + class; Examples for bad blocks: @@ -1071,6 +1146,7 @@ writeln('TStandardCodeTool.GuessUnclosedBlock A CursorPos=',CursorPos.X,',',Curs BuildBlockKeyWordFuncList; if ReadTilGuessedUnclosedBlock(CleanCursorPos,false) then Result:=CleanPosToCaretAndTopLine(CurPos.StartPos,NewPos,NewTopLine); + WriteDebugTreeReport; end; function TStandardCodeTool.ReadTilGuessedUnclosedBlock( @@ -1112,14 +1188,30 @@ begin if BlockType=bkwNone then begin case CurBlockWord of - bkwBegin,bkwRepeat,bkwCase,bkwTry,bkwRecord,bkwClass,bkwObject, - bkwInterface,bkwDispInterface: + bkwBegin, bkwAsm, bkwRepeat, bkwCase, bkwTry, bkwRecord: begin BlockType:=CurBlockWord; BlockStart:=CurPos.StartPos; end; + + bkwClass, bkwObject, bkwInterface, bkwDispInterface: + begin + ReadNextAtom; + if AtomIsChar(';') + or ((CurBlockWord=bkwClass) and UpAtomIs('OF')) + or ((CurBlockWord=bkwClass) + and (UpAtomIs('FUNCTION') or UpAtomIs('PROCEDURE'))) + or ((CurBlockWord=bkwObject) and LastUpAtomIs(0,'OF')) then + begin + // forward class or 'class of' or class method or 'of object' + end else begin + UndoReadNextAtom; + BlockType:=CurBlockWord; + BlockStart:=CurPos.StartPos; + end; + end; - bkwEnd,bkwUntil: + bkwEnd, bkwUntil: begin // close block keywords found, but no block was opened // -> unclosed block found @@ -1149,6 +1241,10 @@ begin exit; end; // end block + if (BlockType=bkwRecord) and (CurBlockWord=bkwCase) then begin + // the 'end' keyword is the end for the case block and the record block + UndoReadNextAtom; + end; BlockType:=bkwNone; if ReadOnlyOneBlock then break; end @@ -1172,7 +1268,7 @@ begin else if ((BlockType in [bkwBegin,bkwRepeat,bkwTry,bkwFinally,bkwExcept, bkwCase]) - and (CurBlockWord in [bkwBegin,bkwRepeat,bkwTry,bkwCase])) + and (CurBlockWord in [bkwBegin,bkwRepeat,bkwTry,bkwCase,bkwAsm])) or ((BlockType in [bkwClass,bkwInterface,bkwDispInterface,bkwObject, bkwRecord]) and (CurBlockWord in [bkwRecord])) then @@ -1186,6 +1282,10 @@ begin // variant record end else + if (BlockType=bkwClass) and (CurBlockWord=bkwClass) then begin + // class method + end + else begin // unexpected keyword found if GetLineIndent(Src,BlockStart)>=GetLineIndent(Src,CurPos.StartPos) @@ -1202,18 +1302,6 @@ begin end; end; -procedure TStandardCodeTool.BuildBlockKeyWordFuncList; -var BlockWord: TBlockKeyword; -begin - if BlockKeywordFuncList=nil then begin - BlockKeywordFuncList:=TKeyWordFunctionList.Create; - for BlockWord:=Low(TBlockKeyword) to High(TBlockKeyword) do - with BlockKeywordFuncList do - Add(BlockKeywords[BlockWord],{$ifdef FPC}@{$endif}AllwaysTrue); - AddKeyWordFuncList(BlockKeywordFuncList); - end; -end; - function TStandardCodeTool.ReadForwardTilAnyBracketClose: boolean; // this function reads any bracket // (the ReadTilBracketClose function reads only brackets in code, not comments)