paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-18 09:29:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: support class operator overloads with different result types. Issue #28875

Browse Source 
git-svn-id: trunk@51363 -
This commit is contained in:
ondrej 2016-01-21 02:41:14 +00:00
parent 579a1526dc
commit 139d5dc799
4 changed files with 71 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
components/codetools/codecompletiontool.pas
View File

@ -1564,6 +1564,7 @@ begin
+PtrUInt(SizeOf(FSetPropertyVariableIsPrefix))
+PtrUInt(SizeOf(FSetPropertyVariableUseConst))
+MemSizeString(FJumpToProcHead.Name)
+MemSizeString(FJumpToProcHead.ResultType)
+PtrUInt(SizeOf(FJumpToProcHead.Group))
+length(NewClassSectionIndent)*SizeOf(integer)
+length(NewClassSectionInsertPos)*SizeOf(integer)
@ -8615,6 +8616,7 @@ var
// remember one proc body to jump to after the completion
FJumpToProcHead.Name:=ANodeExt.Txt;
FJumpToProcHead.Group:=TPascalMethodGroup(ANodeExt.Flags);
FJumpToProcHead.ResultType:=ANodeExt.ExtTxt4;
if System.Pos('.',FJumpToProcHead.Name)<1 then
FJumpToProcHead.Name:=TheClassName+'.'+FJumpToProcHead.Name;
if FJumpToProcHead.Name[length(FJumpToProcHead.Name)]<>';' then
@ -8683,9 +8685,7 @@ var
if NextAVLNode<>nil then begin
ANodeExt:=TCodeTreeNodeExtension(AnAVLNode.Data);
ANodeExt2:=TCodeTreeNodeExtension(NextAVLNode.Data);
if SameMethodHeaders(ANodeExt.Txt, TPascalMethodGroup(ANodeExt.Flags),
ANodeExt2.Txt, TPascalMethodGroup(ANodeExt2.Flags))
then
if CompareCodeTreeNodeExtMethodHeaders(ANodeExt, ANodeExt2) = 0 then
begin
// proc redefined -> error
if ANodeExt.Node.StartPos>ANodeExt2.Node.StartPos then begin

8
components/codetools/codetree.pas
View File

@ -306,7 +306,7 @@ type
public
Node: TCodeTreeNode;
Txt: string;
ExtTxt1, ExtTxt2, ExtTxt3: string;
ExtTxt1, ExtTxt2, ExtTxt3, ExtTxt4: string;
Position: integer;
Data: Pointer;
Flags: cardinal;
@ -1078,6 +1078,7 @@ begin
ExtTxt1:='';
ExtTxt2:='';
ExtTxt3:='';
ExtTxt4:='';
Node:=nil;
Position:=-1;
Data:=nil;
@ -1103,7 +1104,7 @@ begin
DbgOut('Node=',NodeDescriptionAsString(Node.Desc))
else
DbgOut('Node=nil');
DbgOut(' Position=',dbgs(Position),' Txt="'+Txt+'" ExtTxt1="'+ExtTxt1+'" ExtTxt2="'+ExtTxt2+'" ExtTxt3="'+ExtTxt3+'"');
DbgOut(' Position=',dbgs(Position),' Txt="'+Txt+'" ExtTxt1="'+ExtTxt1+'" ExtTxt2="'+ExtTxt2+'" ExtTxt3="'+ExtTxt3+'" ExtTxt4="'+ExtTxt4+'"');
debugln;
end;
@ -1113,7 +1114,8 @@ begin
+MemSizeString(Txt)
+MemSizeString(ExtTxt1)
+MemSizeString(ExtTxt2)
+MemSizeString(ExtTxt3);
+MemSizeString(ExtTxt3)
+MemSizeString(ExtTxt4);
end;
end.

9
components/codetools/methodjumptool.pas
View File

