diff --git a/components/codetools/codecompletiontool.pas b/components/codetools/codecompletiontool.pas index a0f8729086..a1c0fe18af 100644 --- a/components/codetools/codecompletiontool.pas +++ b/components/codetools/codecompletiontool.pas @@ -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: diff --git a/components/codetools/codetree.pas b/components/codetools/codetree.pas index 1b23156d2b..47687cd3dc 100644 --- a/components/codetools/codetree.pas +++ b/components/codetools/codetree.pas @@ -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; diff --git a/components/codetools/eventcodetool.pas b/components/codetools/eventcodetool.pas index ddb7db4235..35f543cb68 100644 --- a/components/codetools/eventcodetool.pas +++ b/components/codetools/eventcodetool.pas @@ -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; diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index f2fdaa3055..b33e9bedb5 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -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),'"'); diff --git a/components/codetools/identcompletiontool.pas b/components/codetools/identcompletiontool.pas index d044ac3c2c..94d383cf0f 100644 --- a/components/codetools/identcompletiontool.pas +++ b/components/codetools/identcompletiontool.pas @@ -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 diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index 3e898d1019..5fa636f076 100644 --- a/components/codetools/pascalparsertool.pas +++ b/components/codetools/pascalparsertool.pas @@ -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 diff --git a/components/codetools/pascalreadertool.pas b/components/codetools/pascalreadertool.pas index 154c899b68..30a14ef1a5 100644 --- a/components/codetools/pascalreadertool.pas +++ b/components/codetools/pascalreadertool.pas @@ -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; diff --git a/ide/codecontextform.pas b/ide/codecontextform.pas index a430c097f0..ac226ca5ae 100644 --- a/ide/codecontextform.pas +++ b/ide/codecontextform.pas @@ -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