fcl-passrc: resolver: typecast procvar and pointer

git-svn-id: trunk@35808 -

packages/fcl-passrc/src/pasresolver.pp

@@ -131,6 +131,8 @@ Works:
 - built-in functions pred, succ for range type and enums
 - untyped parameters
 - built-in procedure str(const boolean|integer|enumvalue|classinstance,var s: string)
+- pointer TPasPointerType
+  - nil, assigned(), typecast, class, classref, dynarray, procvar
 
 ToDo:
 - fix slow lookup declaration proc in PParser
@@ -141,7 +143,6 @@ ToDo:
    - nested types
 - check if constant is longint or int64
 - for..in..do
-- pointer TPasPointerType
 - records - TPasRecordType,
    - const  TRecordValues
    - function default(record type): record
@@ -253,6 +254,7 @@ const
   nSymbolCannotBePublished = 3053;
   nCannotTypecastAType = 3054;
   nTypeIdentifierExpected = 3055;
+  nCannotNestAnonymousX = 3056;
 
 // resourcestring patterns of messages
 resourcestring
@@ -311,6 +313,7 @@ resourcestring
   sSymbolCannotBePublished = 'Symbol cannot be published';
   sCannotTypecastAType = 'Cannot type cast a type';
   sTypeIdentifierExpected = 'Type identifier expected';
+  sCannotNestAnonymousX = 'Cannot nest anonymous %s';
 
 type
   TResolverBaseType = (
@@ -964,7 +967,8 @@ type
     proClassOfIs, // class-of supports is and as operator
     proExtClassInstanceNoTypeMembers, // class members of external class cannot be accessed by instance
     proOpenAsDynArrays, // open arrays work like dynamic arrays
-    proProcTypeWithoutIsNested // proc types can use nested procs without 'is nested'
+    proProcTypeWithoutIsNested, // proc types can use nested procs without 'is nested'
+    proMethodAddrAsPointer  // can assign @method to a pointer
     );
   TPasResolverOptions = set of TPasResolverOption;
 
@@ -976,7 +980,7 @@ type
       TResolveDataListKind = (lkBuiltIn,lkModule);
     procedure ClearResolveDataList(Kind: TResolveDataListKind);
   private
-    FAnonymousEnumtypePostfix: String;
+    FAnonymousElTypePostfix: String;
     FBaseTypes: array[TResolverBaseType] of TPasUnresolvedSymbolRef;
     FBaseTypeStringIndex: TResolverBaseType;
     FDefaultScope: TPasDefaultScope;
@@ -1090,6 +1094,7 @@ type
     procedure FinishTypeDef(El: TPasType); virtual;
     procedure FinishEnumType(El: TPasEnumType); virtual;
     procedure FinishSetType(El: TPasSetType); virtual;
+    procedure FinishSubElementType(Parent, El: TPasElement); virtual;
     procedure FinishRangeType(El: TPasRangeType); virtual;
     procedure FinishRecordType(El: TPasRecordType); virtual;
     procedure FinishClassType(El: TPasClassType); virtual;
@@ -1411,8 +1416,8 @@ type
     property Options: TPasResolverOptions read FOptions write FOptions;
     property ScopeClass_Class: TPasClassScopeClass read FScopeClass_Class write FScopeClass_Class;
     property ScopeClass_WithExpr: TPasWithExprScopeClass read FScopeClass_WithExpr write FScopeClass_WithExpr;
-    property AnonymousEnumtypePostfix: String read FAnonymousEnumtypePostfix
-      write FAnonymousEnumtypePostfix; // default empty, if set, anonymous enumtypes are named SetName+Postfix and add to declarations
+    property AnonymousElTypePostfix: String read FAnonymousElTypePostfix
+      write FAnonymousElTypePostfix; // default empty, if set, anonymous element types are named ArrayName+Postfix and added to declarations
   end;
 
 function GetObjName(o: TObject): string;
@@ -1421,6 +1426,7 @@ function GetTypeDesc(aType: TPasType; AddPath: boolean = false): string;
 function GetTreeDesc(El: TPasElement; Indent: integer = 0): string;
 function GetResolverResultDesc(const T: TPasResolverResult): string;
 function GetResolverResultDescription(const T: TPasResolverResult; OnlyType: boolean = false): string;
