diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc index 65e28b9261..ca48dd4bde 100644 --- a/rtl/inc/objpas.inc +++ b/rtl/inc/objpas.inc @@ -383,6 +383,7 @@ var vmt : PVmt; temp : pointer; + flags : TRecordInfoInitFlags; {$endif FPC_HAS_MANAGEMENT_OPERATORS} begin { the size is saved at offset 0 } @@ -399,10 +400,19 @@ while vmt<>nil do begin Temp:= vmt^.vInitTable; - { The RTTI format matches one for records, except the type is tkClass. - Since RecordRTTI does not check the type, calling it yields the desired result. } - if Assigned(Temp) then - RecordRTTI(Instance,Temp,@int_initialize); + if assigned(Temp) then + begin + flags:=RecordRTTIInitFlags(Temp); + if riifNonTrivialChild in flags then + { The RTTI format matches one for records, except the type + is tkClass. Since RecordRTTI does not check the type, + calling it yields the desired result. } + RecordRTTI(Instance,Temp,@int_initialize); + { no need to continue complex initializing up the inheritance + tree if none of the parents require it anyway } + if not (riifParentHasNonTrivialChild in flags) then + break; + end; vmt:= vmt^.vParent; end; {$endif FPC_HAS_MANAGEMENT_OPERATORS} diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc index fb0794c8bb..986e0f8bf9 100644 --- a/rtl/inc/rtti.inc +++ b/rtl/inc/rtti.inc @@ -137,6 +137,15 @@ begin end; +{$ifndef VER3_0} +function RecordRTTIInitFlags(ti: Pointer): TRecordInfoInitFlags; +begin + ti:=aligntoqword(ti+2+PByte(ti)[1]); + Result:=PRecordInfoInit(ti)^.Flags; +end; +{$endif VER3_0} + + { if you modify this procedure, fpc_copy must be probably modified as well } {$ifdef VER2_6} procedure ArrayRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc); diff --git a/rtl/inc/rttidecl.inc b/rtl/inc/rttidecl.inc index cd6ebce0a7..d5cb3a3f6e 100644 --- a/rtl/inc/rttidecl.inc +++ b/rtl/inc/rttidecl.inc @@ -149,6 +149,10 @@ type end; +{$ifndef VER3_0} +function RecordRTTIInitFlags(ti: Pointer): TRecordInfoInitFlags; forward; +{$endif VER3_0} + {$ifdef VER3_0} {$MINENUMSIZE DEFAULT} {$PACKSET DEFAULT}