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

codetools: ctnReferencTo for typeinfo, code hints and type check

Browse Source 
git-svn-id: branches/fixes_1_8@54643 -
This commit is contained in:
mattias 2017-04-19 11:50:18 +00:00
parent 27937b0e13
commit ea419c75ef
8 changed files with 78 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
components/codetools/codecompletiontool.pas
View File

@ -2059,7 +2059,8 @@ function TCodeCompletionCodeTool.CompleteEventAssignment(CleanCursorPos,
Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers];
ProcContext:=PropVarContext.Tool.FindBaseTypeOfNode(
Params,PropVarContext.Node);
if (ProcContext.Node=nil) or (ProcContext.Node.Desc<>ctnProcedureType)
if (ProcContext.Node=nil)
or not (ProcContext.Node.Desc in AllProcTypes)
then begin
{$IFDEF CTDEBUG}
DebugLn('FindEventTypeAtCursor not a procedure type');
@ -2591,7 +2592,7 @@ begin
TypeNode:=ExprType.Context.Node;
if HasAtOperator
or ((Scanner.CompilerMode=cmDelphi) and (ExprType.Desc=xtContext) // procedures in delphi mode without @
and (TypeNode<>nil) and (TypeNode.Desc=ctnProcedureType)) then
and (TypeNode<>nil) and (TypeNode.Desc in AllProcTypes)) then
begin
debugln(['TCodeCompletionCodeTool.CompleteLocalIdentifierByParameter HasAtOperator ExprType=',ExprTypeToString(ExprType)]);
NewType:='';
@ -2617,7 +2618,7 @@ begin
@AliasType);
//debugln(['TCodeCompletionCodeTool.CompleteLocalIdentifierByParameter parameter is pointer to type: AliasType=',FindContextToString(AliasType)]);
end;
end else if TypeNode.Desc=ctnProcedureType then begin
end else if TypeNode.Desc in AllProcTypes then begin
// for example TNotifyEvent = procedure(...
if TypeTool.ProcNodeHasOfObject(TypeNode) then begin
AddMethod(Identifier,TypeTool,TypeNode);
@ -6379,7 +6380,7 @@ begin
AddAssignment('nil');
ctnPointerType:
AddAssignment('nil');
ctnProcedureType:
ctnProcedureType,ctnReferenceTo:
// address of proc
AddAssignment('nil');
ctnProcedureHead:

10
components/codetools/codetree.pas
View File