@ -101,10 +101,9 @@ begin
AVLNode1:=Tree1.FindLowest;
AVLNode2:=Tree2.FindLowest;
while (AVLNode1<>nil) and (AVLNode2<>nil) do begin
cmp:=CompareTextIgnoringSpace(
TCodeTreeNodeExtension(AVLNode1.Data).Txt,
TCodeTreeNodeExtension(AVLNode2.Data).Txt,
false);
cmp:=CompareCodeTreeNodeExtMethodHeaders(
TCodeTreeNodeExtension(AVLNode1.Data),
TCodeTreeNodeExtension(AVLNode2.Data));
if cmp<0 then
AVLNode1:=Tree1.FindSuccessor(AVLNode1)
else if cmp>0 then
@ -826,6 +825,8 @@ begin
Node:=ANode;
Txt:=CurProcName;
Flags:=Ord(ExtractProcedureGroup(ANode));
if TPascalMethodGroup(Flags)=mgClassOperator then
ExtTxt4:=ExtractFuncResultType(ANode,Attr);
end;
Result.Add(NewNodeExt);
end;

75
components/codetools/pascalreadertool.pas
View File

@ -59,10 +59,10 @@ type
//the scope groups of pascal methods.
//please note that Destructor is principally a method and thus is not listed here -> you cannot define "procedure Destroy;" and "destructor Destroy" in one class
TPascalMethodGroup = (mgMethod, mgConstructor, mgClassConstructor, mgClassDestructor);
TPascalMethodGroup = (mgMethod, mgConstructor, mgClassConstructor, mgClassDestructor, mgClassOperator);
TPascalMethodHeader = record
Name: string;
Name, ResultType: string;
Group: TPascalMethodGroup;
end;
@ -159,6 +159,8 @@ type
function FindProcBody(ProcNode: TCodeTreeNode): TCodeTreeNode;
function ProcBodyIsEmpty(ProcNode: TCodeTreeNode): boolean;
function ExtractProcedureGroup(ProcNode: TCodeTreeNode): TPascalMethodGroup;
function ExtractFuncResultType(ProcNode: TCodeTreeNode;
Attr: TProcHeadAttributes): string;
procedure MoveCursorToFirstProcSpecifier(ProcNode: TCodeTreeNode);
function MoveCursorToProcSpecifier(ProcNode: TCodeTreeNode;
ProcSpec: TProcedureSpecifier): boolean;
@ -294,37 +296,47 @@ type
procedure CalcMemSize(Stats: TCTMemStats); override;
end;
function CompareMethodHeaders(const Method1Name: string; Method1Group: TPascalMethodGroup;
const Method2Name: string; Method2Group: TPascalMethodGroup): Integer; overload;
function CompareMethodHeaders(
const Method1Name: string; Method1Group: TPascalMethodGroup; const Method1ResultType: string;
const Method2Name: string; Method2Group: TPascalMethodGroup; const Method2ResultType: string): Integer; overload;
function CompareMethodHeaders(const Method1Head: TPascalMethodHeader; const Method2Head: TPascalMethodHeader): Integer; overload;
function SameMethodHeaders(const Method1Name: string; Method1Group: TPascalMethodGroup;
const Method2Name: string; Method2Group: TPascalMethodGroup): Boolean; overload;
function SameMethodHeaders(
const Method1Name: string; Method1Group: TPascalMethodGroup; const Method1ResultType: string;
const Method2Name: string; Method2Group: TPascalMethodGroup; const Method2ResultType: string): Boolean; overload;
function SameMethodHeaders(const Method1Head: TPascalMethodHeader; const Method2Head: TPascalMethodHeader): Boolean; overload;
function CompareCodeTreeNodeExtMethodHeaders(NodeData1, NodeData2: pointer): integer;
implementation
function CompareMethodHeaders(const Method1Name: string;
Method1Group: TPascalMethodGroup; const Method2Name: string;
Method2Group: TPascalMethodGroup): Integer;
Method1Group: TPascalMethodGroup; const Method1ResultType: string;
const Method2Name: string; Method2Group: TPascalMethodGroup;
const Method2ResultType: string): Integer;
begin
Result := (Ord(Method1Group) - Ord(Method2Group));
if Result <> 0 then exit;
Result := CompareTextIgnoringSpace(Method1Name,Method2Name,false);
if Result <> 0 then exit;
if Method1Group=mgClassOperator then
Result := CompareTextIgnoringSpace(Method1ResultType,Method2ResultType,false);
end;
function CompareMethodHeaders(const Method1Head: TPascalMethodHeader;
const Method2Head: TPascalMethodHeader): Integer;
begin
Result := CompareMethodHeaders(Method1Head.Name, Method1Head.Group,
Method2Head.Name, Method2Head.Group);
Result := CompareMethodHeaders(
Method1Head.Name, Method1Head.Group, Method1Head.ResultType,
Method2Head.Name, Method2Head.Group, Method2Head.ResultType);
end;
function SameMethodHeaders(const Method1Name: string;
Method1Group: TPascalMethodGroup; const Method2Name: string;
Method2Group: TPascalMethodGroup): Boolean;
Method1Group: TPascalMethodGroup; const Method1ResultType: string;
const Method2Name: string; Method2Group: TPascalMethodGroup;
const Method2ResultType: string): Boolean;
begin
Result := CompareMethodHeaders(Method1Name, Method1Group, Method2Name, Method2Group) = 0;
Result := CompareMethodHeaders(
Method1Name, Method1Group, Method1ResultType,
Method2Name, Method2Group, Method2ResultType) = 0;
end;
function SameMethodHeaders(const Method1Head: TPascalMethodHeader;
@ -338,7 +350,9 @@ var
NodeExt1: TCodeTreeNodeExtension absolute NodeData1;
NodeExt2: TCodeTreeNodeExtension absolute NodeData2;
begin
Result:=CompareMethodHeaders(NodeExt1.Txt,TPascalMethodGroup(NodeExt1.Flags),NodeExt2.Txt,TPascalMethodGroup(NodeExt2.Flags));
Result := CompareMethodHeaders(
NodeExt1.Txt,TPascalMethodGroup(NodeExt1.Flags),NodeExt1.ExtTxt4,
NodeExt2.Txt,TPascalMethodGroup(NodeExt2.Flags),NodeExt2.ExtTxt4);
end;
@ -745,6 +759,8 @@ function TPascalReaderTool.ExtractProcHeadWithGroup(ProcNode: TCodeTreeNode;
begin
Result.Name := ExtractProcHead(ProcNode, Attr);
Result.Group := ExtractProcedureGroup(ProcNode);
if Result.Group=mgClassOperator then
Result.ResultType := ExtractFuncResultType(ProcNode, Attr);
end;
function TPascalReaderTool.ExtractProcedureHeader(CursorPos: TCodeXYPosition;
@ -2539,9 +2555,11 @@ begin
begin
ReadNextAtom;
if UpAtomIs('CONSTRUCTOR') then
Result := mgClassConstructor;
if UpAtomIs('DESTRUCTOR') then
Result := mgClassDestructor;
Result := mgClassConstructor
else if UpAtomIs('DESTRUCTOR') then
Result := mgClassDestructor
else if UpAtomIs('OPERATOR') then
Result := mgClassOperator;
end else
if UpAtomIs('CONSTRUCTOR') then
Result := mgConstructor
@ -2772,6 +2790,29 @@ begin
Result:=GetIdentifier(@Src[TypeNode.StartPos]);
end;
function TPascalReaderTool.ExtractFuncResultType(ProcNode: TCodeTreeNode;
Attr: TProcHeadAttributes): string;
begin
Result := '';
if (ProcNode=nil) then exit;
if ProcNode.Desc=ctnProcedure then
ProcNode:=ProcNode.FirstChild;
if (ProcNode=nil) or(ProcNode.Desc<>ctnProcedureHead) then
Exit;
MoveCursorToCleanPos(ProcNode.EndPos);
CurNode:=ProcNode;
ReadPriorAtom;
if CurPos.Flag<>cafSemicolon then
Exit;
ReadPriorAtom;
if CurPos.Flag<>cafWord then
Exit;
if phpInUpperCase in Attr then
Result := GetUpAtom
else
Result := GetAtom;
end;
function TPascalReaderTool.ExtractDefinitionName(DefinitionNode: TCodeTreeNode
): string;
begin