diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index a869b634d5..dac722710a 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -1492,6 +1492,7 @@ type function GetObjName(o: TObject): string; function GetTreeDbg(El: TPasElement; Indent: integer = 0): string; function GetResolverResultDbg(const T: TPasResolverResult): string; +function GetClassAncestorsDbg(El: TPasClassType): string; function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string; procedure SetResolverIdentifier(out ResolvedType: TPasResolverResult; @@ -1676,6 +1677,42 @@ begin +']'; end; +function GetClassAncestorsDbg(El: TPasClassType): string; + + function GetClassDesc(C: TPasClassType): string; + var + Module: TPasModule; + begin + if C.IsExternal then + Result:='class external ' + else + Result:='class '; + Module:=C.GetModule; + if Module<>nil then + Result:=Result+Module.Name+'.'; + Result:=Result+C.FullName; + end; + +var + Scope, AncestorScope: TPasClassScope; + AncestorEl: TPasClassType; +begin + if El=nil then exit('nil'); + Result:=GetClassDesc(El); + if El.CustomData is TPasClassScope then + begin + Scope:=TPasClassScope(El.CustomData); + AncestorScope:=Scope.AncestorScope; + while AncestorScope<>nil do + begin + Result:=Result+LineEnding+' '; + AncestorEl:=AncestorScope.Element as TPasClassType; + Result:=Result+GetClassDesc(AncestorEl); + AncestorScope:=AncestorScope.AncestorScope; + end; + end; +end; + function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string; var f: TPasResolverResultFlag; @@ -6248,6 +6285,17 @@ begin SetBaseType(btBoolean); exit; end + else if CheckSrcIsADstType(LeftResolved,RightResolved,Bin)<>cIncompatible then + begin + // e.g. if Image is TObject then ; + // This is useful after some unchecked typecast -> allow + SetBaseType(btBoolean); + exit; + end; + {$IFDEF VerbosePasResolver} + writeln('TPasResolver.ComputeBinaryExpr LeftClass=',GetClassAncestorsDbg(TPasClassType(LeftResolved.TypeEl))); + writeln('TPasResolver.ComputeBinaryExpr RightClass=',GetClassAncestorsDbg(TPasClassType(RightResolved.IdentEl))); + {$ENDIF} end else if (RightResolved.TypeEl is TPasClassOfType) and (rrfReadable in RightResolved.Flags) then @@ -6258,7 +6306,7 @@ begin begin SetBaseType(btBoolean); exit; - end + end; end else RaiseXExpectedButYFound(20170216152625,'class type',RightResolved.TypeEl.ElementTypeName,Bin.right); diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index 5bce3fe52d..23ae9d7f11 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -5378,6 +5378,7 @@ begin Add('begin'); Add(' if {@o}o is {@A}TClassA then;'); Add(' if {@v}v is {@A}TClassA then;'); + Add(' if {@v}v is {@TOBJ}TObject then;'); Add(' if {@v}v.{@Sub}Sub is {@A}TClassA then;'); Add(' {@v}v:={@o}o as {@A}TClassA;'); ParseProgram;