+function GetResolverResultDbg(const T: TPasResolverResult): string;
 function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string;
 procedure SetResolverIdentifier(out ResolvedType: TPasResolverResult;
   BaseType: TResolverBaseType; IdentEl: TPasElement;
@@ -1482,9 +1488,9 @@ begin
     Result:=Result+')';
     end;
   if ProcType.IsOfObject then
-    Result:=Result+' of object';
+    Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
   if ProcType.IsNested then
-    Result:=Result+' is nested';
+    Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
   if cCallingConventions[ProcType.CallingConvention]<>'' then
     Result:=Result+';'+cCallingConventions[ProcType.CallingConvention];
 end;
@@ -1638,9 +1644,9 @@ begin
     if El is TPasFunction then
       Result:=Result+':'+GetTreeDesc(TPasFunctionType(TPasFunction(El).ProcType).ResultEl,Indent);
     if TPasProcedureType(El).IsOfObject then
-      Result:=Result+' of object';
+      Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
     if TPasProcedureType(El).IsNested then
-      Result:=Result+' is nested';
+      Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
     if cCallingConventions[TPasProcedureType(El).CallingConvention]<>'' then
       Result:=Result+'; '+cCallingConventions[TPasProcedureType(El).CallingConvention];
     end
@@ -1756,6 +1762,18 @@ begin
     Result:=T.IdentEl.Name+':'+Result;
 end;
 
+function GetResolverResultDbg(const T: TPasResolverResult): string;
+begin
+  Result:='bt='+BaseTypeNames[T.BaseType];
+  if T.SubType<>btNone then
+    Result:=Result+' Sub='+BaseTypeNames[T.SubType];
+  Result:=Result
+         +' Ident='+GetObjName(T.IdentEl)
+         +' Type='+GetObjName(T.TypeEl)
+         +' Expr='+GetObjName(T.ExprEl)
+         +' Flags='+ResolverResultFlagsToStr(T.Flags);
+end;
+
 function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string;
 var
   f: TPasResolverResultFlag;
@@ -2717,9 +2735,11 @@ begin
     else if (C=TPasClassType)
         or (C=TPasClassOfType)
         or (C=TPasEnumType)
+        or (C=TPasProcedureType)
+        or (C=TPasFunctionType)
         or (C=TPasArrayType) then
       begin
-      // type cast to a class, class-of, enum, or array
+      // type cast to user type
       Abort:=true; // can't be overloaded
       if Data^.Found<>nil then exit;
       Distance:=CheckTypeCast(TPasType(El),Data^.Params,false);
@@ -3149,41 +3169,12 @@ var
   RangeExpr: TBinaryExpr;
   C: TClass;
   EnumType: TPasType;
-
-  procedure CheckAnonymousElType;
-  var
-    Decl: TPasDeclarations;
-    EnumScope: TPasEnumTypeScope;
-  begin
-    if (EnumType.Name<>'') or (AnonymousEnumtypePostfix='') then exit;
-    if El.Name='' then
-      RaiseNotYetImplemented(20170415165455,EnumType);
-    // give anonymous enumtype a name
-    EnumType.Name:=El.Name+AnonymousEnumtypePostfix;
-    {$IFDEF VerbosePasResolver}
-    writeln('TPasResolver.FinishSetType set="',GetObjName(El),'" named anonymous enumtype "',GetObjName(EnumType),'"');
-    {$ENDIF}
-    if not (El.Parent is TPasDeclarations) then
-      RaiseNotYetImplemented(20170415161624,EnumType,GetObjName(El.Parent));
-    Decl:=TPasDeclarations(El.Parent);
-    Decl.Declarations.Add(EnumType);
-    EnumType.AddRef;
-    EnumType.Parent:=Decl;
-    Decl.Types.Add(EnumType);
-    if EnumType is TPasEnumType then
-      begin
-      EnumScope:=TPasEnumTypeScope(EnumType.CustomData);
-      ReleaseAndNil(TPasElement(EnumScope.CanonicalSet));
-      EnumScope.CanonicalSet:=El;
-      end;
-  end;
-
 begin
   EnumType:=El.EnumType;
   C:=EnumType.ClassType;
   if C=TPasEnumType then
     begin
-    CheckAnonymousElType;
+    FinishSubElementType(El,EnumType);
     exit;
     end
   else if C=TPasRangeType then
@@ -3191,7 +3182,7 @@ begin
     RangeExpr:=TPasRangeType(EnumType).RangeExpr;
     if RangeExpr.Parent=El then
       CheckRangeExpr(RangeExpr.left,RangeExpr.right,StartResolved,EndResolved);
-    CheckAnonymousElType;
+    FinishSubElementType(El,EnumType);
     exit;
     end
   else if C=TPasUnresolvedSymbolRef then
@@ -3207,6 +3198,37 @@ begin
   RaiseXExpectedButYFound(20170216151557,'enum type',EnumType.ElementTypeName,EnumType);
 end;
 
+procedure TPasResolver.FinishSubElementType(Parent, El: TPasElement);
+var
+  Decl: TPasDeclarations;
+  EnumScope: TPasEnumTypeScope;
+begin
+  if (El.Name<>'') or (AnonymousElTypePostfix='') then exit;
+  if Parent.Name='' then
+    RaiseMsg(20170415165455,nCannotNestAnonymousX,sCannotNestAnonymousX,[El.ElementTypeName],El);
+  if not (Parent.Parent is TPasDeclarations) then
+    RaiseMsg(20170416094735,nCannotNestAnonymousX,sCannotNestAnonymousX,[El.ElementTypeName],El);
+  // give anonymous sub type a name
+  El.Name:=Parent.Name+AnonymousElTypePostfix;
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishSubElementType parent="',GetObjName(Parent),'" named anonymous type "',GetObjName(El),'"');
+  {$ENDIF}
+  Decl:=TPasDeclarations(Parent.Parent);
+  Decl.Declarations.Add(El);
+  El.AddRef;
+  El.Parent:=Decl;
+  Decl.Types.Add(El);
+  if (El.ClassType=TPasEnumType) and (Parent.ClassType=TPasSetType) then
+    begin
+    EnumScope:=TPasEnumTypeScope(El.CustomData);
+    if EnumScope.CanonicalSet<>Parent then
+      begin
+      ReleaseAndNil(TPasElement(EnumScope.CanonicalSet));
+      EnumScope.CanonicalSet:=TPasSetType(Parent);
+      end;
+    end;
+end;
+
 procedure TPasResolver.FinishRangeType(El: TPasRangeType);
 var
   StartResolved, EndResolved: TPasResolverResult;
@@ -3258,6 +3280,7 @@ begin
     else
       RaiseXExpectedButYFound(20170216151609,'range',RangeResolved.IdentEl.ElementTypeName,Expr);
     end;
+  FinishSubElementType(El,El.ElType);
 end;
 
 procedure TPasResolver.FinishConstDef(El: TPasConst);
@@ -5013,12 +5036,12 @@ begin
       begin
       // FoundEl one element, but it was incompatible => raise error
       {$IFDEF VerbosePasResolver}
-      writeln('TPasResolver.ResolveParamsExpr found one element, but it was incompatible => check again to raise error');
+      writeln('TPasResolver.ResolveFuncParamsExpr found one element, but it was incompatible => check again to raise error. Found=',GetObjName(FindCallData.Found));
       {$ENDIF}
       if FindCallData.Found is TPasProcedure then
         CheckCallProcCompatibility(TPasProcedure(FindCallData.Found).ProcType,Params,true)
       else if FindCallData.Found is TPasProcedureType then
-        CheckCallProcCompatibility(TPasProcedureType(FindCallData.Found),Params,true)
+        CheckTypeCast(TPasProcedureType(FindCallData.Found),Params,true)
       else if FindCallData.Found.ClassType=TPasUnresolvedSymbolRef then
         begin
         if FindCallData.Found.CustomData is TResElDataBuiltInProc then
@@ -5059,7 +5082,7 @@ begin
           // ToDo: create a hint for each candidate
           El:=TPasElement(FindCallData.List[i]);
           {$IFDEF VerbosePasResolver}
-          writeln('TPasResolver.ResolveParamsExpr Overload Candidate: ',GetElementSourcePosStr(El),' ',GetTreeDesc(El));
+          writeln('TPasResolver.ResolveFuncParamsExpr Overload Candidate: ',GetElementSourcePosStr(El),' ',GetTreeDesc(El));
           {$ENDIF}
           Msg:=Msg+', ';
           Msg:=Msg+GetElementSourcePosStr(El);
@@ -5094,6 +5117,10 @@ begin
       if (C=TPasClassType)
           or (C=TPasClassOfType)
           or (C=TPasEnumType)
+          or (C=TPasSetType)
+          or (C=TPasPointerType)
+          or (C=TPasProcedureType)
+          or (C=TPasFunctionType)
           or (C=TPasArrayType) then
         begin
         // type cast
@@ -5131,11 +5158,12 @@ begin
         {$IFDEF VerbosePasResolver}
         writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData));
         {$ENDIF}
