Browse Source

fcl-passrc: resolver: built-in function typeinfo

git-svn-id: trunk@35791 -
Mattias Gaertner 8 năm trước cách đây
mục cha
commit
a42fa05288
1 tập tin đã thay đổi với 251 bổ sung54 xóa
  1. 251 54
      packages/fcl-passrc/src/pasresolver.pp

+ 251 - 54
packages/fcl-passrc/src/pasresolver.pp

@@ -229,7 +229,7 @@ const
   nTypesAreNotRelated = 3029;
   nAbstractMethodsCannotBeCalledDirectly = 3030;
   nMissingParameterX = 3031;
-  nCannotAccessThisMemberFromAClassReference = 3032;
+  nCannotAccessThisMemberFromAX = 3032;
   nInOperatorExpectsSetElementButGot = 3033;
   nWrongNumberOfParametersForTypeCast = 3034;
   nIllegalTypeConversionTo = 3035;
@@ -252,6 +252,7 @@ const
   nXModifierMismatchY = 3052;
   nSymbolCannotBePublished = 3053;
   nCannotTypecastAType = 3054;
+  nTypeIdentifierExpected = 3055;
 
 // resourcestring patterns of messages
 resourcestring
@@ -286,7 +287,7 @@ resourcestring
   sTypesAreNotRelated = 'Types are not related';
   sAbstractMethodsCannotBeCalledDirectly = 'Abstract methods cannot be called directly';
   sMissingParameterX = 'Missing parameter %s';
-  sCannotAccessThisMemberFromAClassReference = 'Cannot access this member from a class reference';
+  sCannotAccessThisMemberFromAX = 'Cannot access this member from a %s';
   sInOperatorExpectsSetElementButGot = 'the in-operator expects a set element, but got %s';
   sWrongNumberOfParametersForTypeCast = 'wrong number of parameters for type cast to %s';
   sIllegalTypeConversionTo = 'Illegal type conversion: "%s" to "%s"';
@@ -307,8 +308,9 @@ resourcestring
   sVirtualMethodXHasLowerVisibility = 'Virtual method "%s" has a lower visibility (%s) than parent class %s (%s)';
   sExternalClassInstanceCannotAccessStaticX = 'External class instance cannot access static %s';
   sXModifierMismatchY = '%s modifier "%s" mismatch';
-  sSymbolCannotBePublished = 'Symbol cannot be published. Only methods and properties.';
+  sSymbolCannotBePublished = 'Symbol cannot be published';
   sCannotTypecastAType = 'Cannot type cast a type';
+  sTypeIdentifierExpected = 'Type identifier expected';
 
 type
   TResolverBaseType = (
@@ -443,7 +445,7 @@ const
     'Nil',
     'Procedure/Function',
     'BuiltInProc',
-    'set literal',
+    'set',
     'range..',
     'array literal'
     );
@@ -472,7 +474,8 @@ type
     bfConcatArray,
     bfCopyArray,
     bfInsertArray,
-    bfDeleteArray
+    bfDeleteArray,
+    bfTypeInfo
     );
   TResolverBuiltInProcs = set of TResolverBuiltInProc;
 const
@@ -499,7 +502,8 @@ const
     'Concat',
     'Copy',
     'Insert',
-    'Delete'
+    'Delete',
+    'TypeInfo'
     );
   bfAllStandardProcs = [Succ(bfCustom)..high(TResolverBuiltInProc)];
 
@@ -1218,6 +1222,10 @@ type
       Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
     procedure BI_DeleteArray_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
       Params: TParamsExpr); virtual;