@ -147,7 +147,7 @@ const
ctnGenericParams = 94; // parent = ctnGenericType, children = ctnGenericParameter
ctnGenericParameter = 95; // can has a child ctnGenericConstraint
ctnGenericConstraint = 96; // parent = ctnGenericParameter
ctnReferenceTo = 97; // 1st child = ctnProcedure
ctnReferenceTo = 97; // 1st child = ctnProcedureType
ctnConstant = 98;
ctnHintModifier = 99; // deprecated, platform, unimplemented, library, experimental
@ -192,9 +192,11 @@ const
[ctnGenericType,ctnSpecialize,
ctnIdentifier,ctnOpenArrayType,ctnRangedArrayType,
ctnRecordCase,ctnRecordVariant,
ctnProcedureType,ctnSetType,ctnRangeType,ctnEnumerationType,
ctnProcedureType,ctnReferenceTo,
ctnSetType,ctnRangeType,ctnEnumerationType,
ctnEnumIdentifier,ctnLabel,ctnTypeType,ctnFileType,ctnPointerType,
ctnClassOfType,ctnVariantType,ctnConstant];
AllProcTypes = [ctnProcedureType,ctnReferenceTo];
AllPascalStatements = [ctnBeginBlock,ctnWithStatement,ctnWithVariable,
ctnOnBlock,ctnOnIdentifier,ctnOnStatement,
ctnInitialization,ctnFinalization];
@ -266,7 +268,7 @@ type
function HasParentOfType(ParentDesc: TCodeTreeNodeDesc): boolean;
function HasAsRoot(RootNode: TCodeTreeNode): boolean;
function GetNodeOfType(ADesc: TCodeTreeNodeDesc): TCodeTreeNode;
function GetNodeOfTypes(Descriptors: array of TCodeTreeNodeDesc): TCodeTreeNode;
function GetNodeOfTypes(const Descriptors: array of TCodeTreeNodeDesc): TCodeTreeNode;
function GetTopMostNodeOfType(ADesc: TCodeTreeNodeDesc): TCodeTreeNode;
function GetFindContextParent: TCodeTreeNode;
function GetLevel: integer;
@ -833,7 +835,7 @@ begin
Result:=Result.Parent;
end;
function TCodeTreeNode.GetNodeOfTypes(Descriptors: array of TCodeTreeNodeDesc
function TCodeTreeNode.GetNodeOfTypes(const Descriptors: array of TCodeTreeNodeDesc
): TCodeTreeNode;
var
i: Integer;

13
components/codetools/eventcodetool.pas
View File

@ -583,7 +583,7 @@ begin
TypeContext.Tool.MoveCursorToNodeStart(TypeContext.Node);
TypeContext.Tool.RaiseException(ctsMethodTypeDefinitionNotFound);
end;
if Result.Node.Desc<>ctnProcedureType then begin
if not (Result.Node.Desc in AllProcTypes) then begin
TypeContext.Tool.MoveCursorToNodeStart(TypeContext.Node);
TypeContext.Tool.RaiseException(Format(ctsExpectedAMethodTypeButFound, [
Result.Node.DescAsString]));
@ -845,13 +845,18 @@ function TEventsCodeTool.CreateMethod(ClassNode: TCodeTreeNode;
Node: TCodeTreeNode;
ParamNode: TCodeTreeNode;
begin
Node:=AFindContext.Node;
MethodUnitName:=AFindContext.Tool.GetSourceName(false);
AddNeededUnitToMainUsesSection(PChar(MethodUnitName));
// search every parameter type and collect units
if not (AFindContext.Tool is TCodeCompletionCodeTool) then exit;
if not (AFindContext.Node.Desc in [ctnProcedureType,ctnProcedure]) then exit;
ProcHeadNode:=AFindContext.Node.FirstChild;
if Node.Desc=ctnReferenceTo then begin
Node:=Node.FirstChild;
if Node=nil then exit;
end;
if not (Node.Desc in [ctnProcedureType,ctnProcedure]) then exit;
ProcHeadNode:=Node.FirstChild;
if (ProcHeadNode=nil) or (ProcHeadNode.Desc<>ctnProcedureHead) then exit;
if ProcHeadNode.FirstChild=nil then
AFindContext.Tool.BuildSubTreeForProcHead(ProcHeadNode);
@ -1166,7 +1171,7 @@ begin
exit;
end else begin
if not FindTypeOfInstanceProperty(Instance,PropName,TypeContext,true) then exit;
if TypeContext.Node.Desc<>ctnProcedureType then begin
if not (TypeContext.Node.Desc in AllProcTypes) then begin
debugln(['TEventsCodeTool.CreateExprListFromPropertyInfo property '+DbgSName(Instance)+'.'+PropName+' is not method: ',TypeContext.Node.DescAsString]);
exit;
end;

8
components/codetools/finddeclarationtool.pas
View File

@ -10419,6 +10419,10 @@ begin
{$IFDEF CheckNodeTool}CheckNodeTool(Node);{$ENDIF}
Result:=Node;
if Result=nil then exit;
if Result.Desc=ctnReferenceTo then begin
Result:=Result.FirstChild;
if Result=nil then exit;
end;
if (Result.Desc in [ctnProperty,ctnGlobalProperty]) then
Result:=Result.FirstChild
else if Result.Desc in [ctnProcedure,ctnProcedureHead,ctnProcedureType] then begin
@ -11433,6 +11437,10 @@ begin
{$IFDEF CheckNodeTool}CheckNodeTool(Node);{$ENDIF}
Result:=nil;
if Node=nil then exit;
if Node.Desc=ctnReferenceTo then begin
Node:=Node.FirstChild;
if Node=nil then exit;
end;
if Node.Desc in [ctnProcedure,ctnProcedureType] then begin
ProcNode:=Node;
//DebugLn(' FindNthParameterNode ProcNode="',copy(Params.NewCodeTool.Src,ProcNode.StartPos,ProcNode.EndPos-ProcNode.StartPos),'"');

7
components/codetools/identcompletiontool.pas
View File

@ -2190,7 +2190,7 @@ begin
case FoundContext.Node.Desc of
ctnProcedure:
begin
//DebugLn('TIdentCompletionTool.CollectAllContexts CurrentContexts.ProcNameAtom.StartPos=',dbgs(CurrentIdentifierContexts.ProcNameAtom.StartPos));
//DebugLn('TIdentCompletionTool.CollectAllContexts Found Proc CurrentContexts.ProcNameAtom.StartPos=',dbgs(CurrentIdentifierContexts.ProcNameAtom.StartPos));
if (CurrentIdentifierContexts.ProcName='') then exit;
FoundContext.Tool.MoveCursorToProcName(FoundContext.Node,true);
//DebugLn(['TIdentCompletionTool.CollectAllContexts ProcName=',GetIdentifier(@FoundContext.Tool.Src[FoundContext.Tool.CurPos.StartPos])]);
@ -2201,7 +2201,7 @@ begin
// method without 'overload' hides inherited one
if not FoundContext.Tool.ProcNodeHasSpecifier(FoundContext.Node, psOVERLOAD) then
Exclude(Params.Flags, fdfSearchInAncestors);
end else exit
end else exit;
end;
ctnProperty,ctnGlobalProperty:
begin
@ -3156,7 +3156,8 @@ begin
if IdentEndPos=0 then ;
// find class and ancestors if existing (needed for protected identifiers)
FindContextClassAndAncestorsAndExtendedClassOfHelper(CursorPos,FICTClassAndAncestorsAndExtClassOfHelper);
FindContextClassAndAncestorsAndExtendedClassOfHelper(CursorPos,
FICTClassAndAncestorsAndExtClassOfHelper);
if CursorNode<>nil then begin
if not CheckContextIsParameter(Result) then begin

32
components/codetools/pascalparsertool.pas
View File

@ -4564,8 +4564,9 @@ function TPascalParserTool.KeyWordFuncTypeProc: boolean;
function(ParmList):SimpleType of object;
procedure; cdecl; popstack; register; pascal; stdcall;
}
var IsFunction, EqualFound: boolean;
var IsFunction, EqualFound, IsReferenceTo: boolean;
begin
IsReferenceTo:=CurNode.Desc=ctnReferenceTo;
IsFunction:=UpAtomIs('FUNCTION');
CreateChildNode;
CurNode.Desc:=ctnProcedureType;
@ -4591,7 +4592,7 @@ begin
SaveRaiseCharExpectedButAtomFound(':');
end;
end;
if UpAtomIs('OF') then begin
if (not IsReferenceTo) and UpAtomIs('OF') then begin
if not ReadNextUpAtomIs('OBJECT') then
SaveRaiseStringExpectedButAtomFound('"object"');
ReadNextAtom;
@ -4616,14 +4617,16 @@ begin
UndoReadNextAtom;
break;
end;
if UpAtomIs('IS') then begin
ReadNextAtom;
if not UpAtomIs('NESTED') then
SaveRaiseStringExpectedButAtomFound('nested');
end else if UpAtomIs('OF') then begin
ReadNextAtom;
if not UpAtomIs('OBJECT') then
SaveRaiseStringExpectedButAtomFound('object');
if not IsReferenceTo then begin
if UpAtomIs('IS') then begin
ReadNextAtom;
if not UpAtomIs('NESTED') then
SaveRaiseStringExpectedButAtomFound('nested');
end else if UpAtomIs('OF') then begin
ReadNextAtom;
if not UpAtomIs('OBJECT') then
SaveRaiseStringExpectedButAtomFound('object');
end;
end;
ReadNextAtom;
if CurPos.Flag<>cafSemicolon then begin
@ -5793,8 +5796,11 @@ var
ProcHeadNode: TCodeTreeNode;
begin
if ProcNode.Desc=ctnProcedureHead then ProcNode:=ProcNode.Parent;
if ProcNode.Desc=ctnMethodMap then begin
if ProcNode.Desc=ctnMethodMap then
exit;
if ProcNode.Desc=ctnReferenceTo then begin
ProcNode:=ProcNode.FirstChild;
if ProcNode=nil then exit;
end;
if (not (ProcNode.Desc in [ctnProcedure,ctnProcedureType])) then begin
{$IFDEF CheckNodeTool}
@ -5871,10 +5877,6 @@ end;
procedure TPascalParserTool.BuildSubTreeForProcHead(ProcNode: TCodeTreeNode;
out FunctionResult: TCodeTreeNode);
begin
if ProcNode.Desc=ctnProcedureHead then
ProcNode:=ProcNode.Parent;
if not(ProcNode.Desc in [ctnProcedure,ctnProcedureType]) then
RaiseException('INTERNAL ERROR: TPascalParserTool.BuildSubTreeForProcHead with FunctionResult');
BuildSubTreeForProcHead(ProcNode);
FunctionResult:=ProcNode.FirstChild.FirstChild;
if (FunctionResult<>nil) and (FunctionResult.Desc=ctnParameterList) then

31
components/codetools/pascalreadertool.pas
View File

@ -1872,12 +1872,26 @@ begin
while IsHintModifier do ReadNextAtom;
end;
ctnProcedure,ctnProcedureType,ctnProcedureHead:
ctnProcedureHead:
begin
if Node.Desc<>ctnProcedureHead then begin
Node:=Node.FirstChild;
if Node=nil then exit;
end;
MoveCursorToFirstProcSpecifier(Node);
// ToDo:
end;
ctnProcedure,ctnProcedureType:
begin
Node:=Node.FirstChild;
if Node=nil then exit;
MoveCursorToFirstProcSpecifier(Node);
// ToDo:
end;
ctnReferenceTo:
begin
Node:=Node.FirstChild;
if (Node=nil) or (Node.Desc<>ctnProcedureType) then exit;
Node:=Node.FirstChild;
if Node=nil then exit;
MoveCursorToFirstProcSpecifier(Node);
// ToDo:
end;
@ -3278,7 +3292,12 @@ begin
// ToDo: ppu, dcu
Result:=false;
if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedureType) then exit;
if ProcNode=nil then exit;
if ProcNode.Desc=ctnReferenceTo then begin
ProcNode:=ProcNode.FirstChild;
if ProcNode=nil then exit;
end;
if ProcNode.Desc<>ctnProcedureType then exit;
MoveCursorToFirstProcSpecifier(ProcNode);
Result:=UpAtomIs('OF') and ReadNextUpAtomIs('OBJECT');
end;

5
ide/codecontextform.pas
View File

@ -388,10 +388,13 @@ procedure TCodeContextFrm.CreateHints(const CodeContexts: TCodeContextInfo);
try
try
Expr:=Tool.ConvertNodeToExpressionType(Node,Params);
//debugln(['FindBaseType ',s,' ',ExprTypeToString(Expr)]);
if (Expr.Desc=xtContext) and (Expr.Context.Node<>nil) then begin
ExprTool:=Expr.Context.Tool;
ExprNode:=Expr.Context.Node;
if ExprNode.Desc=ctnReferenceTo then begin
ExprNode:=ExprNode.FirstChild;
if ExprNode=nil then exit;
end;
case ExprNode.Desc of
ctnProcedureType:
begin