codetools: ctnReferencTo for typeinfo, code hints and type check

git-svn-id: trunk@54642 -

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:

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;

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;
+    if Node.Desc=ctnReferenceTo then begin
-    ProcHeadNode:=AFindContext.Node.FirstChild;
+      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;

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),'"');

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

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
+        if not IsReferenceTo then begin
-          ReadNextAtom;
+          if UpAtomIs('IS') then begin
-          if not UpAtomIs('NESTED') then
+            ReadNextAtom;
-            SaveRaiseStringExpectedButAtomFound('nested');
+            if not UpAtomIs('NESTED') then
-        end else if UpAtomIs('OF') then begin
+              SaveRaiseStringExpectedButAtomFound('nested');
-          ReadNextAtom;
+          end else if UpAtomIs('OF') then begin
-          if not UpAtomIs('OBJECT') then
+            ReadNextAtom;
-            SaveRaiseStringExpectedButAtomFound('object');
+            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

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
+      MoveCursorToFirstProcSpecifier(Node);
-        Node:=Node.FirstChild;
+      // ToDo:
-        if Node=nil then exit;
+    end;
-      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;

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