From f8329f9fc6a9cbf74d0ce25482afe7061638fc39 Mon Sep 17 00:00:00 2001 From: mattias Date: Fri, 20 Dec 2002 11:08:47 +0000 Subject: [PATCH] method resolution clause, class ancestor find declaration, 1.1. makros git-svn-id: trunk@3716 - --- components/codetools/codetoolsstrconsts.pas | 2 +- components/codetools/codetree.pas | 2 + components/codetools/definetemplates.pas | 192 +++++++++++++------ components/codetools/finddeclarationtool.pas | 1 + components/codetools/fpc.errore.msg | 4 + components/codetools/pascalparsertool.pas | 26 ++- ide/codetoolsdefines.pas | 12 +- 7 files changed, 172 insertions(+), 67 deletions(-) diff --git a/components/codetools/codetoolsstrconsts.pas b/components/codetools/codetoolsstrconsts.pas index fe79928a79..3f039ced82 100644 --- a/components/codetools/codetoolsstrconsts.pas +++ b/components/codetools/codetoolsstrconsts.pas @@ -147,7 +147,7 @@ ResourceString // definetemplates ctsUnknownFunction = 'Unknown function %s'; ctsSyntaxErrorInExpr = 'Syntax Error in expression "%s"'; - ctsDefaultppc386Macro = 'Default ppc386 macro'; + ctsDefaultppc386Symbol = 'Default ppc386 symbol'; ctsDefaultppc386TargetOperatingSystem = 'Default ppc386 target Operating System'; ctsDefaultppc386SourceOperatingSystem = 'Default ppc386 source Operating System'; ctsDefaultppc386TargetProcessor = 'Default ppc386 target processor'; diff --git a/components/codetools/codetree.pas b/components/codetools/codetree.pas index 942e2466be..2ef192d22c 100644 --- a/components/codetools/codetree.pas +++ b/components/codetools/codetree.pas @@ -81,6 +81,7 @@ const ctnClassGUID = 35; ctnProperty = 40; + ctnMethodMap = 41; ctnProcedure = 50; ctnProcedureHead = 51; @@ -300,6 +301,7 @@ begin ctnConstDefinition: Result:='Const'; ctnProperty: Result:='Property'; + ctnMethodMap: Result:='Method Map'; ctnIdentifier: Result:='Identifier'; ctnArrayType: Result:='Array Type'; diff --git a/components/codetools/definetemplates.pas b/components/codetools/definetemplates.pas index 71385fff54..ab53954e3d 100644 --- a/components/codetools/definetemplates.pas +++ b/components/codetools/definetemplates.pas @@ -134,14 +134,7 @@ type Action: TDefineAction; Flags: TDefineTemplateFlags; function Level: integer; - property ChildCount: integer read FChildCount; - property Parent: TDefineTemplate read FParent; - property Next: TDefineTemplate read FNext; - property Prior: TDefineTemplate read FPrior; - property FirstChild: TDefineTemplate read FFirstChild; - property LastChild: TDefineTemplate read FLastChild; - property Marked: boolean read FMarked write FMarked; - + function GetFirstSibling: TDefineTemplate; procedure AddChild(ADefineTemplate: TDefineTemplate); procedure InsertBehind(APrior: TDefineTemplate); procedure InsertInFront(ANext: TDefineTemplate); @@ -179,6 +172,14 @@ type destructor Destroy; override; function ConsistencyCheck: integer; // 0 = ok procedure WriteDebugReport; + public + property ChildCount: integer read FChildCount; + property Parent: TDefineTemplate read FParent; + property Next: TDefineTemplate read FNext; + property Prior: TDefineTemplate read FPrior; + property FirstChild: TDefineTemplate read FFirstChild; + property LastChild: TDefineTemplate read FLastChild; + property Marked: boolean read FMarked write FMarked; end; //--------------------------------------------------------------------------- @@ -253,6 +254,9 @@ type procedure RemoveNonAutoCreated; function GetIncludePathForDirectory(const Directory: string): string; function GetSrcPathForDirectory(const Directory: string): string; + function GetPPUSrcPathForDirectory(const Directory: string): string; + function GetPPWSrcPathForDirectory(const Directory: string): string; + function GetDCUSrcPathForDirectory(const Directory: string): string; constructor Create; destructor Destroy; override; function ConsistencyCheck: integer; // 0 = ok @@ -275,7 +279,7 @@ type procedure Move(SrcIndex, DestIndex: integer); property EnglishErrorMsgFilename: string read FEnglishErrorMsgFilename write SetEnglishErrorMsgFilename; - function CreateFPCTemplate(const PPC386Path: string; + function CreateFPCTemplate(const PPC386Path, TestPascalFile: string; var UnitSearchPath: string): TDefineTemplate; function CreateFPCSrcTemplate(const FPCSrcDir, UnitSearchPath: string; @@ -1035,6 +1039,12 @@ begin end; end; +function TDefineTemplate.GetFirstSibling: TDefineTemplate; +begin + Result:=Self; + while Result.Prior<>nil do Result:=Result.Prior; +end; + function TDefineTemplate.SelfOrParentContainsFlag( AFlag: TDefineTemplateFlag): boolean; var Node: TDefineTemplate; @@ -1248,6 +1258,42 @@ begin end; end; +function TDefineTree.GetPPUSrcPathForDirectory(const Directory: string + ): string; +var ExprEval: TExpressionEvaluator; +begin + ExprEval:=GetDefinesForDirectory(Directory); + if ExprEval<>nil then begin + Result:=ExprEval.Variables[ExternalMacroStart+'PPUSrcPath']; + end else begin + Result:=''; + end; +end; + +function TDefineTree.GetPPWSrcPathForDirectory(const Directory: string + ): string; +var ExprEval: TExpressionEvaluator; +begin + ExprEval:=GetDefinesForDirectory(Directory); + if ExprEval<>nil then begin + Result:=ExprEval.Variables[ExternalMacroStart+'PPWSrcPath']; + end else begin + Result:=''; + end; +end; + +function TDefineTree.GetDCUSrcPathForDirectory(const Directory: string + ): string; +var ExprEval: TExpressionEvaluator; +begin + ExprEval:=GetDefinesForDirectory(Directory); + if ExprEval<>nil then begin + Result:=ExprEval.Variables[ExternalMacroStart+'DCUSrcPath']; + end else begin + Result:=''; + end; +end; + function TDefineTree.GetDefinesForDirectory( const Path: string): TExpressionEvaluator; var ExpPath: string; @@ -1759,63 +1805,108 @@ begin end; function TDefinePool.CreateFPCTemplate( - const PPC386Path: string; + const PPC386Path, TestPascalFile: string; var UnitSearchPath: string): TDefineTemplate; -// create makro definitions for the freepascal compiler +// create symbol definitions for the freepascal compiler // To get reliable values the compiler itself is asked for +var + LastDefTempl: TDefineTemplate; + ShortTestFile: string; + + procedure AddTemplate(NewDefTempl: TDefineTemplate); + begin + if NewDefTempl=nil then exit; + if LastDefTempl<>nil then + NewDefTempl.InsertBehind(LastDefTempl); + LastDefTempl:=NewDefTempl; + end; + + function FindSymbol(const SymbolName: string): TDefineTemplate; + begin + Result:=LastDefTempl; + while (Result<>nil) + and (AnsiComparetext(Result.Variable,SymbolName)<>0) do + Result:=Result.Prior; + end; - procedure ProcessOutputLine(var LastDefTempl: TDefineTemplate; Line: string); + procedure DefineSymbol(const SymbolName, SymbolValue: string); var NewDefTempl: TDefineTemplate; - MacroName, MacroValue, UpLine: string; + begin + NewDefTempl:=FindSymbol(SymbolName); + if NewDefTempl=nil then begin + NewDefTempl:=TDefineTemplate.Create('Define '+SymbolName, + ctsDefaultppc386Symbol,SymbolName,'',da_DefineRecurse); + AddTemplate(NewDefTempl); + end else begin + NewDefTempl.Value:=SymbolValue; + end; + end; + + procedure UndefineSymbol(const SymbolName: string); + var + ADefTempl: TDefineTemplate; + begin + ADefTempl:=FindSymbol(SymbolName); + if ADefTempl=nil then exit; + if LastDefTempl=ADefTempl then LastDefTempl:=ADefTempl.Prior; + ADefTempl.Free; + end; + + procedure ProcessOutputLine(var Line: string); + var + SymbolName, SymbolValue, UpLine: string; i: integer; begin - NewDefTempl:=nil; UpLine:=UpperCaseStr(Line); + i:=length(ShortTestFile); + if (length(Line)>i) + and (AnsiCompareText(LeftStr(Line,i),ShortTestFile)=0) + and (Line[i+1]='(') then begin + inc(i); + while (i')') do inc(i); + inc(i); + while (i' ') do inc(i); - MacroName:=copy(UpLine,1,i-1); - inc(i); + SymbolName:=copy(UpLine,1,i-1); + inc(i); // skip '=' System.Delete(Line,1,i-1); System.Delete(UpLine,1,i-1); if copy(UpLine,1,7)='SET TO ' then begin - MacroValue:=copy(Line,8,length(Line)-7); - NewDefTempl:=TDefineTemplate.Create('Define '+MacroName, - ctsDefaultppc386Macro,MacroName,MacroValue,da_DefineRecurse); + SymbolValue:=copy(Line,8,length(Line)-7); + DefineSymbol(SymbolName,SymbolValue); end; end else if copy(UpLine,1,17)='USING UNIT PATH: ' then begin UnitSearchPath:=UnitSearchPath+copy(Line,18,length(Line)-17)+#13; end; - if NewDefTempl<>nil then begin - if LastDefTempl<>nil then - NewDefTempl.InsertBehind(LastDefTempl); - LastDefTempl:=NewDefTempl; - end; end; // function TDefinePool.CreateFPCTemplate( -// const PPC386Path: string): TDefineTemplate; -var CmdLine, BogusFilename: string; +// const PPC386Path: string): TDefineTemplate; +var CmdLine: string; i, OutLen, LineStart: integer; TheProcess : TProcess; OutputLine, Buf, TargetOS, SrcOS, TargetProcessor: String; - DefTempl, NewDefTempl: TDefineTemplate; + NewDefTempl: TDefineTemplate; begin Result:=nil; UnitSearchPath:=''; if (PPC386Path='') or (not FileIsExecutable(PPC386Path)) then exit; - DefTempl:=nil; + LastDefTempl:=nil; // find all initial compiler macros and all unit paths // -> ask compiler with the -va switch SetLength(Buf,1024); @@ -1823,11 +1914,8 @@ begin CmdLine:=PPC386Path+' -va '; if FileExists(EnglishErrorMsgFilename) then CmdLine:=CmdLine+'-Fr'+EnglishErrorMsgFilename+' '; - // give compiler a not existing file, so that it will return quickly - BogusFilename:='bogus'; - i:=1; - while FileExists(BogusFilename+IntToStr(i)+'.pp') do inc(i); - CmdLine:=CmdLine+BogusFilename+'.pp'; + CmdLine:=CmdLine+TestPascalFile; + ShortTestFile:=ExtractFileName(TestPascalFile); TheProcess := TProcess.Create(nil); TheProcess.CommandLine := CmdLine; @@ -1846,7 +1934,7 @@ begin while i<=OutLen do begin if Buf[i] in [#10,#13] then begin OutputLine:=OutputLine+copy(Buf,LineStart,i-LineStart); - ProcessOutputLine(DefTempl,OutputLine); + ProcessOutputLine(OutputLine); OutputLine:=''; if (iBuf[i+1]) then @@ -1882,9 +1970,7 @@ begin NewDefTempl:=TDefineTemplate.Create('Define TargetOS', ctsDefaultppc386TargetOperatingSystem, ExternalMacroStart+'TargetOS',TargetOS,da_DefineRecurse); - if DefTempl<>nil then - NewDefTempl.InsertBehind(DefTempl); - DefTempl:=NewDefTempl; + AddTemplate(NewDefTempl); if TargetOS='linux' then SrcOS:='unix' else @@ -1892,9 +1978,7 @@ begin NewDefTempl:=TDefineTemplate.Create('Define SrcOS', ctsDefaultppc386SourceOperatingSystem, ExternalMacroStart+'SrcOS',SrcOS,da_DefineRecurse); - if DefTempl<>nil then - NewDefTempl.InsertBehind(DefTempl); - DefTempl:=NewDefTempl; + AddTemplate(NewDefTempl); break; end; inc(i); @@ -1923,9 +2007,7 @@ begin ctsDefaultppc386TargetProcessor, ExternalMacroStart+'TargetProcessor',TargetProcessor, da_DefineRecurse); - if DefTempl<>nil then - NewDefTempl.InsertBehind(DefTempl); - DefTempl:=NewDefTempl; + AddTemplate(NewDefTempl); break; end; inc(i); @@ -1936,14 +2018,16 @@ begin end; // add - if (DefTempl<>nil) then begin - while (DefTempl.Prior<>nil) do DefTempl:=DefTempl.Prior; + if (LastDefTempl<>nil) then begin Result:=TDefineTemplate.Create('Free Pascal Compiler', ctsFreePascalCompilerInitialMacros,'','',da_Block); - Result.AddChild(DefTempl); + Result.AddChild(LastDefTempl.GetFirstSibling); Result.Flags:=[dtfAutoGenerated]; end; except + on E: Exception do begin + writeln('ERROR: TDefinePool.CreateFPCTemplate: ',E.Message); + end; end; end; diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index f3f76cc3f7..6788c21fb8 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -800,6 +800,7 @@ var CleanCursorPos: integer; if (CursorNode.Desc=ctnClass) and (CleanCursorPoscafPoint) then begin + // read rest + ParseAttr:=[pphIsMethod]; + if IsFunction then Include(ParseAttr,pphIsFunction); + ReadTilProcedureHeadEnd(ParseAttr,HasForwardModifier); + end else begin + // Method resolution clause (e.g. function Intf.Method = MethodName) + CurNode.Parent.Desc:=ctnMethodMap; + // read Method name of interface + ReadNextAtom; + AtomIsIdentifier(true); + // read '=' + ReadNextAtomIsChar('='); + // read implementing method name ReadNextAtom; AtomIsIdentifier(true); ReadNextAtom; + if CurPos.Flag<>cafSemicolon then + UndoReadNextAtom; end; - // read rest - ParseAttr:=[pphIsMethod]; - if IsFunction then Include(ParseAttr,pphIsFunction); - ReadTilProcedureHeadEnd(ParseAttr,HasForwardModifier); // close procedure header CurNode.EndPos:=CurPos.EndPos; EndChildNode; - // close procedure + // close procedure / method map CurNode.EndPos:=CurPos.EndPos; EndChildNode; Result:=true; @@ -1189,6 +1200,7 @@ function TPascalParserTool.ReadTilProcedureHeadEnd( destructor Destroy; override; class function X: integer; function QWidget_mouseGrabber(): QWidgetH; cdecl; + procedure Intf.Method = ImplementingMethodName; proc specifiers without parameters: stdcall, virtual, abstract, dynamic, overload, override, cdecl, inline diff --git a/ide/codetoolsdefines.pas b/ide/codetoolsdefines.pas index 3646e710f6..c3e819d1cc 100644 --- a/ide/codetoolsdefines.pas +++ b/ide/codetoolsdefines.pas @@ -47,7 +47,7 @@ uses Classes, SysUtils, LCLLinux, Forms, Controls, Buttons, StdCtrls, ComCtrls, ExtCtrls, Menus, LResources, Graphics, Dialogs, ImgList, SynEdit, Laz_XMLCfg, DefineTemplates, CodeToolManager, CodeToolsOptions, CodeToolsDefPreview, - TransferMacros, InputFileDialog, IDEOptionDefs; + TransferMacros, InputFileDialog, IDEOptionDefs, LazConf; type TCodeToolsDefinesEditor = class(TForm) @@ -707,7 +707,7 @@ procedure TCodeToolsDefinesEditor.InsertFPCProjectDefinesTemplateMenuItemClick( Sender: TObject); var InputFileDlg: TInputFileDialog; UnitSearchPath, UnitLinkList, DefaultFPCSrcDir, DefaultCompiler, - CompilerPath, FPCSrcDIr: string; + CompilerPath, FPCSrcDir: string; DirTemplate, FPCTemplate, FPCSrcTemplate: TDefineTemplate; begin InputFileDlg:=GetInputFileDialog; @@ -752,7 +752,7 @@ begin writeln(' CompilerPath="',CompilerPath,'"'); if (CompilerPath<>'') and (CompilerPath<>DefaultCompiler) then FPCTemplate:=Boss.DefinePool.CreateFPCTemplate(CompilerPath, - UnitSearchPath) + CreateCompilerTestPascalFilename,UnitSearchPath) else FPCTemplate:=nil; @@ -822,7 +822,8 @@ begin if Macros<>nil then Macros.SubstituteStr(CompilerPath); writeln(' CompilerPath="',CompilerPath,'"'); - FPCTemplate:=Boss.DefinePool.CreateFPCTemplate(CompilerPath,s); + FPCTemplate:=Boss.DefinePool.CreateFPCTemplate(CompilerPath, + CreateCompilerTestPascalFilename,s); if FPCTemplate=nil then exit; FPCTemplate.Name:='Free Pascal Compiler ('+CompilerPath+')'; InsertTemplate(FPCTemplate); @@ -865,7 +866,8 @@ begin if Macros<>nil then Macros.SubstituteStr(CompilerPath); writeln(' CompilerPath="',CompilerPath,'"'); - FPCTemplate:=Boss.DefinePool.CreateFPCTemplate(CompilerPath,UnitSearchPath); + FPCTemplate:=Boss.DefinePool.CreateFPCTemplate(CompilerPath, + CreateCompilerTestPascalFilename,UnitSearchPath); if FPCTemplate=nil then begin writeln('ERROR: unable to get FPC Compiler Macros from "',CompilerPath,'"'); exit;