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

codetool: fixed find declaration of pointer type to type behind, issue #31320

Browse Source
This commit is contained in:
mattias 2025-01-23 13:25:23 +01:00
parent a48730d17a
commit b30984ef03
3 changed files with 37 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
components/codetools/finddeclarationtool.pas
View File

@ -9574,6 +9574,22 @@ var
Result:=FlagCanBeForwardDefined;
end;
function FindPointedTypeBehind(PointerTypeNode: TCodeTreeNode): TCodeTreeNode;
var
IdentNode, Node: TCodeTreeNode;
begin
IdentNode:=PointerTypeNode.FirstChild;
Node:=PointerTypeNode.Parent.NextBrother;
while Node<>nil do begin
if (Node.Desc=ctnTypeDefinition)
and CompareSrcIdentifiers(Node.StartPos, IdentNode.StartPos)
then
exit(Node);
Node:=Node.NextBrother; // all remaing types of current type section
end;
Result:=nil;
end;
procedure ResolveTypeLessProperty;
begin
if ExprType.Desc<>xtContext then exit;
@ -9930,7 +9946,7 @@ var
if Find(Identifier) then exit(true);
Params.Load(OldInput,false);
end;
procedure ResolveIdentifier;
var
ProcNode: TCodeTreeNode;
@ -10087,6 +10103,16 @@ var
end;
end;
end;
end else if (StartNode.Parent<>nil)
and (StartNode.Parent.Desc=ctnPointerType) and (NextAtomType<>vatPoint) then
begin
Node:=FindPointedTypeBehind(StartNode.Parent);
if Node<>nil then begin
ExprType.Context.Tool:=Self;
ExprType.Context.Node:=Node;
ExprType.Desc:=xtContext;
exit;
end;
end;
end;
// find identifier
@ -10455,25 +10481,9 @@ var
ExprType.Context.Tool:=Self;
ExprType.Context.Node:=StartNode;
end;
procedure ResolveUp;
var NodeBehind: TCodeTreeNode;
function HasPointedTypeBehind: TCodeTreeNode;
var Node, pNode: TCodeTreeNode;
begin
Result:=nil;
pNode:=ExprType.Context.Node;//ctnPointerType
Node:=pNode.Parent.NextBrother;
while Node<>nil do begin
if (Node.Desc=ctnTypeDefinition)
and CompareSrcIdentifiers(Node.StartPos, pNode.FirstChild{Identifier}.StartPos)
then
exit(Node);
Node:=Node.NextBrother; // all remaing types of current type section
end;
end;
var NodeBehind, PointerTypeNode: TCodeTreeNode;
begin
// for example:
// 1. 'PInt = ^integer' pointer type
@ -10505,14 +10515,15 @@ var
ReadNextAtom;
RaisePointNotFound(20191003163249);
end;
if (ExprType.Context.Node=nil)
or (ExprType.Context.Node.Desc<>ctnPointerType) then begin
PointerTypeNode:=ExprType.Context.Node;
if (PointerTypeNode=nil)
or (PointerTypeNode.Desc<>ctnPointerType) then begin
MoveCursorToCleanPos(CurAtom.StartPos);
RaiseExceptionFmt(20170421200550,ctsIllegalQualifier,['^']);
end;
ExprType.Desc:=xtContext;
//first try if this node has a pointed type behind
NodeBehind:=HasPointedTypeBehind;
NodeBehind:=FindPointedTypeBehind(PointerTypeNode);
if NodeBehind=nil then
ExprType.Context.Node:=ExprType.Context.Node.FirstChild
else

6
components/codetools/pascalreadertool.pas
View File

@ -271,10 +271,10 @@ type
function GetFirstGroupVarNode(VarNode: TCodeTreeNode): TCodeTreeNode;
function NodeIsIdentifierInInterface(Node: TCodeTreeNode): boolean;
function NodeCanHaveForwardType(TypeNode: TCodeTreeNode): boolean;
function NodeIsForwardType(TypeNode: TCodeTreeNode): boolean;
function NodeIsForwardType(TypeNode: TCodeTreeNode): boolean; // forward class/interface/object, not pointer
function FindForwardTypeNode(TypeNode: TCodeTreeNode;
SearchFirst: boolean): TCodeTreeNode;
function FindTypeOfForwardNode(TypeNode: TCodeTreeNode): TCodeTreeNode;
SearchFirst: boolean): TCodeTreeNode; // find for a type the forward type node
function FindTypeOfForwardNode(TypeNode: TCodeTreeNode): TCodeTreeNode; // find the forward type for a type node
function FindEndOfWithExpr(WithVarNode: TCodeTreeNode): integer;
function ExtractWithBlockExpression(WithVarNode: TCodeTreeNode; Attr: TProcHeadAttributes = []): string;
function FindWithBlockStatement(WithVarNode: TCodeTreeNode): TCodeTreeNode;

2
components/codetools/tests/testfinddeclaration.pas
View File

@ -1424,7 +1424,7 @@ begin
Add([
'uses unit2;',
'type',
' PBird = ^TBird;',
' PBird = ^TBird{declaration:test1.tbird};',
' [attr]',
' TBird = record',
' Speed: word;',