+    function BI_TypeInfo_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_TypeInfo_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
+      {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
   public
     constructor Create;
     destructor Destroy; override;
@@ -1359,10 +1367,12 @@ type
     function GetPasPropertyAncestor(El: TPasProperty): TPasProperty;
     function GetPasPropertyGetter(El: TPasProperty): TPasElement;
     function GetPasPropertySetter(El: TPasProperty): TPasElement;
+    function GetPasPropertyStored(El: TPasProperty): TPasElement;
     function GetPasClassAncestor(ClassEl: TPasClassType; SkipAlias: boolean): TPasType;
     function GetLoop(El: TPasElement): TPasImplElement;
     function ResolveAliasType(aType: TPasType): TPasType;
     function ExprIsAddrTarget(El: TPasExpr): boolean;
+    function IsNameExpr(El: TPasExpr): boolean; inline; // TSelfExpr or TPrimitiveExpr with Kind=pekIdent
     function GetLastExprIdentifier(El: TPasExpr): TPasExpr;
     function ParentNeedsExprResult(El: TPasExpr): boolean;
     function GetReference_NewInstanceClass(Ref: TResolvedReference): TPasClassType;
@@ -1376,6 +1386,7 @@ type
     function IsTypeCast(Params: TParamsExpr): boolean;
     function ProcNeedsParams(El: TPasProcedureType): boolean;
     function GetRangeLength(RangeResolved: TPasResolverResult): integer;
+    function HasTypeInfo(El: TPasType): boolean; virtual;
   public
     property BaseTypes[bt: TResolverBaseType]: TPasUnresolvedSymbolRef read GetBaseTypes;
     property BaseTypeStringIndex: TResolverBaseType read FBaseTypeStringIndex write FBaseTypeStringIndex;
@@ -2551,6 +2562,13 @@ begin
   Result:=FScopes[Index];
 end;
 
+// inline
+function TPasResolver.IsNameExpr(El: TPasExpr): boolean;
+begin
+  if El.ClassType=TSelfExpr then exit(true);
+  Result:=(El.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(El).Kind=pekIdent);
+end;
+
 procedure TPasResolver.ClearResolveDataList(Kind: TResolveDataListKind);
 var
   El: TPasElement;
@@ -2864,14 +2882,16 @@ var
   ClassScope: TPasClassScope;
   OlderEl: TPasElement;
   IsClassScope: Boolean;
+  C: TClass;
 begin
   IsClassScope:=(Scope is TPasClassScope);
 
   if (El.Visibility=visPublished) then
     begin
-    if El.ClassType=TPasProperty then
+    C:=El.ClassType;
+    if (C=TPasProperty) or (C=TPasVariable) then
       // Note: VarModifiers are not yet set
-    else if (El.ClassType=TPasProcedure) or (El.ClassType=TPasFunction) then
+    else if (C=TPasProcedure) or (C=TPasFunction) then
       // ok
     else
       RaiseMsg(20170403223024,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
@@ -3254,6 +3274,7 @@ var
   DeclProcScope, ProcScope: TPasProcedureScope;
   ParentScope: TPasScope;
   pm: TProcedureModifier;
+  ptm: TProcTypeModifier;
 begin
   if (El.Parent is TPasProcedure) and (TPasProcedure(El.Parent).ProcType=El) then
     begin
@@ -3281,15 +3302,21 @@ begin
       end;
 
     if Proc.IsExternal then
+      begin
       for pm in TProcedureModifier do
         if (pm in Proc.Modifiers)
             and not (pm in [pmVirtual, pmDynamic, pmOverride,
                         pmOverload, pmMessage, pmReintroduce,
-                        pmStatic, pmVarargs,
                         pmExternal, pmDispId,
                         pmfar]) then
           RaiseMsg(20170216151616,nInvalidXModifierY,
             sInvalidXModifierY,[Proc.ElementTypeName,'external, '+ModifierNames[pm]],Proc);
+      for ptm in TProcTypeModifier do
+        if (ptm in Proc.ProcType.Modifiers)
+            and not (ptm in [ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs]) then
+          RaiseMsg(20170411171224,nInvalidXModifierY,
+            sInvalidXModifierY,[Proc.ElementTypeName,'external, '+ProcTypeModifiers[ptm]],Proc);
+      end;
 
     if Proc.Parent is TPasClassType then
       begin
@@ -3597,19 +3624,25 @@ begin
 end;
 
 procedure TPasResolver.FinishDeclaration(El: TPasElement);
+var
+  C: TClass;
 begin
-  if El.ClassType=TPasVariable then
+  C:=El.ClassType;
+  if C=TPasVariable then
     FinishVariable(TPasVariable(El))
-  else if El.ClassType=TPasProperty then
+  else if C=TPasProperty then
     FinishPropertyOfClass(TPasProperty(El))
-  else if El.ClassType=TPasArgument then
+  else if C=TPasArgument then
     FinishArgument(TPasArgument(El));
 end;
 
 procedure TPasResolver.FinishVariable(El: TPasVariable);
 begin
   if (El.Visibility=visPublished) then
-    RaiseMsg(20170403223837,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
+    begin
+    if [vmClass,vmStatic,vmCVar]*El.VarModifiers<>[] then
+      RaiseMsg(20170403223837,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
+    end;
   if El.Expr<>nil then
     begin
     ResolveExpr(El.Expr,rraRead);
@@ -3757,7 +3790,7 @@ var
   end;
 
 var
-  ResultType: TPasType;
+  ResultType, TypeEl: TPasType;
   CurClassType: TPasClassType;
   AccEl: TPasElement;
   Proc: TPasProcedure;
@@ -3788,7 +3821,7 @@ begin
     begin
     // check compatibility
     AccEl:=GetAccessor(PropEl.ReadAccessor);
-    if AccEl is TPasVariable then
+    if (AccEl.ClassType=TPasVariable) or (AccEl.ClassType=TPasConst) then
       begin
       if PropEl.Args.Count>0 then
         RaiseXExpectedButYFound(20170216151823,'function',AccEl.ElementTypeName,PropEl.ReadAccessor);
@@ -3838,7 +3871,7 @@ begin
     begin
     // check compatibility
     AccEl:=GetAccessor(PropEl.WriteAccessor);
-    if AccEl is TPasVariable then
+    if AccEl.ClassType=TPasVariable then
       begin
       if PropEl.Args.Count>0 then
         RaiseXExpectedButYFound(20170216151852,'procedure',AccEl.ElementTypeName,PropEl.WriteAccessor);
@@ -3892,13 +3925,27 @@ begin
     begin
     ResolveExpr(PropEl.ImplementsFunc,rraRead);
     // ToDo: check compatibility
-
+    RaiseNotYetImplemented(20170409213850,PropEl.ImplementsFunc);
     end;
   if PropEl.StoredAccessor<>nil then
     begin
     // check compatibility
     AccEl:=GetAccessor(PropEl.StoredAccessor);
-    if AccEl is TPasProcedure then
+    if (AccEl.ClassType=TPasVariable) or (AccEl.ClassType=TPasConst) then
+      begin
+      if PropEl.IndexExpr<>nil then
+        RaiseNotYetImplemented(20170409214006,PropEl.StoredAccessor,'stored with index');
+      TypeEl:=ResolveAliasType(TPasVariable(AccEl).VarType);
+      if not IsBaseType(TypeEl,btBoolean) then
+        RaiseIncompatibleType(20170409214300,nIncompatibleTypesGotExpected,
+          [],TypeEl,BaseTypes[btBoolean],PropEl.StoredAccessor);
+      if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
+        if vmClass in PropEl.VarModifiers then
+          RaiseXExpectedButYFound(20170409214351,'class var','var',PropEl.StoredAccessor)
+        else
+          RaiseXExpectedButYFound(20170409214359,'var','class var',PropEl.StoredAccessor);
+      end
+    else if AccEl is TPasProcedure then
       begin
       // check function
       Proc:=TPasProcedure(AccEl);
@@ -4913,9 +4960,7 @@ var
   C: TClass;
 begin
   Value:=Params.Value;
-  if (Value.ClassType=TSelfExpr)
-      or ((Value.ClassType=TPrimitiveExpr)
-        and (TPrimitiveExpr(Value).Kind=pekIdent)) then
+  if IsNameExpr(Value) then
     begin
     // e.g. Name() -> find compatible
     if Value.ClassType=TPrimitiveExpr then
@@ -7494,6 +7539,51 @@ begin
   AccessExpr(P[2],rraRead);
 end;
 
+function TPasResolver.BI_TypeInfo_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  Decl: TPasElement;
+  ParamResolved: TPasResolverResult;
+  aType: TPasType;
+begin
+  Result:=cIncompatible;
+  if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
+    exit;
+  Params:=TParamsExpr(Expr);
+
+  // check type or var
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
+  Decl:=ParamResolved.IdentEl;
+  aType:=nil;
+  if (Decl<>nil) then
+    begin
+    if Decl is TPasType then
+      aType:=TPasType(Decl)
+    else if Decl is TPasVariable then
+      aType:=TPasVariable(Decl).VarType
+    else if Decl is TPasArgument then
+      aType:=TPasArgument(Decl).ArgType;
+    end;
+  if aType=nil then
+    RaiseMsg(20170411100259,nTypeIdentifierExpected,sTypeIdentifierExpected,[],Param);
+  aType:=ResolveAliasType(aType);
+  if not HasTypeInfo(aType) then
+    RaiseMsg(20170413200118,nSymbolCannotBePublished,sSymbolCannotBePublished,[],Param);
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
+begin
+  if Proc=nil then;
+  if Params=nil then ;
+  SetResolverTypeExpr(ResolvedEl,btPointer,FBaseTypes[btPointer],[rrfReadable]);
+end;
+
 constructor TPasResolver.Create;
 begin
   inherited Create;
@@ -7807,8 +7897,10 @@ begin
         and (vmClass in TPasVariable(FindData.Found).VarModifiers) then
       // class var/const/property: ok
     else
-      RaiseMsg(20170216152348,nCannotAccessThisMemberFromAClassReference,
-        sCannotAccessThisMemberFromAClassReference,[],FindData.ErrorPosEl);
+      begin
+      RaiseMsg(20170216152348,nCannotAccessThisMemberFromAX,
+        sCannotAccessThisMemberFromAX,[FindData.Found.Parent.ElementTypeName],FindData.ErrorPosEl);
+      end;
     end
   else if (proExtClassInstanceNoTypeMembers in Options)
       and (StartScope.ClassType=TPasDotClassScope)
@@ -8126,6 +8218,10 @@ begin
     AddBuiltInProc('Delete','procedure Delete(var Array; Start, Count: integer)',
         @BI_DeleteArray_OnGetCallCompatibility,nil,
         @BI_DeleteArray_OnFinishParamsExpr,bfDeleteArray,[bipfCanBeStatement]);
+  if bfTypeInfo in TheBaseProcs then
+    AddBuiltInProc('TypeInfo','function TypeInfo(type or var identifier): Pointer',
+        @BI_TypeInfo_OnGetCallCompatibility,@BI_TypeInfo_OnGetCallResult,
+        nil,bfTypeInfo);
 end;
 
 function TPasResolver.AddBaseType(const aName: string; Typ: TResolverBaseType
@@ -8683,8 +8779,7 @@ begin
       end
     else
       begin
-      IsVarArgs:=IsVarArgs or ((ProcType.Parent is TPasProcedure)
-        and (pmVarargs in TPasProcedure(ProcType.Parent).Modifiers));
+      IsVarArgs:=IsVarArgs or (ptmVarargs in ProcType.Modifiers);
       if IsVarArgs then
         begin
         ComputeElement(Param,ParamResolved,[],Param);
@@ -9049,6 +9144,7 @@ function TPasResolver.CheckAssignResCompatibility(const LHS,
 var
   TypeEl: TPasType;
   Handled: Boolean;
+  C: TClass;
 begin
   // check if the RHS can be converted to LHS
   {$IFDEF VerbosePasResolver}
@@ -9118,10 +9214,11 @@ begin
       else if LHS.BaseType=btContext then
         begin
         TypeEl:=LHS.TypeEl;
-        if (TypeEl.ClassType=TPasClassType)
-            or (TypeEl.ClassType=TPasClassOfType)
-            or (TypeEl.ClassType=TPasPointerType)
-            or (TypeEl is TPasProcedureType)
+        C:=TypeEl.ClassType;
+        if (C=TPasClassType)
+            or (C=TPasClassOfType)
+            or (C=TPasPointerType)
+            or C.InheritsFrom(TPasProcedureType)
             or IsDynArray(TypeEl) then
           Result:=cExact;
         end;
@@ -9154,6 +9251,36 @@ begin
           Result:=cExact;
         end;
       end
+    else if LHS.BaseType=btPointer then
+      begin
+      if RHS.BaseType=btPointer then
+        begin
+        if IsBaseType(LHS.TypeEl,btPointer) then
+          Result:=cExact // btPointer can take any pointer
+        else if IsBaseType(RHS.TypeEl,btPointer) then
+          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);
+        end
+      else if IsBaseType(LHS.TypeEl,btPointer) then
+        begin
+        if RHS.BaseType=btContext then
+          begin
+          C:=RHS.TypeEl.ClassType;
+          if C=TPasClassType then
+            exit(cExact) // class type or class instance
+          else if C=TPasClassOfType then
+            Result:=cExact
+          else if C=TPasArrayType then
+            begin
+            if IsDynArray(RHS.TypeEl) then
+              Result:=cExact;
+            end;
+          end;
+        end;
+      end
     else if (LHS.BaseType=btContext) and (LHS.TypeEl is TPasArrayType) then
       Result:=CheckAssignCompatibilityArrayType(LHS,RHS,ErrorEl,RaiseOnIncompatible);
     end;
@@ -9475,6 +9602,24 @@ begin
     end;
 end;
 
+function TPasResolver.GetPasPropertyStored(El: TPasProperty): TPasElement;
+// search the member variable or setter procedure of a property
+var
+  DeclEl: TPasElement;
+begin
+  Result:=nil;
+  while El<>nil do
+    begin
+    if El.StoredAccessor<>nil then
+      begin
+      DeclEl:=(El.StoredAccessor.CustomData as TResolvedReference).Declaration;
+      Result:=DeclEl;
+      exit;
+      end;
+    El:=GetPasPropertyAncestor(El);
+    end;
+end;
+
 function TPasResolver.CheckParamCompatibility(Expr: TPasExpr;
   Param: TPasArgument; ParamNo: integer; RaiseOnError: boolean): integer;
 var
@@ -10021,33 +10166,52 @@ begin
           begin
           if FromResolved.BaseType in btAllStringAndChars then
             Result:=cExact+1;
+          end
+        else if ToTypeBaseType=btPointer then
+          begin
+          if FromResolved.BaseType=btPointer then
+            Result:=cExact
+          else if FromResolved.BaseType=btContext then
+            begin
+            C:=FromResolved.TypeEl.ClassType;
+            if (C=TPasClassType)
+                or (C=TPasClassOfType)
+                or (C=TPasPointerType)
+                or ((C=TPasArrayType) and IsDynArray(FromResolved.TypeEl)) then
+              Result:=cExact;
+            end;
           end;
         end;
       end
     else if C=TPasClassType then
       begin
       // to class
-      if FromResolved.BaseType=btNil then
-        Result:=cExact
-      else if (FromResolved.BaseType=btContext)
-          and (FromResolved.TypeEl.ClassType=TPasClassType) then
+      if FromResolved.BaseType=btContext then
+        begin
+        if FromResolved.TypeEl.ClassType=TPasClassType then
+          begin
+          if FromResolved.IdentEl is TPasType then
+            RaiseMsg(20170404162606,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
+          // type cast upwards or downwards
+          Result:=CheckSrcIsADstType(FromResolved,ToResolved,ErrorEl);
+          if Result=cIncompatible then
+            Result:=CheckSrcIsADstType(ToResolved,FromResolved,ErrorEl);
+          if Result=cIncompatible then
+            Result:=CheckTypeCastClassInstanceToClass(FromResolved,ToResolved,ErrorEl);
+          end
+        end
+      else if FromResolved.BaseType=btPointer then
         begin
-        if (FromResolved.IdentEl is TPasType) then
-          RaiseMsg(20170404162606,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
-        // type cast upwards or downwards
-        Result:=CheckSrcIsADstType(FromResolved,ToResolved,ErrorEl);
-        if Result=cIncompatible then
-          Result:=CheckSrcIsADstType(ToResolved,FromResolved,ErrorEl);
-        if Result=cIncompatible then
-          Result:=CheckTypeCastClassInstanceToClass(FromResolved,ToResolved,ErrorEl);
+        if IsBaseType(FromResolved.TypeEl,btPointer) then
+          Result:=cExact; // untyped pointer to class instance
         end;
       end
     else if C=TPasClassOfType then
       begin
       //writeln('TPasResolver.CheckTypeCast class-of FromRes.TypeEl=',GetObjName(FromResolved.TypeEl),' FromRes.IdentEl=',GetObjName(FromResolved.IdentEl));
-      if (FromResolved.BaseType=btContext) then
+      if FromResolved.BaseType=btContext then
         begin
-        if (FromResolved.TypeEl.ClassType=TPasClassOfType) then
+        if FromResolved.TypeEl.ClassType=TPasClassOfType then
           begin
           if (FromResolved.IdentEl is TPasType) then
             RaiseMsg(20170404162604,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
@@ -10056,6 +10220,11 @@ begin
           FromClassType:=TPasClassOfType(FromResolved.TypeEl).DestType;
           Result:=CheckClassesAreRelated(ToClassType,FromClassType,ErrorEl);
           end;
+        end
+      else if FromResolved.BaseType=btPointer then
+        begin
+        if IsBaseType(FromResolved.TypeEl,btPointer) then
+          Result:=cExact; // untyped pointer to class-of
         end;
       end
     else if C=TPasEnumType then
@@ -10065,10 +10234,18 @@ begin
       end
     else if C=TPasArrayType then
       begin
-      if (FromResolved.BaseType=btContext)
-          and (FromResolved.TypeEl.ClassType=TPasArrayType) then
-        Result:=CheckTypeCastArray(TPasArrayType(FromResolved.TypeEl),
-          TPasArrayType(ToTypeEl),ErrorEl,RaiseOnError);
+      if FromResolved.BaseType=btContext then
+        begin
+        if FromResolved.TypeEl.ClassType=TPasArrayType then
+          Result:=CheckTypeCastArray(TPasArrayType(FromResolved.TypeEl),
+            TPasArrayType(ToTypeEl),ErrorEl,RaiseOnError);
+        end
+      else if FromResolved.BaseType=btPointer then
+        begin
+        if IsDynArray(ToResolved.TypeEl)
+            and IsBaseType(FromResolved.TypeEl,btPointer) then
+          Result:=cExact; // untyped pointer to dynnamic array
+        end;
       end;
     end
   else if ToTypeEl<>nil then
@@ -10595,11 +10772,21 @@ begin
 end;
 
 function TPasResolver.ResolveAliasType(aType: TPasType): TPasType;
+var
+  C: TClass;
 begin
   Result:=aType;
-  while (Result<>nil)
-      and ((Result.ClassType=TPasAliasType) or (Result.ClassType=TPasTypeAliasType)) do
-    Result:=TPasAliasType(Result).DestType;
+  while Result<>nil do
+    begin
+    C:=Result.ClassType;
+    if (C=TPasAliasType) or (C=TPasTypeAliasType) then
+      Result:=TPasAliasType(Result).DestType
+    else if (C=TPasClassType) and TPasClassType(Result).IsForward
+        and (Result.CustomData is TResolvedReference) then
+      Result:=TResolvedReference(Result.CustomData).Declaration as TPasType
+    else
+      exit;
+    end;
 end;
 
 function TPasResolver.ExprIsAddrTarget(El: TPasExpr): boolean;
@@ -10615,8 +10802,7 @@ var
 begin
   Result:=false;
   if El=nil then exit;
-  if not ((El.ClassType=TParamsExpr) or (El.ClassType=TPrimitiveExpr)
-      or (El.ClassType=TSelfExpr)) then
+  if not IsNameExpr(El) then
     exit;
   repeat
     Parent:=El.Parent;
@@ -10793,8 +10979,7 @@ begin
   Result:=false;
   if (Params=nil) or (Params.Kind<>pekFuncParams) then exit;
   Value:=Params.Value;
-  if (Value.ClassType<>TSelfExpr)
-      and ((Value.ClassType<>TPrimitiveExpr) or (TPrimitiveExpr(Value).Kind<>pekIdent)) then
+  if not IsNameExpr(Value) then
     exit;
   if not (Value.CustomData is TResolvedReference) then exit;
   Ref:=TResolvedReference(Value.CustomData);
@@ -10828,6 +11013,18 @@ begin
     Result:=2;
 end;
 
+function TPasResolver.HasTypeInfo(El: TPasType): boolean;
+begin
+  Result:=false;
+  if El=nil then exit;
+  if El.CustomData is TResElDataBaseType then
+    exit(true); // base type
+  if El.Parent=nil then exit;
+  if (El.Parent is TPasType) and not HasTypeInfo(TPasType(El.Parent)) then
+    exit;
+  Result:=true;
+end;
+
 function TPasResolver.CheckSrcIsADstType(const ResolvedSrcType,
   ResolvedDestType: TPasResolverResult; ErrorEl: TPasElement): integer;
 // finds distance between classes SrcType and DestType