paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 13:37:45 +02:00
Code Issues Packages Projects Releases Wiki Activity

method resolution clause, class ancestor find declaration, 1.1. makros

Browse Source 
git-svn-id: trunk@3716 -
This commit is contained in:
mattias 2002-12-20 11:08:47 +00:00
parent 306c9673f8
commit f8329f9fc6
7 changed files with 172 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/codetools/codetoolsstrconsts.pas
View File

@ -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';

2
components/codetools/codetree.pas
View File

@ -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';

192
components/codetools/definetemplates.pas
View File

@ -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<length(Line)) and (Line[i]<>')') do inc(i);
inc(i);
while (i<length(Line)) and (Line[i]=' ') do inc(i);
if (i<=length(Line)) then begin
System.Delete(Line,1,i-1);
System.Delete(UpLine,1,i-1);
end;
end;
if copy(UpLine,1,15)='MACRO DEFINED: ' then begin
MacroName:=copy(UpLine,16,length(Line)-15);
NewDefTempl:=TDefineTemplate.Create('Define '+MacroName,
ctsDefaultppc386Macro,MacroName,'',da_DefineRecurse);
end else if copy(UpLine,1,15)='MACRO UNDEFINED: ' then begin
MacroName:=copy(UpLine,16,length(Line)-15);
// ToDo: delete macro definition
SymbolName:=copy(UpLine,16,length(Line)-15);
DefineSymbol(SymbolName,'');
end else if copy(UpLine,1,17)='MACRO UNDEFINED: ' then begin
SymbolName:=copy(UpLine,18,length(Line)-17);
UndefineSymbol(SymbolName);
end else if copy(UpLine,1,6)='MACRO ' then begin
System.Delete(Line,1,6);
System.Delete(UpLine,1,6);
i:=1;
while (i<=length(Line)) and (Line[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 (i<OutLen) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[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;

1
components/codetools/finddeclarationtool.pas
View File

@ -800,6 +800,7 @@ var CleanCursorPos: integer;
if (CursorNode.Desc=ctnClass)
and (CleanCursorPos<ClassNode.FirstChild.StartPos) then begin
// identifier is an ancestor/interface identifier
CursorNode:=CursorNode.Parent;
DirectSearch:=true;
SkipChecks:=true;
end;

4
components/codetools/fpc.errore.msg
View File

@ -8,6 +8,9 @@ parser_m_macro_undefined=03102_M_Macro undefined: $1
parser_m_macro_set_to=03103_M_Macro $1 set to $2
% When \var{-vm} is used, the compiler tells you what values macros get.
general_d_defining_symbol=11037_D_Defining symbol: $1
general_d_undefining_symbol=11038_D_Undefining symbol: $1
general_t_exepath=01003_T_Using executable path: $1
% When the \var{-vt} switch is used, this line tells you where the compiler
% looks for it's binaries.
@ -26,5 +29,6 @@ general_t_objectpath=01007_T_Using object path: $1
% looks for object files you link in (files used in \var{\{\$L xxx\}} statements).
% You can set this path with the \var{-Fo} option.
# end.

26
components/codetools/pascalparsertool.pas
View File

@ -911,6 +911,7 @@ function TPascalParserTool.KeyWordFuncClassMethod: boolean;
destructor Destroy; override;
class function X: integer;
static function X: integer;
function Intf.Method = ImplementingMethodName;
proc specifiers without parameters:
stdcall, virtual, abstract, dynamic, overload, override, cdecl, inline
@ -942,20 +943,30 @@ begin
CurNode.Desc:=ctnProcedureHead;
CurNode.SubDesc:=ctnsNeedJITParsing;
ReadNextAtom;
if (CurPos.Flag=cafPoint) then begin
// first identifier was interface name
if (CurPos.Flag<>cafPoint) 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

12
ide/codetoolsdefines.pas
View File

@ -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;