-        RaiseNotYetImplemented(20170306121908,Params);
+        RaiseMsg(20170306121908,nIllegalExpression,sIllegalExpression,[],Params);
         end;
       end
     else
       begin
+      // FoundEl is not a type, maybe a var
       ComputeElement(FoundEl,ResolvedEl,[rcNoImplicitProc]);
       if ResolvedEl.TypeEl is TPasProcedureType then
         begin
@@ -5145,7 +5173,7 @@ begin
       {$IFDEF VerbosePasResolver}
       writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData),' Resolvedel=',GetResolverResultDesc(ResolvedEl));
       {$ENDIF}
-      RaiseNotYetImplemented(20170306104301,Params);
+      RaiseMsg(20170306104301,nIllegalExpression,sIllegalExpression,[],Params);
       end;
     end
   else if Value.ClassType=TParamsExpr then
@@ -5159,7 +5187,7 @@ begin
       if IsProcedureType(ResolvedEl,true) then
         begin
         CheckCallProcCompatibility(TPasProcedureType(ResolvedEl.TypeEl),Params,true);
-        CreateReference(ResolvedEl.TypeEl,Value,Access);
+        CreateReference(TPasProcedureType(ResolvedEl.TypeEl),Value,Access);
         exit;
         end
       end;
@@ -5354,7 +5382,7 @@ end;
 
 procedure TPasResolver.AccessExpr(Expr: TPasExpr;
   Access: TResolvedRefAccess);
