mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-15 19:39:33 +02:00
fcl-passrc: resolver: built-in function typeinfo
git-svn-id: trunk@35791 -
This commit is contained in:
Mattias Gaertner
parent
642ea28368
commit
a42fa05288
@ -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.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 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 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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user