+ add a flags field to the record init RTTI which declares whether

a) the current record contains a field with non-trivial initialization
    b) and of the parents contains such a field (only relevant for objects and classes)

git-svn-id: trunk@39255 -

compiler/ncgrtti.pas

@@ -65,6 +65,7 @@ interface
         procedure write_callconv(tcb:ttai_typedconstbuilder;def:tabstractprocdef);
         procedure write_paralocs(tcb:ttai_typedconstbuilder;para:pcgpara);
         procedure write_param_flag(tcb:ttai_typedconstbuilder;parasym:tparavarsym);
+        procedure write_record_init_flag(tcb:ttai_typedconstbuilder;value:longword);
       public
         constructor create;
         procedure write_rtti(def:tdef;rt:trttitype);
@@ -415,6 +416,16 @@ implementation
       end;
 
 
+    procedure TRTTIWriter.write_record_init_flag(tcb:ttai_typedconstbuilder;value:longword);
+      begin
+        { keep this in sync with the type declaration of TRecordInfoInitFlag(s)
+          in both rttidecl.inc and typinfo.pp }
+        if target_info.endian=endian_big then
+          value:=reverse_byte(value);
+        tcb.emit_ord_const(value,u32inttype);
+      end;
+
+
     procedure TRTTIWriter.write_rtti_name(tcb: ttai_typedconstbuilder; def: tdef);
       begin
          if is_open_array(def) then
@@ -1176,6 +1187,8 @@ implementation
             tcb.free;
           end;
 
+        var
+          riif : byte;
         begin
            write_header(tcb,def,tkRecord);
            { need extra reqalign record, because otherwise the u32 int will
@@ -1199,12 +1212,18 @@ implementation
 
            { store rtti management operators only for init table }
            if (rt=initrtti) then
-             if (trecordsymtable(def.symtable).managementoperators=[]) then
-               tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype)
-             else
-               tcb.emit_tai(Tai_const.Createname(
-                 internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),
-                 AT_DATA_FORCEINDIRECT,0),voidpointertype);
+             begin
+               riif:=0;
+               if def.has_non_trivial_init_child(false) then
+                 riif:=riif or riifNonTrivialChild;
+               write_record_init_flag(tcb,riif);
+               if (trecordsymtable(def.symtable).managementoperators=[]) then
+                 tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype)
+               else
+                 tcb.emit_tai(Tai_const.Createname(
+                   internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),
+                   AT_DATA_FORCEINDIRECT,0),voidpointertype);
+             end;
 
            fields_write_rtti_data(tcb,def,rt);
            tcb.end_anonymous_record;
@@ -1327,6 +1346,8 @@ implementation
         procedure objectdef_rtti(def: tobjectdef);
 
           procedure objectdef_rtti_fields(def:tobjectdef);
+          var
+            riif : byte;
           begin
             { - for compatiblity with record RTTI we need to write a terminator-
                 Nil pointer for initrtti as well for objects
@@ -1347,7 +1368,15 @@ implementation
             tcb.emit_ord_const(def.size, u32inttype);
             { pointer to management operators available only for initrtti }
             if (rt=initrtti) then
-              tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
+              begin
+                riif:=0;
+                if def.has_non_trivial_init_child(false) then
+                  riif:=riif or riifNonTrivialChild;
+                if assigned(def.childof) and def.childof.has_non_trivial_init_child(true) then
+                  riif:=riif or riifParentHasNonTrivialChild;
+                write_record_init_flag(tcb,riif);
+                tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
+              end;
             { enclosing record takes care of alignment }
             fields_write_rtti_data(tcb,def,rt);
           end;

compiler/symconst.pas

@@ -111,6 +111,9 @@ const
   pfVmt      = 1024;
   pfResult   = 2048;
 
+  riifNonTrivialChild          = 1;
+  riifParentHasNonTrivialChild = 2;
+
   unknown_level         = 0;
   main_program_level    = 1;
   normal_function_level = 2;

rtl/inc/rttidecl.inc

@@ -94,6 +94,25 @@ type
   end;
 {$endif FPC_HAS_MANAGEMENT_OPERATORS}
 
+{$ifndef VER3_0}
+{$push}
+
+{ better alignment for TRecordInfoInit }
+{ keep in sync with ncgrtti.TRTTIWriter.write_record_init_flag() and typinfo.pp }
+{ ToDo: different values for 8/16-bit platforms? }
+{$minenumsize 4}
+{$packset 4}
+
+  TRecordInfoInitFlag = (
+    riifNonTrivialChild,
+    { only relevant for classes }
+    riifParentHasNonTrivialChild
+  );
+  TRecordInfoInitFlags = set of TRecordInfoInitFlag;
+
+{$pop}
+{$endif}
+
   TRecordInfoInit=
 {$ifdef USE_PACKED}
   packed
@@ -102,6 +121,7 @@ type
     Terminator: Pointer;
     Size: Longint;
 {$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
+    Flags: TRecordInfoInitFlags;
     RecordOp: PRTTIRecordOpVMT;
 {$endif FPC_HAS_MANAGEMENT_OPERATORS}
     Count: Longint;

rtl/objpas/typinfo.pp

@@ -408,6 +408,26 @@ unit TypInfo;
         Entries: array[0..0] of TVmtMethodEntry;
       end;
 
+
+{$ifndef VER3_0}
+{$push}
+
+{ better alignment for TRecordInfoInit }
+{ keep in sync with ncgrtti.TRTTIWriter.write_record_init_flag() and rttidecl.inc }
+{ ToDo: different values for 8/16-bit platforms? }
+{$minenumsize 4}
+{$packset 4}
+
+      TRecordInfoInitFlag = (
+        riifNonTrivialChild,
+        { only relevant for classes }
+        riifParentHasNonTrivialChild
+      );
+      TRecordInfoInitFlags = set of TRecordInfoInitFlag;
+
+{$pop}
+{$endif}
+
       PRecInitData = ^TRecInitData;
       TRecInitData =
       {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
@@ -417,6 +437,7 @@ unit TypInfo;
         Terminator: Pointer;
         Size: Integer;
 {$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
+        Flags: TRecordInfoInitFlags;
         ManagementOp: Pointer;
 {$endif}
         ManagedFieldCount: Integer;