-// called after a call overload was found for each element
+// called after a call target was found, called for each element
 // to set the rraParamToUnknownProc to Access
 var
   Ref: TResolvedReference;
@@ -6417,16 +6445,39 @@ begin
         end
       else if ResolvedEl.TypeEl is TPasProcedureType then
         begin
-        if rcConstant in Flags then
-          RaiseConstantExprExp(20170216152639,Params);
-        if ResolvedEl.TypeEl is TPasFunctionType then
-          // function call => return result
-          ComputeElement(TPasFunctionType(ResolvedEl.TypeEl).ResultEl,
-            ResolvedEl,Flags+[rcNoImplicitProc],StartEl)
+        if Params.Value is TParamsExpr then
+          begin
+          // e.g. Name()() or Name[]()
+          Include(ResolvedEl.Flags,rrfReadable);
+          end;
+        if rrfReadable in ResolvedEl.Flags then
+          begin
+          // call procvar
+          if rcConstant in Flags then
+            RaiseConstantExprExp(20170216152639,Params);
+          if ResolvedEl.TypeEl is TPasFunctionType then
+            // function call => return result
+            ComputeElement(TPasFunctionType(ResolvedEl.TypeEl).ResultEl,
+              ResolvedEl,Flags+[rcNoImplicitProc],StartEl)
+          else
+            // procedure call, result is neither readable nor writable
+            SetResolverTypeExpr(ResolvedEl,btProc,TPasProcedureType(ResolvedEl.TypeEl),[]);
+          Include(ResolvedEl.Flags,rrfCanBeStatement);
+          end
         else
-          // procedure call, result is neither readable nor writable
-          SetResolverTypeExpr(ResolvedEl,btProc,TPasProcedureType(ResolvedEl.TypeEl),[]);
-        Include(ResolvedEl.Flags,rrfCanBeStatement);
+          begin
+          // typecast proctype
+          if length(Params.Params)<>1 then
+            begin
+            {$IFDEF VerbosePasResolver}
+            writeln('TPasResolver.ComputeFuncParams DeclEl=',GetObjName(DeclEl),' ',GetResolverResultDbg(ResolvedEl));
+            {$ENDIF}
+            RaiseMsg(20170416185211,nWrongNumberOfParametersForTypeCast,
+              sWrongNumberOfParametersForTypeCast,[ResolvedEl.TypeEl.Name],Params);
+            end;
+          SetResolverValueExpr(ResolvedEl,btContext,TPasProcedureType(ResolvedEl.TypeEl),
+            Params.Params[0],[rrfReadable]);
+          end;
         end
       else if (DeclEl is TPasType) then
         begin
@@ -9018,15 +9069,15 @@ begin
     exit;
     end;
   if Proc1.IsNested<>Proc2.IsNested then
-    exit(ModifierError('is nested'));
+    exit(ModifierError(ProcTypeModifiers[ptmIsNested]));
   if Proc1.IsOfObject<>Proc2.IsOfObject then
     begin
     if (proProcTypeWithoutIsNested in Options) then
-      exit(ModifierError('of object'))
+      exit(ModifierError(ProcTypeModifiers[ptmOfObject]))
     else if Proc1.IsNested then
       // "is nested" can handle both, proc and method.
     else
-      exit(ModifierError('of object'))
+      exit(ModifierError(ProcTypeModifiers[ptmOfObject]))
     end;
   if Proc1.CallingConvention<>Proc2.CallingConvention then
     begin
@@ -9234,7 +9285,7 @@ begin
           [],ErrorEl);
       exit(cIncompatible);
       end
