paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 19:29:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: optimized HasRegster

Browse Source 
git-svn-id: trunk@44961 -
This commit is contained in:
mattias 2014-05-07 11:13:15 +00:00
parent b12bf358a7
commit eedad74e42
1 changed files with 25 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
components/codetools/stdcodetools.pas
View File

@ -326,7 +326,7 @@ type
out StartInStringConst, EndInStringConst: boolean): boolean;
// register procedure
function HasInterfaceRegisterProc(var HasRegisterProc: boolean): boolean;
function HasInterfaceRegisterProc(out HasRegisterProc: boolean): boolean;
// Delphi to Lazarus conversion
function ConvertDelphiToLazarusSource(AddLRSCode: boolean;
@ -3885,32 +3885,42 @@ begin
FormatParameters,StartInStringConst,EndInStringConst);
end;
function TStandardCodeTool.HasInterfaceRegisterProc(var HasRegisterProc: boolean
function TStandardCodeTool.HasInterfaceRegisterProc(out HasRegisterProc: boolean
): boolean;
function IsRegisterProc(ANode: TCodeTreeNode): boolean;
begin
Result:=false;
if ANode=nil then exit;
if ANode.Desc=ctnProcedureHead then
ANode:=Anode.Parent;
if (ANode.Desc<>ctnProcedure) then exit;
MoveCursorToNodeStart(ANode);
if not ReadNextUpAtomIs('PROCEDURE') then exit;
if not ReadNextUpAtomIs('REGISTER') then exit;
if CurPos.Flag<>cafSemicolon then exit;
HasRegisterProc:=true;
Result:=true;
end;
var
InterfaceNode: TCodeTreeNode;
ANode: TCodeTreeNode;
begin
Result:=false;
HasRegisterProc:=false;
BuildTree(lsrImplementationStart);
ANode:=FindDeclarationNodeInInterface('Register',true);
if ANode=nil then exit;
if IsRegisterProc(ANode) then
exit(true);
// there may be multiple register
InterfaceNode:=FindInterfaceNode;
if InterfaceNode=nil then exit;
ANode:=InterfaceNode.FirstChild;
while ANode<>nil do begin
if (ANode.Desc=ctnProcedure) then begin
MoveCursorToNodeStart(ANode);
if ReadNextUpAtomIs('PROCEDURE')
and ReadNextUpAtomIs('REGISTER')
and ReadNextAtomIsChar(';')
then begin
HasRegisterProc:=true;
break;
end;
end;
if IsRegisterProc(ANode) then
exit(true);
ANode:=ANode.NextBrother;
end;
Result:=true;
end;
function TStandardCodeTool.ConvertDelphiToLazarusSource(AddLRSCode: boolean;