-    else if LHS.BaseType in [btRange,btSet,btModule,btArray] then
+    else if LHS.BaseType in [btRange,btSet,btModule,btArray,btProc] then
       begin
       if RaiseOnIncompatible then
         RaiseMsg(20170216152432,nIllegalExpression,sIllegalExpression,[],ErrorEl);
@@ -9300,8 +9351,10 @@ begin
           Result:=cExact+1 // any pointer can take a btPointer
         else if IsSameType(LHS.TypeEl,RHS.TypeEl) then
           Result:=cExact // pointer of same type
-        else if (LHS.TypeEl<>nil) and (RHS.TypeEl<>nil) then
-          Result:=CheckAssignCompatibility(LHS.TypeEl,RHS.TypeEl,RaiseOnIncompatible);
+        else if (LHS.TypeEl.ClassType=TPasPointerType)
+            and (RHS.TypeEl.ClassType=TPasPointerType) then
+          Result:=CheckAssignCompatibility(TPasPointerType(LHS.TypeEl).DestType,
+            TPasPointerType(RHS.TypeEl).DestType,RaiseOnIncompatible);
         end
       else if IsBaseType(LHS.TypeEl,btPointer) then
         begin
@@ -9316,7 +9369,9 @@ begin
             begin
             if IsDynArray(RHS.TypeEl) then
               Result:=cExact;
-            end;
+            end
+          else if (C=TPasProcedureType) or (C=TPasFunctionType) then
+            Result:=cExact+1;
           end;
         end;
       end
@@ -9713,7 +9768,7 @@ begin
     if not ResolvedElCanBeVarParam(ExprResolved) then
       begin
       {$IFDEF VerbosePasResolver}
-      writeln('TPasResolver.CheckParamCompatibility NeedWritable: Identifier=',GetObjName(ExprResolved.IdentEl),' Type=',GetObjName(ExprResolved.TypeEl),' Expr=',GetObjName(ExprResolved.ExprEl),' Flags=',ResolverResultFlagsToStr(ExprResolved.Flags));
+      writeln('TPasResolver.CheckParamCompatibility NeedWritable: ',GetResolverResultDbg(ExprResolved));
       {$ENDIF}
       if RaiseOnError then
         RaiseMsg(20170216152450,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
@@ -10152,8 +10207,8 @@ begin
     exit(cIncompatible);
     end;
   Param:=Params.Params[0];
-  ComputeElement(Param,ParamResolved,[]);
-  ComputeElement(El,ResolvedEl,[]);
+  ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
+  ComputeElement(El,ResolvedEl,[rcNoImplicitProc]);
   Result:=CheckTypeCastRes(ParamResolved,ResolvedEl,Param,RaiseOnError);
 end;
 
@@ -10164,9 +10219,10 @@ var
   ToTypeEl, ToClassType, FromClassType: TPasType;
   ToTypeBaseType: TResolverBaseType;
   C: TClass;
+  ToProcType, FromProcType: TPasProcedureType;
 begin
   Result:=cIncompatible;
-  ToTypeEl:=ToResolved.TypeEl;
+  ToTypeEl:=ResolveAliasType(ToResolved.TypeEl);
   if (ToTypeEl<>nil)
       and (rrfReadable in FromResolved.Flags) then
     begin
@@ -10217,7 +10273,30 @@ begin
                 or (C=TPasClassOfType)
                 or (C=TPasPointerType)
                 or ((C=TPasArrayType) and IsDynArray(FromResolved.TypeEl)) then
-              Result:=cExact;
+              Result:=cExact
+            else if (C=TPasProcedureType) or (C=TPasFunctionType) then
+              begin
+              // from procvar to pointer
+              FromProcType:=TPasProcedureType(FromResolved.TypeEl);
+              if FromProcType.IsOfObject then
+                begin
+                if proMethodAddrAsPointer in Options then
+                  Result:=cExact+1
+                else if RaiseOnError then
+                  RaiseMsg(20170416183615,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+                    [FromProcType.ElementTypeName+' '+ProcTypeModifiers[ptmOfObject],
+                     BaseTypeNames[btPointer]],ErrorEl);
+                end
+              else if FromProcType.IsNested then
+                begin
+                if RaiseOnError then
+                  RaiseMsg(20170416183800,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+                    [FromProcType.ElementTypeName+' '+ProcTypeModifiers[ptmIsNested],
+                     BaseTypeNames[btPointer]],ErrorEl);
+                end
+              else
+                Result:=cExact+1;
+              end;
             end;
           end;
         end;
@@ -10285,25 +10364,77 @@ begin
             and IsBaseType(FromResolved.TypeEl,btPointer) then
           Result:=cExact; // untyped pointer to dynnamic array
         end;
+      end
+    else if (C=TPasProcedureType) or (C=TPasFunctionType) then
+      begin
+      ToProcType:=TPasProcedureType(ToTypeEl);
+      if IsBaseType(FromResolved.TypeEl,btPointer) then
+        begin
+        // type cast untyped pointer value to proctype
+        if ToProcType.IsOfObject then
+          begin
+          if proMethodAddrAsPointer in Options then
+            Result:=cExact+1
+          else if RaiseOnError then
+            RaiseMsg(20170416183940,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+              [BaseTypeNames[btPointer],
+               ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmOfObject]],ErrorEl);
+          end
+        else if ToProcType.IsNested then
+          begin
+          if RaiseOnError then
+            RaiseMsg(20170416184149,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+              [BaseTypeNames[btPointer],
+               ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmIsNested]],ErrorEl);
+          end
+        else
+          Result:=cExact+1;
+        end
+      else if FromResolved.BaseType=btContext then
+        begin
+        if FromResolved.TypeEl is TPasProcedureType then
+          begin
+          // type cast procvar to proctype
+          FromProcType:=TPasProcedureType(FromResolved.TypeEl);
+          if (FromProcType.IsOfObject<>ToProcType.IsOfObject)
+              and not (proMethodAddrAsPointer in Options) then
+            begin
+            if RaiseOnError then
+              RaiseMsg(20170416183109,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+                [FromProcType.ElementTypeName+BoolToStr(FromProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],''),
+                 ToProcType.ElementTypeName+BoolToStr(ToProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],'')],ErrorEl);
+            end
+          else if FromProcType.IsNested<>ToProcType.IsNested then
+            begin
+            if RaiseOnError then
+              RaiseMsg(20170416183305,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+                [FromProcType.ElementTypeName+BoolToStr(FromProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],''),
+                 ToProcType.ElementTypeName+BoolToStr(ToProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],'')],ErrorEl);
+            end
+          else
+            Result:=cExact+1;
+          end;
+        end;
       end;
     end
   else if ToTypeEl<>nil then
     begin
     // FromResolved is not readable
-    if (FromResolved.BaseType=btContext)
-        and (FromResolved.TypeEl.ClassType=TPasClassType)
-        and (FromResolved.TypeEl=FromResolved.IdentEl)
-        and (ToResolved.BaseType=btContext)
-        and (ToResolved.TypeEl.ClassType=TPasClassOfType)
-        and (ToResolved.TypeEl=ToResolved.IdentEl) then
-      begin
-      // for example  class-of(Self) in a class function
-      ToClassType:=TPasClassOfType(ToTypeEl).DestType;
-      FromClassType:=TPasClassType(FromResolved.TypeEl);
-      Result:=CheckClassesAreRelated(ToClassType,FromClassType,ErrorEl);
-      if Result<cIncompatible then exit;
+    if FromResolved.BaseType=btContext then
+      begin
+      if (FromResolved.TypeEl.ClassType=TPasClassType)
+          and (FromResolved.TypeEl=FromResolved.IdentEl)
+          and (ToResolved.BaseType=btContext)
+          and (ToResolved.TypeEl.ClassType=TPasClassOfType)
+          and (ToResolved.TypeEl=ToResolved.IdentEl) then
+        begin
+        // for example  class-of(Self) in a class function
+        ToClassType:=TPasClassOfType(ToTypeEl).DestType;
+        FromClassType:=TPasClassType(FromResolved.TypeEl);
+        Result:=CheckClassesAreRelated(ToClassType,FromClassType,ErrorEl);
+        end;
       end;
-    if RaiseOnError then
+    if (Result=cIncompatible) and RaiseOnError then
       begin
       if FromResolved.IdentEl is TPasType then
         RaiseMsg(20170404162610,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
@@ -11014,6 +11145,7 @@ var
   Value: TPasExpr;
   Ref: TResolvedReference;
   Decl: TPasElement;
+  C: TClass;
 begin
   Result:=false;
   if (Params=nil) or (Params.Kind<>pekFuncParams) then exit;
@@ -11023,13 +11155,20 @@ begin
   if not (Value.CustomData is TResolvedReference) then exit;
   Ref:=TResolvedReference(Value.CustomData);
   Decl:=Ref.Declaration;
-  if (Decl.ClassType=TPasAliasType) or (Decl.ClassType=TPasTypeAliasType) then
+  C:=Decl.ClassType;
+  if (C=TPasAliasType) or (C=TPasTypeAliasType) then
+    begin
     Decl:=ResolveAliasType(TPasAliasType(Decl));
-  if (Decl.ClassType=TPasClassType)
-      or (Decl.ClassType=TPasClassOfType)
-      or (Decl.ClassType=TPasEnumType) then
-    exit(true);
-  if (Decl.ClassType=TPasUnresolvedSymbolRef)
+    C:=Decl.ClassType;
+    end;
+  if (C=TPasProcedureType)
+      or (C=TPasFunctionType) then
+    exit(true)
+  else if (C=TPasClassType)
+      or (C=TPasClassOfType)
+      or (C=TPasEnumType) then
+    exit(true)
+  else if (C=TPasUnresolvedSymbolRef)
       and (Decl.CustomData is TResElDataBaseType) then
     exit(true);
 end;

packages/fcl-passrc/tests/tcresolver.pas

@@ -473,6 +473,7 @@ type
     Procedure TestDynArrayOfLongint;
     Procedure TestStaticArray;
     Procedure TestArrayOfArray;
+    Procedure TestArrayOfArray_NameAnonymous;
     Procedure TestFunctionReturningArray;
     Procedure TestArray_LowHigh;
     Procedure TestArray_AssignSameSignatureFail;
@@ -528,10 +529,14 @@ type
     Procedure TestProcType_AsArgOtherUnit;
     Procedure TestProcType_Property;
     Procedure TestProcType_PropertyCallWrongArgFail;
+    Procedure TestProcType_Typecast;
 
     // pointer
     Procedure TestPointer;
     Procedure TestPointer_AssignPointerToClassFail;
+    Procedure TestPointer_TypecastToMethodTypeFail;
+    Procedure TestPointer_TypecastFromMethodTypeFail;
+    Procedure TestPointer_TypecastMethod_proMethodAddrAsPointer;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -2439,7 +2444,7 @@ end;
 
 procedure TTestResolver.TestSet_AnonymousEnumtypeName;
 begin
-  ResolverEngine.AnonymousEnumtypePostfix:='$enum';
+  ResolverEngine.AnonymousElTypePostfix:='$enum';
   StartProgram(false);
   Add('type');
   Add('  TFlags = set of (red, green);');
@@ -7358,6 +7363,22 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestArrayOfArray_NameAnonymous;
+begin
+  ResolverEngine.AnonymousElTypePostfix:='$array';
+  StartProgram(false);
+  Add('type');
+  Add('  TArrA = array of array of longint;');
+  Add('var');
+  Add('  a: TArrA;');
+  Add('begin');
+  Add('  a[1][2]:=5;');
+  Add('  a[1,2]:=5;');
+  Add('  if a[2,1]=a[0,1] then ;');
+  Add('  a[3][4]:=a[5,6];');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestFunctionReturningArray;
 begin
   StartProgram(false);
@@ -8110,7 +8131,7 @@ begin
   Add('var n: TNotifyEvent;');
   Add('begin');
   Add('  n:=@ProcA;');
-  CheckResolverException('procedure type modifier "of object" mismatch',
+  CheckResolverException('procedure type modifier "of Object" mismatch',
     PasResolver.nXModifierMismatchY);
 end;
 
@@ -8129,7 +8150,7 @@ begin
   Add('  o: TObject;');
   Add('begin');
   Add('  n:[email protected];');
-  CheckResolverException('procedure type modifier "of object" mismatch',
+  CheckResolverException('procedure type modifier "of Object" mismatch',
     PasResolver.nXModifierMismatchY);
 end;
 
@@ -8304,7 +8325,7 @@ begin
   Add('begin');
   Add('  Button1.OnClick := App.BtnClickHandler();');
   CheckResolverException(
-    'Wrong number of parameters specified for call to "procedure BtnClickHandler(TObject) of object"',
+    'Wrong number of parameters specified for call to "procedure BtnClickHandler(TObject) of Object"',
     nWrongNumberOfParametersForCallTo);
 end;
 
@@ -8328,7 +8349,7 @@ begin
   Add('begin');
   Add('  Button1.OnClick := @App.BtnClickHandler();');
   CheckResolverException(
-    'Wrong number of parameters specified for call to "procedure BtnClickHandler(TObject) of object"',
+    'Wrong number of parameters specified for call to "procedure BtnClickHandler(TObject) of Object"',
     nWrongNumberOfParametersForCallTo);
 end;
 
@@ -8538,6 +8559,32 @@ begin
     nIncompatibleTypeArgNo);
 end;
 
+procedure TTestResolver.TestProcType_Typecast;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TNotifyEvent = procedure(Sender: Pointer) of object;');
+  Add('  TEvent = procedure of object;');
+  Add('  TProcA = procedure(i: longint);');
+  Add('  TFuncB = function(i, j: longint): longint;');
+  Add('var');
+  Add('  Notify: TNotifyEvent;');
+  Add('  Event: TEvent;');
+  Add('  ProcA: TProcA;');
+  Add('  FuncB: TFuncB;');
+  Add('  p: pointer;');
+  Add('begin');
+  Add('  Notify:=TNotifyEvent(Event);');
+  Add('  Event:=TEvent(Event);');
+  Add('  Event:=TEvent(Notify);');
+  Add('  ProcA:=TProcA(FuncB);');
+  Add('  FuncB:=TFuncB(FuncB);');
+  Add('  FuncB:=TFuncB(ProcA);');
+  Add('  ProcA:=TProcA(p);');
+  Add('  FuncB:=TFuncB(p);');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestPointer;
 begin
   StartProgram(false);
@@ -8546,11 +8593,14 @@ begin
   Add('  TClass = class of TObject;');
   Add('  TMyPtr = pointer;');
   Add('  TArrInt = array of longint;');
+  Add('  TFunc = function: longint;');
+  Add('procedure DoIt; begin end;');
   Add('var');
   Add('  p: TMyPtr;');
   Add('  Obj: TObject;');
   Add('  Cl: TClass;');
   Add('  a: tarrint;');
+  Add('  f: TFunc;');
   Add('begin');
   Add('  p:=nil;');
   Add('  if p=nil then;');
@@ -8559,6 +8609,9 @@ begin
   Add('  p:=obj;');
   Add('  p:=cl;');
   Add('  p:=a;');
+  Add('  p:=Pointer(f);');
+  Add('  p:=@DoIt;');
+  Add('  p:=Pointer(@DoIt)');
   Add('  obj:=TObject(p);');
   Add('  cl:=TClass(p);');
   Add('  a:=TArrInt(p);');
@@ -8579,6 +8632,49 @@ begin
     nIncompatibleTypesGotExpected);
 end;
 
+procedure TTestResolver.TestPointer_TypecastToMethodTypeFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEvent = procedure of object;');
+  Add('var');
+  Add('  p: pointer;');
+  Add('  e: TEvent;');
+  Add('begin');
+  Add('  e:=TEvent(p);');
+  CheckResolverException('Illegal type conversion: "Pointer" to "procedure type of Object"',
+    nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestPointer_TypecastFromMethodTypeFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEvent = procedure of object;');
+  Add('var');
+  Add('  p: pointer;');
+  Add('  e: TEvent;');
+  Add('begin');
+  Add('  p:=Pointer(e);');
+  CheckResolverException('Illegal type conversion: "procedure type of Object" to "Pointer"',
+    nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestPointer_TypecastMethod_proMethodAddrAsPointer;
+begin
+  ResolverEngine.Options:=ResolverEngine.Options+[proMethodAddrAsPointer];
+  StartProgram(false);
+  Add('type');
+  Add('  TEvent = procedure of object;');
+  Add('var');
+  Add('  p: pointer;');
+  Add('  e: TEvent;');
+  Add('begin');
+  Add('  e:=TEvent(p);');
+  Add('  p:=Pointer(e);');
+  ParseProgram;
+end;
+
 initialization
   RegisterTests([TTestResolver]);
 

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -79,6 +79,7 @@ type
     procedure TestM_Hint_UnitNotUsed_No_OnlyExternal;
     procedure TestM_Hint_ParameterNotUsed;
     procedure TestM_Hint_ParameterNotUsed_Abstract;
+    procedure TestM_Hint_ParameterNotUsedTypecast;
     procedure TestM_Hint_LocalVariableNotUsed;
     procedure TestM_Hint_InterfaceUnitVariableUsed;
     procedure TestM_Hint_ValueParameterIsAssignedButNeverUsed;
@@ -900,6 +901,27 @@ begin
   CheckUnexpectedMessages;
 end;
 
+procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsedTypecast;
+begin
+  StartProgram(true);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TSortCompare = function(a,b: Pointer): integer;');
+  Add('  TObjCompare = function(a,b: TObject): integer;');
+  Add('procedure Sort(const Compare: TSortCompare);');
+  Add('begin');
+  Add('  Compare(nil,nil);');
+  Add('end;');
+  Add('procedure DoIt(const Compare: TObjCompare);');
+  Add('begin');
+  Add('  Sort(TSortCompare(Compare));');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt(nil);');
+  AnalyzeProgram;
+  CheckUnexpectedMessages;
+end;
+
 procedure TTestUseAnalyzer.TestM_Hint_LocalVariableNotUsed;
 begin
   StartProgram(true);