View Issue Details

IDProjectCategoryView StatusLast Update
0030687FPCCompilerpublic2017-02-28 14:43
ReporterMaciej IzakAssigned ToMarco van de Voort 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Product Version3.1.1Product Build 
Target Version3.2.0Fixed in Version 
Summary0030687: [patch/feature] Management operators
DescriptionReady to use merged with latest FPC trunk implementation of management operators, consulted with Sven and Florian (few times on mailing list). Implementation tested on many platforms (Windows 32/64, Mac 32/64, Linux 32/64, Linux Aarch64, Android ARM6/7). Patch also pass all tests included with FPC without any regression.

Including this to trunk is very important for smart pointers implementation (even if FPC core team wants to reject my Smart Pointers implementation - management operators are independent). My work without management operators in trunk will be much harder (another feature to maintenance).

Precompiled version of compiler for testing purposes:
https://github.com/newpascal/freepascal/releases/tag/fpc4np-v1.0.25

Branch for management-operators:
https://github.com/maciej-izak/freepascal/commits/management-operators

Final result:
https://github.com/newpascal/freepascal/tree/release

Note: version of newpascal at newpascal.org with Lazarus IDE doesn't include this feature/compiler version yet.

Series of patches included with this bug report.
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files
  • 0001-Fix-small-typo-don-t-use-COPY-token-as-keyword.patch (5,417 bytes)
    From f687dedb86d89ffdf3db4ae03464b736f8eed791 Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Thu, 29 Sep 2016 23:25:25 +0200
    Subject: [PATCH 01/15] * Fix small typo - don't use 'COPY' token as keyword
    
    git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33118
    
    * New tokens for new record operators: Initialize, Copy and Finalize. Small adjustments in compiler for new tokens.
    
    git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33115
    ---
     compiler/pstatmnt.pas |  4 ++--
     compiler/symtable.pas |  3 +++
     compiler/tokens.pas   | 14 ++++++++++++++
     3 files changed, 19 insertions(+), 2 deletions(-)
    
    diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas
    index 0f3e232..1a74d3c 100644
    --- a/compiler/pstatmnt.pas
    +++ b/compiler/pstatmnt.pas
    @@ -1355,7 +1355,7 @@ implementation
              filepos:=current_tokenpos;
              consume(starttoken);
     
    -         while not(token in [_END,_FINALIZATION]) do
    +         while not((token = _END) or (token = _FINALIZATION)) do
                begin
                   if first=nil then
                     begin
    @@ -1367,7 +1367,7 @@ implementation
                        tstatementnode(last).right:=cstatementnode.create(statement,nil);
                        last:=tstatementnode(last).right;
                     end;
    -              if (token in [_END,_FINALIZATION]) then
    +              if ((token = _END) or (token = _FINALIZATION)) then
                     break
                   else
                     begin
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index 3a46c8b..3672b4d 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -422,6 +422,9 @@ interface
         { _ASSIGNMENT    }  'assign',
         { _OP_EXPLICIT   }  'explicit',
         { _OP_ENUMERATOR }  'enumerator',
    +    { _OP_INITIALIZE }  'initialize',
    +    { _OP_COPY       }  'copy',
    +    { _OP_FINALIZE   }  'finalize',    
         { _OP_INC        }  'inc',
         { _OP_DEC        }  'dec');
     
    diff --git a/compiler/tokens.pas b/compiler/tokens.pas
    index bb1d1eb..3283b5f 100644
    --- a/compiler/tokens.pas
    +++ b/compiler/tokens.pas
    @@ -56,6 +56,9 @@ type
         _ASSIGNMENT,
         _OP_EXPLICIT,
         _OP_ENUMERATOR,
    +    _OP_INITIALIZE,
    +    _OP_COPY,
    +    _OP_FINALIZE,    
         _OP_INC,
         _OP_DEC,
         { special chars }
    @@ -129,6 +132,7 @@ type
         _VAR,
         _XOR,
         _CASE,
    +    _COPY,
         _CVAR,
         _ELSE,
         _EXIT,
    @@ -220,6 +224,7 @@ type
         _CPPCLASS,
         _EXPLICIT,
         _EXTERNAL,
    +    _FINALIZE,
         _FUNCTION,
         _IMPLICIT,
         _LESSTHAN,
    @@ -271,6 +276,7 @@ type
         _DESTRUCTOR,
         _ENUMERATOR,
         _IMPLEMENTS,
    +    _INITIALIZE,
         _INTERNPROC,
         _LOGICALAND,
         _LOGICALNOT,
    @@ -320,6 +326,8 @@ const
       first_overloaded = succ(NOTOKEN);
       last_overloaded  = _OP_DEC;
       last_operator = _GENERICSPECIALTOKEN;
    +  first_managment_operator = _OP_INITIALIZE;
    +  last_managment_operator = _OP_FINALIZE;
     
       highest_precedence = oppower;
     
    @@ -379,6 +387,9 @@ const
           (str:':='            ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'explicit'      ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'enumerator'    ;special:true ;keyword:[m_none];op:NOTOKEN),
    +      (str:'initialize'    ;special:true ;keyword:[m_none];op:NOTOKEN),
    +      (str:'copy'          ;special:true ;keyword:[m_none];op:NOTOKEN),
    +      (str:'finalize'      ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'inc'           ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'dec'           ;special:true ;keyword:[m_none];op:NOTOKEN),
         { Special chars }
    @@ -452,6 +463,7 @@ const
           (str:'VAR'           ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
           (str:'XOR'           ;special:false;keyword:alllanguagemodes;op:_OP_XOR),
           (str:'CASE'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
    +      (str:'COPY'          ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'CVAR'          ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'ELSE'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
           (str:'EXIT'          ;special:false;keyword:[m_none];op:NOTOKEN),
    @@ -543,6 +555,7 @@ const
           (str:'CPPCLASS'      ;special:false;keyword:[m_fpc];op:NOTOKEN),
           (str:'EXPLICIT'      ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
           (str:'EXTERNAL'      ;special:false;keyword:[m_none];op:NOTOKEN),
    +      (str:'FINALIZE'      ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'FUNCTION'      ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
           (str:'IMPLICIT'      ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
           (str:'LESSTHAN'      ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
    @@ -594,6 +607,7 @@ const
           (str:'DESTRUCTOR'    ;special:false;keyword:alllanguagemodes-[m_iso,m_extpas];op:NOTOKEN),
           (str:'ENUMERATOR'    ;special:false;keyword:[m_none];op:_OP_ENUMERATOR),
           (str:'IMPLEMENTS'    ;special:false;keyword:[m_none];op:NOTOKEN),
    +      (str:'INITIALIZE'    ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'INTERNPROC'    ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'LOGICALAND'    ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
           (str:'LOGICALNOT'    ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
    -- 
    2.9.3.windows.2
    
    
  • 0002-Add-support-for-new-record-operators-management-oper.patch (41,318 bytes)
    From db3cd91bbdadb776103a87331682823df87a1b57 Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Fri, 30 Sep 2016 00:17:04 +0200
    Subject: [PATCH 02/15] Add support for new record operators (management
     operators): Initialize, Finalize. They working like low level auto-executed
     constructor/destructor for records.
    
    rtl/objpas/typinfo.pp, TTypeData:
      + new field RecInitTable, pointer to init table
    
    rtl/inc/rtti.inc:
      * rename TRecordInfo to TRecordInfoFull, is realated to fullrtti (rtti table)
      + new field for TRecordInfoFull: InitTable (pointer to init table)
      + new record TRecordInfoInit, related to initrtti (init table)
      + new record TRTTIRecordOpVMT to handle record management operators (has 2 reserved slots for addref and copy operators)
      + new function RTTIRecordOp to obtain init table pointer and record management operators (both are related)
      * adjust existing code to new RTTI. Affected functions: RecordRTTI, fpc_Initialize, fpc_finalize, fpc_Addref, fpc_Copy
    
    rtl/inc/objpas.inc, TObject.InitInstance:
      * allow to call Initialize operator for object fields
    
    tokens.pas:
      - temporary remove _OP_COPY token
    
    symtable.pas:
      + trecordsymtable: new field managementoperators for storing included management operators
      + trecordsymtable: new method includemanagementoperator to include new management operator
      + new function search_management_operator
      + new const managementoperator2tok for conversion tmanagementoperator to ttoken
    
    symdef.pas:
      * store set trecordsymtable.managementoperators into ppu file
      * add new condition into trecorddef.needs_inittable (returns true when any of management operators is used)
    
    symconst.pas:
      + new enum tmanagementoperator and related set tmanagementoperators for storing new operators Initialize, Finalize and for future operators: addref and copy
      + new item itp_init_record_operators in tinternaltypeprefix enum for storing management operators into init table
      + new position '$init_record_operators$' in internaltypeprefixName const, related to itp_init_record_operators
    
    ppu.pas:
      * increase ppu version (CurrentPPUVersion), related to new trecordsymtable.managementoperators
    
    pdecsub.pas:
      * add new operators tokens _INITIALIZE, _FINALIZE into parse_operator_name function
      * parse_proc_dec_finish: class operator is always static so always include po_staticmethod into pd.procoptions for potype_operator
      * parse_proc_dec_finish: parse in correct way new operators (first class operators without result)
    
    ncgrtti.pas:
      + new procedure write_record_operators for storing management operators
      * recorddef_rtti: init rtti and full rtti is different for better performance and for less memory usage (see TRecordInfoFull and TRecordInfoInit in rtl/inc/rtti.inc). Allow to save initrtti for fullrtti, guarantee initrtti for any record for fpc_initialize, fpc_finalize, fpc_copy and fpc_addref. Related to
    
    trtti10.pp test.
      * objectdef_rtti_fields: adjust rtti for objects to new rtti.
    
    htypechk.pas:
      + new Ttok2opRec record
      + new tok2op const for conversion ttoken to tmanagementoperator
      + new function token2managementoperator
    
    hlcgobj.pas, thlcgobj.initialize_data:
      * allow checking global variables (affects only records and classic pascal objects) for management operators. In the case of management operator, "initialize data node" is needed.
    
    + added tests
    git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33200
    ---
     compiler/htypechk.pas     |  24 ++++++++
     compiler/ncgrtti.pas      |  74 +++++++++++++++++++++++++
     compiler/ngenutil.pas     |  13 ++++-
     compiler/pdecsub.pas      |  82 ++++++++++++++++-----------
     compiler/symconst.pas     |  11 ++++
     compiler/symdef.pas       |   5 +-
     compiler/symtable.pas     |  50 ++++++++++++++++-
     compiler/tokens.pas       |   4 --
     rtl/inc/objpas.inc        |  16 ++++++
     rtl/inc/rtti.inc          |  84 ++++++++++++++++++++++++----
     rtl/objpas/typinfo.pp     |   1 +
     tests/test/tmoperator1.pp |  29 ++++++++++
     tests/test/tmoperator2.pp | 129 +++++++++++++++++++++++++++++++++++++++++++
     tests/test/tmoperator3.pp | 104 ++++++++++++++++++++++++++++++++++
     tests/test/tmoperator4.pp |  81 +++++++++++++++++++++++++++
     tests/test/tmoperator5.pp | 138 ++++++++++++++++++++++++++++++++++++++++++++++
     tests/test/tmoperator6.pp |  28 ++++++++++
     tests/test/tmoperator7.pp |  15 +++++
     18 files changed, 839 insertions(+), 49 deletions(-)
     create mode 100644 tests/test/tmoperator1.pp
     create mode 100644 tests/test/tmoperator2.pp
     create mode 100644 tests/test/tmoperator3.pp
     create mode 100644 tests/test/tmoperator4.pp
     create mode 100644 tests/test/tmoperator5.pp
     create mode 100644 tests/test/tmoperator6.pp
     create mode 100644 tests/test/tmoperator7.pp
    
    diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
    index a908d42..ec9bb07 100644
    --- a/compiler/htypechk.pas
    +++ b/compiler/htypechk.pas
    @@ -39,6 +39,11 @@ interface
             op_overloading_supported : boolean;
           end;
     
    +      Ttok2opRec=record
    +        tok : ttoken;
    +        managementoperator: tmanagementoperator;
    +      end;
    +
           pcandidate = ^tcandidate;
           tcandidate = record
              next         : pcandidate;
    @@ -132,10 +137,17 @@ interface
             (tok:_OP_DEC     ;nod:inlinen;inr:in_dec_x;op_overloading_supported:true) { unary overloading supported }
           );
     
    +      tok2ops=2;
    +      tok2op: array[1..tok2ops] of ttok2oprec = (
    +        (tok:_OP_INITIALIZE; managementoperator: mop_initialize),
    +        (tok:_OP_FINALIZE  ; managementoperator: mop_finalize)
    +      );
    +
           { true, if we are parsing stuff which allows array constructors }
           allow_array_constructor : boolean = false;
     
         function node2opstr(nt:tnodetype):string;
    +    function token2managementoperator(optoken : ttoken): tmanagementoperator;
     
         { check operator args and result type }
         function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
    @@ -217,6 +229,18 @@ implementation
                 end;
            end;
     
    +    function token2managementoperator(optoken: ttoken): tmanagementoperator;
    +      var
    +        i : integer;
    +      begin
    +        result:=mop_none;
    +        for i:=1 to tok2ops do
    +          if tok2op[i].tok=optoken then
    +            begin
    +              result:=tok2op[i].managementoperator;
    +              break;
    +            end;
    +      end;
     
         function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
     
    diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas
    index eafff74..6752527 100644
    --- a/compiler/ncgrtti.pas
    +++ b/compiler/ncgrtti.pas
    @@ -972,6 +972,51 @@ implementation
             end;
     
             procedure recorddef_rtti(def:trecorddef);
    +
    +          procedure write_record_operators;
    +          var
    +            rttilab: Tasmsymbol;
    +            rttidef: tdef;
    +            tcb: ttai_typedconstbuilder;
    +            mop: tmanagementoperator;
    +            procdef: tprocdef;
    +          begin
    +            rttilab := current_asmdata.DefineAsmSymbol(
    +                internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),
    +                AB_GLOBAL,AT_DATA);
    +            tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable]);
    +
    +            tcb.begin_anonymous_record(
    +              rttilab.Name,
    +              defaultpacking,reqalign,
    +              targetinfos[target_info.system]^.alignment.recordalignmin,
    +              targetinfos[target_info.system]^.alignment.maxCrecordalign
    +            );
    +
    +            { use "succ" to omit first enum item "mop_none" }
    +            for mop := succ(low(tmanagementoperator)) to high(tmanagementoperator) do
    +            begin
    +              if not (mop in trecordsymtable(def.symtable).managementoperators) then
    +                tcb.emit_tai(Tai_const.Create_nil_codeptr,voidcodepointertype)
    +              else
    +                begin
    +                  procdef := search_management_operator(mop, def);
    +                  if procdef = nil then
    +                    internalerror(201603021)
    +                  else
    +                    tcb.emit_tai(Tai_const.Createname(procdef.mangledname,AT_FUNCTION,0),
    +                      cprocvardef.getreusableprocaddr(procdef));
    +                end;
    +            end;
    +
    +            rttidef := tcb.end_anonymous_record;
    +
    +            current_asmdata.AsmLists[al_rtti].concatList(
    +              tcb.get_final_asmlist(rttilab,rttidef,sec_rodata,rttilab.name,
    +              const_align(sizeof(pint))));
    +            tcb.free;
    +          end;
    +
             begin
                write_header(tcb,def,tkRecord);
                { need extra reqalign record, because otherwise the u32 int will
    @@ -981,8 +1026,33 @@ implementation
                  targetinfos[target_info.system]^.alignment.recordalignmin,
                  targetinfos[target_info.system]^.alignment.maxCrecordalign);
                tcb.emit_ord_const(def.size,u32inttype);
    +
    +           { store rtti management operators only for init table }
    +           if (rt=initrtti) then
    +           begin
    +             tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
    +             if (trecordsymtable(def.symtable).managementoperators=[]) then
    +               tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype)
    +             else
    +               tcb.emit_tai(Tai_const.Createname(
    +                 internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),AT_DATA,0),voidpointertype);
    +           end else
    +           begin
    +             Include(def.defstates, ds_init_table_used);
    +             write_rtti_reference(tcb,def,initrtti);
    +           end;
    +
                fields_write_rtti_data(tcb,def,rt);
                tcb.end_anonymous_record;
    +
    +           { write pointers to operators if needed }
    +           if (rt=initrtti) and (trecordsymtable(def.symtable).managementoperators<>[]) then
    +             write_record_operators;
    +
    +           { guarantee initrtti for any record for fpc_initialize, fpc_finalize, fpc_copy and fpc_addref }
    +           if (rt = fullrtti) and (ds_init_table_used in def.defstates) and
    +              not (ds_init_table_written in def.defstates) then
    +             write_rtti(def, initrtti);
             end;
     
     
    @@ -1116,6 +1186,10 @@ implementation
               procedure objectdef_rtti_fields(def:tobjectdef);
               begin
                 tcb.emit_ord_const(def.size, u32inttype);
    +            { inittable terminator for vmt vInitTable }
    +            tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
    +            { pointer to management operators }
    +            tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
                 { enclosing record takes care of alignment }
                 fields_write_rtti_data(tcb,def,rt);
               end;
    diff --git a/compiler/ngenutil.pas b/compiler/ngenutil.pas
    index dfc3214..66e9aef 100644
    --- a/compiler/ngenutil.pas
    +++ b/compiler/ngenutil.pas
    @@ -308,7 +308,18 @@ implementation
     
       class procedure tnodeutils.sym_maybe_initialize(p: TObject; arg: pointer);
         begin
    -      if (tsym(p).typ = localvarsym) and
    +      if ((tsym(p).typ = localvarsym) or
    +          { check staticvarsym for record management opeators and for objects}
    +          ((tsym(p).typ = staticvarsym) and
    +           (
    +            (tabstractvarsym(p).vardef is trecorddef) or
    +            (
    +             (tabstractvarsym(p).vardef is tobjectdef) and
    +             (tobjectdef(tabstractvarsym(p).vardef).objecttype = odt_object)
    +            )
    +           )
    +          )
    +         ) and
              { local (procedure or unit) variables only need initialization if
                they are used }
              ((tabstractvarsym(p).refs>0) or
    diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
    index 837fb92..1ff290c 100644
    --- a/compiler/pdecsub.pas
    +++ b/compiler/pdecsub.pas
    @@ -596,6 +596,8 @@ implementation
                         _EXPLICIT:optoken:=_OP_EXPLICIT;
                         _INC:optoken:=_OP_INC;
                         _DEC:optoken:=_OP_DEC;
    +                    _INITIALIZE:optoken:=_OP_INITIALIZE;
    +                    _FINALIZE:optoken:=_OP_FINALIZE;
                         else
                         if (m_delphi in current_settings.modeswitches) then
                           case lastidtoken of
    @@ -1407,7 +1409,11 @@ implementation
                   if pd.parast.symtablelevel>normal_function_level then
                     Message(parser_e_no_local_operator);
                   if isclassmethod then
    +              begin
                     include(pd.procoptions,po_classmethod);
    +                { any class operator is also static }
    +                include(pd.procoptions,po_staticmethod);
    +              end;
                   if token<>_ID then
                     begin
                        if not(m_result in current_settings.modeswitches) then
    @@ -1418,40 +1424,54 @@ implementation
                       pd.resultname:=stringdup(orgpattern);
                       consume(_ID);
                     end;
    -              if not try_to_consume(_COLON) then
    +
    +              { operators without result }
    +              if optoken in [_OP_INITIALIZE, _OP_FINALIZE] then
                     begin
    -                  consume(_COLON);
    -                  pd.returndef:=generrordef;
    -                  consume_all_until(_SEMICOLON);
    +                  if (pd.parast.SymList.Count <> 1) or
    +                     (tparavarsym(pd.parast.SymList[0]).vardef<>pd.struct) or
    +                     (tparavarsym(pd.parast.SymList[0]).varspez<>vs_var) then
    +                    Message(parser_e_overload_impossible);
    +
    +                  trecordsymtable(pd.procsym.Owner).includemanagementoperator(
    +                    token2managementoperator(optoken));
    +                  pd.returndef:=voidtype
                     end
                   else
    -               begin
    -                 read_returndef(pd);
    -                 { check that class operators have either return type of structure or }
    -                 { at least one argument of that type                                 }
    -                 if (po_classmethod in pd.procoptions) and
    -                    (pd.returndef <> pd.struct) then
    -                   begin
    -                     found:=false;
    -                     for i := 0 to pd.parast.SymList.Count - 1 do
    -                       if tparavarsym(pd.parast.SymList[i]).vardef=pd.struct then
    -                         begin
    -                           found:=true;
    -                           break;
    -                         end;
    -                     if not found then
    -                       if assigned(pd.struct) then
    -                         Message1(parser_e_at_least_one_argument_must_be_of_type,pd.struct.RttiName)
    -                       else
    -                         MessagePos(pd.fileinfo,type_e_type_id_expected);
    -                   end;
    -                 if (optoken in [_ASSIGNMENT,_OP_EXPLICIT]) and
    -                    equal_defs(pd.returndef,tparavarsym(pd.parast.SymList[0]).vardef) and
    -                    (pd.returndef.typ<>undefineddef) and (tparavarsym(pd.parast.SymList[0]).vardef.typ<>undefineddef) then
    -                   message(parser_e_no_such_assignment)
    -                 else if not isoperatoracceptable(pd,optoken) then
    -                   Message(parser_e_overload_impossible);
    -               end;
    +                if not try_to_consume(_COLON) then
    +                  begin
    +                    consume(_COLON);
    +                    pd.returndef:=generrordef;
    +                    consume_all_until(_SEMICOLON);
    +                  end
    +                else
    +                 begin
    +                   read_returndef(pd);
    +                   { check that class operators have either return type of structure or }
    +                   { at least one argument of that type                                 }
    +                   if (po_classmethod in pd.procoptions) and
    +                      (pd.returndef <> pd.struct) then
    +                     begin
    +                       found:=false;
    +                       for i := 0 to pd.parast.SymList.Count - 1 do
    +                         if tparavarsym(pd.parast.SymList[i]).vardef=pd.struct then
    +                           begin
    +                             found:=true;
    +                             break;
    +                           end;
    +                       if not found then
    +                         if assigned(pd.struct) then
    +                           Message1(parser_e_at_least_one_argument_must_be_of_type,pd.struct.RttiName)
    +                         else
    +                           MessagePos(pd.fileinfo,type_e_type_id_expected);
    +                     end;
    +                   if (optoken in [_ASSIGNMENT,_OP_EXPLICIT]) and
    +                      equal_defs(pd.returndef,tparavarsym(pd.parast.SymList[0]).vardef) and
    +                      (pd.returndef.typ<>undefineddef) and (tparavarsym(pd.parast.SymList[0]).vardef.typ<>undefineddef) then
    +                     message(parser_e_no_such_assignment)
    +                   else if not isoperatoracceptable(pd,optoken) then
    +                     Message(parser_e_overload_impossible);
    +                 end;
                 end;
               else
                 internalerror(2015052202);
    diff --git a/compiler/symconst.pas b/compiler/symconst.pas
    index e043ac7..d7a1899 100644
    --- a/compiler/symconst.pas
    +++ b/compiler/symconst.pas
    @@ -582,6 +582,15 @@ type
       );
       tvaroptions=set of tvaroption;
     
    +  tmanagementoperator=(mop_none,
    +    mop_initialize,
    +    mop_finalize,
    +    { reserved for future usage }
    +    mop_addref,
    +    mop_copy
    +  );
    +  tmanagementoperators=set of tmanagementoperator;
    +
       { register variable }
       tvarregable=(vr_none,
         vr_intreg,
    @@ -701,6 +710,7 @@ type
         itp_rtti_normal_array,
         itp_rtti_dyn_array,
         itp_rtti_proc_param,
    +    itp_init_record_operators,
         itp_rtti_enum_size_start_rec,
         itp_rtti_enum_min_max_rec,
         itp_rtti_enum_basetype_array_rec,
    @@ -842,6 +852,7 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
            '$rtti_normal_array$',
            '$rtti_dyn_array$',
            '$rtti_proc_param$',
    +       '$init_record_operators$',
            '$rtti_enum_size_start_rec$',
            '$rtti_enum_min_max_rec$',
            '$rtti_enum_basetype_array_rec$',
    diff --git a/compiler/symdef.pas b/compiler/symdef.pas
    index e264845..5a230b6 100644
    --- a/compiler/symdef.pas
    +++ b/compiler/symdef.pas
    @@ -4436,6 +4436,7 @@ implementation
                  trecordsymtable(symtable).recordalignmin:=shortint(ppufile.getbyte);
                  trecordsymtable(symtable).datasize:=ppufile.getasizeint;
                  trecordsymtable(symtable).paddingsize:=ppufile.getword;
    +             ppufile.getsmallset(trecordsymtable(symtable).managementoperators);
                  trecordsymtable(symtable).ppuload(ppufile);
                  { the variantrecdesc is needed only for iso-like new statements new(prec,1,2,3 ...);
                    but because iso mode supports no units, there is no need to store the variantrecdesc
    @@ -4494,7 +4495,8 @@ implementation
     
         function trecorddef.needs_inittable : boolean;
           begin
    -        needs_inittable:=trecordsymtable(symtable).needs_init_final
    +        needs_inittable:=(trecordsymtable(symtable).managementoperators<>[]) or
    +          trecordsymtable(symtable).needs_init_final
           end;
     
         function trecorddef.needs_separate_initrtti : boolean;
    @@ -4581,6 +4583,7 @@ implementation
                  ppufile.putbyte(byte(trecordsymtable(symtable).recordalignmin));
                  ppufile.putasizeint(trecordsymtable(symtable).datasize);
                  ppufile.putword(trecordsymtable(symtable).paddingsize);
    +             ppufile.putsmallset(trecordsymtable(symtable).managementoperators);
                  { the variantrecdesc is needed only for iso-like new statements new(prec,1,2,3 ...);
                    but because iso mode supports no units, there is no need to store the variantrecdesc
                    in the ppu
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index 3672b4d..1f07544 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -135,8 +135,15 @@ interface
     
            trecordsymtable = class(tabstractrecordsymtable)
            public
    +          { maybe someday is worth to move managementoperators to              }
    +          { tabstractrecordsymtable to perform management class operators for  }
    +          { object/classes. In XE5 and newer is possible to use class operator }
    +          { for classes (like for Delphi .NET before) only for Delphi NEXTGEN  }
    +          managementoperators : tmanagementoperators;
    +
               constructor create(const n:string;usealign,recordminalign,recordmaxCalign:shortint);
               procedure insertunionst(unionst : trecordsymtable;offset : longint);
    +          procedure includemanagementoperator(mop:tmanagementoperator);
            end;
     
            tObjectSymtable = class(tabstractrecordsymtable)
    @@ -339,6 +346,7 @@ interface
         function  search_struct_member_no_helper(pd : tabstractrecorddef;const s : string):tsym;
         function  search_assignment_operator(from_def,to_def:Tdef;explicit:boolean):Tprocdef;
         function  search_enumerator_operator(from_def,to_def:Tdef):Tprocdef;
    +    function  search_management_operator(mop:tmanagementoperator;pd:Tdef):Tprocdef;
         { searches for the helper definition that's currently active for pd }
         function  search_last_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean;
         { searches whether the symbol s is available in the currently active }
    @@ -423,11 +431,18 @@ interface
         { _OP_EXPLICIT   }  'explicit',
         { _OP_ENUMERATOR }  'enumerator',
         { _OP_INITIALIZE }  'initialize',
    -    { _OP_COPY       }  'copy',
         { _OP_FINALIZE   }  'finalize',    
         { _OP_INC        }  'inc',
         { _OP_DEC        }  'dec');
     
    +      managementoperator2tok:array[tmanagementoperator] of ttoken = (
    +    { mop_none       }  NOTOKEN,
    +    { mop_initialize }  _OP_INITIALIZE,
    +    { mop_finalize   }  _OP_FINALIZE,
    +
    +    { reserved for future usage }
    +    { mop_addref     }  NOTOKEN,
    +    { mop_copy       }  NOTOKEN);
     
     
     implementation
    @@ -1728,6 +1743,14 @@ implementation
           end;
     
     
    +    procedure trecordsymtable.includemanagementoperator(mop: tmanagementoperator);
    +      begin
    +        if mop in managementoperators then
    +          exit;
    +        include(managementoperators,mop);
    +      end;
    +
    +
     {****************************************************************************
                                   TObjectSymtable
     ****************************************************************************}
    @@ -3750,6 +3773,31 @@ implementation
         end;
     
     
    +    function search_management_operator(mop: tmanagementoperator; pd: Tdef): Tprocdef;
    +      var
    +        sym : Tprocsym;
    +        hashedid : THashedIDString;
    +        optoken: ttoken;
    +      begin
    +        optoken := managementoperator2tok[mop];
    +        if (optoken<first_managment_operator) or
    +           (optoken>last_managment_operator) then
    +          internalerror(201602280);
    +        hashedid.id:=overloaded_names[optoken];
    +        if not (pd.typ in [recorddef]) then
    +          internalerror(201602281);
    +        sym:=Tprocsym(tabstractrecorddef(pd).symtable.FindWithHash(hashedid));
    +        if sym<>nil then
    +          begin
    +            if sym.typ<>procsym then
    +              internalerror(201602282);
    +            result:=sym.find_procdef_bytype(potype_operator);
    +          end
    +        else
    +          result:=nil;
    +      end;
    +
    +
         function search_system_type(const s: TIDString): ttypesym;
           var
             sym : tsym;
    diff --git a/compiler/tokens.pas b/compiler/tokens.pas
    index 3283b5f..d98a626 100644
    --- a/compiler/tokens.pas
    +++ b/compiler/tokens.pas
    @@ -57,7 +57,6 @@ type
         _OP_EXPLICIT,
         _OP_ENUMERATOR,
         _OP_INITIALIZE,
    -    _OP_COPY,
         _OP_FINALIZE,    
         _OP_INC,
         _OP_DEC,
    @@ -132,7 +131,6 @@ type
         _VAR,
         _XOR,
         _CASE,
    -    _COPY,
         _CVAR,
         _ELSE,
         _EXIT,
    @@ -388,7 +386,6 @@ const
           (str:'explicit'      ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'enumerator'    ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'initialize'    ;special:true ;keyword:[m_none];op:NOTOKEN),
    -      (str:'copy'          ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'finalize'      ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'inc'           ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'dec'           ;special:true ;keyword:[m_none];op:NOTOKEN),
    @@ -463,7 +460,6 @@ const
           (str:'VAR'           ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
           (str:'XOR'           ;special:false;keyword:alllanguagemodes;op:_OP_XOR),
           (str:'CASE'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
    -      (str:'COPY'          ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'CVAR'          ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'ELSE'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
           (str:'EXIT'          ;special:false;keyword:[m_none];op:NOTOKEN),
    diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc
    index f8157a8..0e3caf4 100644
    --- a/rtl/inc/objpas.inc
    +++ b/rtl/inc/objpas.inc
    @@ -379,6 +379,9 @@
     
           class function TObject.InitInstance(instance : pointer) : tobject; {$ifdef SYSTEMINLINE} inline; {$ENDIF}
     
    +        var
    +           vmt  : PVmt;
    +           temp : pointer;
             begin
                { the size is saved at offset 0 }
                fillchar(instance^, InstanceSize, 0);
    @@ -387,6 +390,19 @@
                ppointer(instance)^:=pointer(self);
                if {$ifdef VER3_0}PVmt(self)^.vIntfTable <> @emptyintf{$else}assigned(PVmt(self)^.vIntfTable){$endif} then
                  InitInterfacePointers(self,instance);
    +
    +           { for record operators like initialize/finalize call int_initialize }
    +           vmt := PVmt(self);
    +           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);
    +               vmt:= vmt^.vParent;
    +             end;
    +
                InitInstance:=TObject(Instance);
             end;
     
    diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
    index 6587bad..7104618 100644
    --- a/rtl/inc/rtti.inc
    +++ b/rtl/inc/rtti.inc
    @@ -42,13 +42,41 @@ type
         {$endif}
       end;
     
    -  PRecordInfo=^TRecordInfo;
    -  TRecordInfo=
    +  PRecordInfoFull=^TRecordInfoFull;
    +  TRecordInfoFull=
     {$ifdef USE_PACKED}
       packed
     {$endif USE_PACKED}
       record
         Size: Longint;
    +    InitTable: Pointer;
    +    Count: Longint;
    +    { Elements: array[count] of TRecordElement }
    +  end;
    +
    +  TRTTIRecInitFiniOp=procedure(ARec: Pointer);
    +
    +  PRTTIRecordOpVMT=^TRTTIRecordOpVMT;
    +  TRTTIRecordOpVMT=
    +{$ifdef USE_PACKED}
    +  packed
    +{$endif USE_PACKED}
    +  record
    +    Initialize: TRTTIRecInitFiniOp;
    +    Finalize: TRTTIRecInitFiniOp;
    +    Reserved1: CodePointer;
    +    Reserved2: CodePointer;
    +  end;
    +
    +  PRecordInfoInit=^TRecordInfoInit;
    +  TRecordInfoInit=
    +{$ifdef USE_PACKED}
    +  packed
    +{$endif USE_PACKED}
    +  record
    +    Size: Longint;
    +    Terminator: Pointer;
    +    RecordOp: PRTTIRecordOpVMT;
         Count: Longint;
         { Elements: array[count] of TRecordElement }
       end;
    @@ -83,7 +111,23 @@ end;
     function RTTIRecordSize(typeInfo: Pointer): SizeInt;
     begin
       typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
    -  result:=PRecordInfo(typeInfo)^.Size;
    +  result:=PRecordInfoFull(typeInfo)^.Size;
    +end;
    +
    +function RTTIRecordOp(typeInfo: Pointer; var initrtti: Pointer): PRecordInfoInit; inline;
    +begin
    +  { find init table and management operators }
    +  typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
    +  result:=typeInfo;
    +
    +  { check terminator, maybe we are already in init table }
    +  if Assigned(result^.Terminator) then
    +  begin
    +    { point to more optimal initrtti }
    +    initrtti:=PRecordInfoFull(result)^.InitTable;
    +    { and point to management operators in our init table }
    +    result:=aligntoptr(initrtti+2+PByte(initrtti)[1]);
    +  end
     end;
     
     function RTTISize(typeInfo: Pointer): SizeInt;
    @@ -112,8 +156,8 @@ var
       i : longint;
     begin
       typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
    -  Count:=PRecordInfo(typeInfo)^.Count;
    -  Inc(PRecordInfo(typeInfo));
    +  Count:=PRecordInfoInit(typeInfo)^.Count;
    +  Inc(PRecordInfoInit(typeInfo));
       { Process elements }
       for i:=1 to count Do
         begin
    @@ -173,7 +217,13 @@ begin
         tkObject,
     {$endif FPC_HAS_FEATURE_OBJECTS}
         tkRecord:
    -      recordrtti(data,typeinfo,@int_initialize);
    +      { if possible try to use more optimal initrtti }
    +      with RTTIRecordOp(typeinfo, typeinfo)^ do
    +      begin
    +        recordrtti(data,typeinfo,@int_initialize);
    +        if Assigned(recordop) and Assigned(recordop^.Initialize) then
    +          recordop^.Initialize(data);
    +      end;
     {$ifdef FPC_HAS_FEATURE_VARIANTS}
         tkVariant:
           variant_init(PVarData(Data)^);
    @@ -203,7 +253,13 @@ begin
         tkObject,
     {$endif FPC_HAS_FEATURE_OBJECTS}
         tkRecord:
    -      recordrtti(data,typeinfo,@int_finalize);
    +      { if possible try to use more optimal initrtti }
    +      with RTTIRecordOp(typeinfo, typeinfo)^ do
    +      begin
    +        if Assigned(recordop) and Assigned(recordop^.Finalize) then
    +          recordop^.Finalize(data);
    +        recordrtti(data,typeinfo,@int_finalize);
    +      end;
         tkInterface:
           Intf_Decr_Ref(PPointer(Data)^);
     {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
    @@ -239,7 +295,11 @@ begin
         tkobject,
     {$endif FPC_HAS_FEATURE_OBJECTS}
         tkrecord :
    -      recordrtti(data,typeinfo,@int_addref);
    +      begin
    +        { find init table }
    +        RTTIRecordOp(typeinfo, typeinfo);
    +        recordrtti(data,typeinfo,@int_addref);
    +      end;
     {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
         tkDynArray:
           fpc_dynarray_incr_ref(PPointer(Data)^);
    @@ -311,11 +371,13 @@ begin
     {$endif FPC_HAS_FEATURE_OBJECTS}
         tkrecord:
           begin
    +        { find init table }
    +        RTTIRecordOp(typeinfo, typeinfo);
             Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
     
    -        Result:=PRecordInfo(Temp)^.Size;
    -        Count:=PRecordInfo(Temp)^.Count;
    -        Inc(PRecordInfo(Temp));
    +        Result:=PRecordInfoInit(Temp)^.Size;
    +        Count:=PRecordInfoInit(Temp)^.Count;
    +        Inc(PRecordInfoInit(Temp));
             expectedoffset:=0;
             { Process elements with rtti }
             for i:=1 to count Do
    diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp
    index 6517913..2b66803 100644
    --- a/rtl/objpas/typinfo.pp
    +++ b/rtl/objpas/typinfo.pp
    @@ -312,6 +312,7 @@ unit typinfo;
                 tkRecord:
                   (
                     RecSize: Integer;
    +                RecInitTable: Pointer;
                     ManagedFldCount: Integer;
                     {ManagedFields: array[1..ManagedFldCount] of TManagedField}
                   );
    diff --git a/tests/test/tmoperator1.pp b/tests/test/tmoperator1.pp
    new file mode 100644
    index 0000000..2fb3ac3
    --- /dev/null
    +++ b/tests/test/tmoperator1.pp
    @@ -0,0 +1,29 @@
    +{ %NORUN }
    +
    +program tmoperator1;
    +
    +{$MODE OBJFPC}
    +{$modeswitch advancedrecords}
    +
    +type
    +
    +  { TFoo }
    +
    +  TFoo = record
    +  private
    +    class operator Initialize(var aFoo: TFoo);
    +    class operator Finalize(var aFoo: TFoo);
    +  end;
    +
    +{ TFoo }
    +
    +class operator TFoo.Initialize(var aFoo: TFoo);
    +begin
    +end;
    +
    +class operator TFoo.Finalize(var aFoo: TFoo);
    +begin
    +end;
    +
    +begin
    +end. 
    \ No newline at end of file
    diff --git a/tests/test/tmoperator2.pp b/tests/test/tmoperator2.pp
    new file mode 100644
    index 0000000..4721430
    --- /dev/null
    +++ b/tests/test/tmoperator2.pp
    @@ -0,0 +1,129 @@
    +program tmoperator2;
    +
    +{$MODE DELPHI}
    +
    +type
    +
    +  { TFoo }
    +
    +  PFoo = ^TFoo;
    +  TFoo = record
    +  private
    +    class operator Initialize(var aFoo: TFoo);
    +    class operator Finalize(var aFoo: TFoo);
    +  public
    +    F: Integer;
    +    S: string;
    +  end;
    +
    +{ TFoo }
    +
    +class operator TFoo.Initialize(var aFoo: TFoo);
    +begin
    +  WriteLn;
    +  WriteLn('TFoo.Initialize');
    +  if aFoo.S <> '' then
    +    Halt(1);
    +  aFoo.F := 1;
    +  aFoo.S := 'A';
    +end;
    +
    +class operator TFoo.Finalize(var aFoo: TFoo);
    +begin
    +  if aFoo.F <> 2 then
    +    Halt(2);
    +  if aFoo.S <> 'B' then
    +    Halt(3);
    +  aFoo.F := 3;
    +  WriteLn('TFoo.Finalize');
    +  WriteLn;
    +end;
    +
    +{ TBar }
    +type 
    +  TBar = class
    +  private 
    +    F: TFoo;
    +  end;
    +
    +procedure Foo();
    +var
    +  F: TFoo;
    +begin
    +  if F.F <> 1 then
    +    Halt(4);
    +  if F.S <> 'A' then
    +    Halt(5);
    +  F.F := 2;
    +  F.S := 'B';
    +end;
    +
    +var
    +  F: TFoo;
    +  B: TBar;
    +  PF: PFoo;
    +begin
    +  WriteLn('=== Global variable [begin] ===');
    +  WriteLn;
    +  
    +  if F.F <> 1 then
    +    Halt(6);
    +
    +  if F.S <> 'A' then
    +    Halt(7);
    +    
    +  WriteLn('=== Local variable ===');
    +  Foo();  
    +    
    +  WriteLn('=== Field in class ===');
    +  B := TBar.Create();
    +  if B.F.F <> 1 then
    +    Halt(8);
    +  if B.F.S <> 'A' then
    +    Halt(9);
    +  B.F.F := 2;
    +  B.F.S := 'B';
    +  B.Free; 
    +    
    +  WriteLn('=== New and Dispose ===');
    +  New(PF);
    +  if PF^.F <> 1 then
    +    Halt(10);
    +  if PF^.S <> 'A' then
    +    Halt(11);
    +  PF^.F := 2;
    +  PF^.S := 'B';
    +  Dispose(PF); 
    +  
    +  WriteLn('=== InitializeArray and FinalizeArray ===');
    +  GetMem(PF, SizeOf(TFoo));
    +  InitializeArray(PF, TypeInfo(TFoo), 1);
    +  if PF^.F <> 1 then
    +    Halt(12);
    +  if PF^.S <> 'A' then
    +    Halt(13);
    +  PF^.F := 2;  
    +  PF^.S := 'B';  
    +  FinalizeArray(PF, TypeInfo(TFoo), 1);
    +  if PF^.F <> 3 then
    +    Halt(14);
    +  FreeMem(PF);
    +
    +  WriteLn('=== Initialize and Finalize ===');
    +  GetMem(PF, SizeOf(TFoo));
    +  Initialize(PF^);
    +  if PF^.F <> 1 then
    +    Halt(15);
    +  if PF^.S <> 'A' then
    +    Halt(16);
    +  PF^.F := 2;  
    +  PF^.S := 'B';  
    +  Finalize(PF^);
    +  if PF^.F <> 3 then
    +    Halt(17);
    +  FreeMem(PF);
    +    
    +  WriteLn('=== Global variable [end] ===');
    +  F.F := 2;
    +  F.S := 'B';
    +end. 
    \ No newline at end of file
    diff --git a/tests/test/tmoperator3.pp b/tests/test/tmoperator3.pp
    new file mode 100644
    index 0000000..ae28d02
    --- /dev/null
    +++ b/tests/test/tmoperator3.pp
    @@ -0,0 +1,104 @@
    +program tmoperator3;
    +
    +{$MODE DELPHI}
    +
    +type
    +
    +  { TFoo }
    +
    +  PFoo = ^TFoo;
    +  TFoo = record
    +  private
    +    class operator Initialize(var aFoo: TFoo);
    +    class operator Finalize(var aFoo: TFoo);
    +  public
    +    F: Integer;
    +  end;
    +
    +{ TFoo }
    +
    +class operator TFoo.Initialize(var aFoo: TFoo);
    +begin
    +  WriteLn;
    +  WriteLn('TFoo.Initialize');
    +  aFoo.F := 1;
    +end;
    +
    +class operator TFoo.Finalize(var aFoo: TFoo);
    +begin
    +  if aFoo.F <> 2 then
    +    Halt(2);
    +  aFoo.F := 3;
    +  WriteLn('TFoo.Finalize');
    +  WriteLn;
    +end;
    +
    +{ TBar }
    +type 
    +  TBar = class
    +  private 
    +    F: TFoo;
    +  end;
    +
    +procedure Foo();
    +var
    +  F: TFoo;
    +begin
    +  if F.F <> 1 then
    +    Halt(3);
    +  F.F := 2;
    +end;
    +
    +var
    +  F: TFoo;
    +  B: TBar;
    +  PF: PFoo;
    +begin
    +  WriteLn('=== Global variable [begin] ===');
    +  WriteLn;
    +  
    +  if F.F <> 1 then
    +    Halt(4);
    +    
    +  WriteLn('=== Local variable ===');
    +  Foo();  
    +    
    +  WriteLn('=== Field in class ===');
    +  B := TBar.Create();
    +  if B.F.F <> 1 then
    +    Halt(5);
    +  B.F.F := 2;
    +  B.Free; 
    +    
    +  WriteLn('=== New and Dispose ===');
    +  New(PF);
    +  if PF.F <> 1 then
    +    Halt(6);
    +  PF^.F := 2;
    +  Dispose(PF); 
    +  
    +  WriteLn('=== InitializeArray and FinalizeArray ===');
    +  GetMem(PF, SizeOf(TFoo));
    +  InitializeArray(PF, TypeInfo(TFoo), 1);
    +  if PF.F <> 1 then
    +    Halt(7);
    +  PF^.F := 2;  
    +  FinalizeArray(PF, TypeInfo(TFoo), 1);
    +  if PF^.F <> 3 then
    +    Halt(8);
    +  FreeMem(PF);
    +
    +  WriteLn('=== Initialize and Finalize ===');
    +  GetMem(PF, SizeOf(TFoo));
    +  Initialize(PF^);
    +  if PF.F <> 1 then
    +    Halt(9);
    +  PF^.F := 2;  
    +  Finalize(PF^);
    +  if PF^.F <> 3 then
    +    Halt(10);
    +  FreeMem(PF);
    +    
    +  F.F := 2;
    +  WriteLn('=== Global variable [end] ===');
    +end. 
    \ No newline at end of file
    diff --git a/tests/test/tmoperator4.pp b/tests/test/tmoperator4.pp
    new file mode 100644
    index 0000000..e624003
    --- /dev/null
    +++ b/tests/test/tmoperator4.pp
    @@ -0,0 +1,81 @@
    +program tmoperator4;
    +
    +{$MODE DELPHI}
    +
    +type
    +  TR1 = record
    +  private
    +    class operator Initialize(var aR1: TR1);
    +    class operator Finalize(var aR1: TR1);
    +  public
    +    I: Integer;
    +  end;
    +
    +  TR2 = record
    +  private
    +    class operator Initialize(var aR2: TR2);
    +    class operator Finalize(var aR2: TR2);
    +  public
    +    S: string;
    +  end;
    +
    +{ TR1 }
    +
    +class operator TR1.Initialize(var aR1: TR1);
    +begin
    +  WriteLn('TR1.Initialize');
    +  aR1.I := 1;
    +end;
    +
    +class operator TR1.Finalize(var aR1: TR1);
    +begin
    +  if aR1.I <> 2 then
    +    Halt(1);
    +  WriteLn('TR1.Finalize');
    +end;
    +
    +{ TR2 }
    +
    +class operator TR2.Initialize(var aR2: TR2);
    +begin
    +  WriteLn('TR2.Initialize');
    +  aR2.S := 'A';
    +end;
    +
    +class operator TR2.Finalize(var aR2: TR2);
    +begin
    +  if aR2.S <> 'B' then
    +    Halt(2);
    +  WriteLn('TR2.Finalize');
    +end;
    +
    +{ TA }
    +
    +type 
    +  TA = class
    +  public 
    +    F1: TR1;
    +  end;
    +
    +  TB = class(TA)
    +  public
    +    F2: TR2;
    +  end;
    +
    +var
    +  O: TB;
    +begin
    +  O := TB.Create;
    +  
    +  if O.F1.I <> 1 then
    +    Halt(3);
    +  if O.F2.S <> 'A' then
    +    Halt(4);
    +    
    +  O.F1.I := 2;
    +  O.F2.S := 'B'; 
    +  
    +  O.Free;
    +  
    +  WriteLn('end');
    +end. 
    \ No newline at end of file
    diff --git a/tests/test/tmoperator5.pp b/tests/test/tmoperator5.pp
    new file mode 100644
    index 0000000..bc7d386
    --- /dev/null
    +++ b/tests/test/tmoperator5.pp
    @@ -0,0 +1,138 @@
    +program tmoperator5;
    +
    +{$MODE DELPHI}
    +
    +type
    +  TR1 = record
    +  private
    +    class operator Initialize(var aR1: TR1);
    +    class operator Finalize(var aR1: TR1);
    +  public
    +    I: Integer;
    +  end;
    +
    +  TR2 = record
    +  private
    +    class operator Initialize(var aR2: TR2);
    +    class operator Finalize(var aR2: TR2);
    +  public
    +    S: string;
    +  end;
    +
    +{ TR1 }
    +
    +class operator TR1.Initialize(var aR1: TR1);
    +begin
    +  WriteLn('TR1.Initialize');
    +  aR1.I := 1;
    +end;
    +
    +class operator TR1.Finalize(var aR1: TR1);
    +begin
    +  if aR1.I <> 2 then
    +    Halt(1);
    +  aR1.I := 3;
    +  WriteLn('TR1.Finalize');
    +end;
    +
    +{ TR2 }
    +
    +class operator TR2.Initialize(var aR2: TR2);
    +begin
    +  WriteLn('TR2.Initialize');
    +  aR2.S := 'A';
    +end;
    +
    +class operator TR2.Finalize(var aR2: TR2);
    +begin
    +  if aR2.S <> 'B' then
    +    Halt(2);
    +  WriteLn('TR2.Finalize');
    +end;
    +
    +{ TA }
    +
    +type 
    +  TA = object
    +  public 
    +    F1: TR1;
    +  end;
    +
    +  TB = object(TA)
    +  public
    +    F2: TR2;
    +  end;
    +  
    +procedure Foo();
    +var
    +  LO: TB;
    +begin
    +  if LO.F1.I <> 1 then
    +    Halt(4);
    +  if LO.F2.S <> 'A' then
    +    Halt(5);
    +  LO.F1.I := 2;
    +  LO.F2.S := 'B';
    +end;
    +
    +var
    +  O: TB;
    +  P: ^TB;
    +begin
    +  WriteLn('=== Global object variable [begin] ===');
    +  
    +  if O.F1.I <> 1 then
    +    Halt(3);
    +  if O.F2.S <> 'A' then
    +    Halt(4);
    +    
    +  WriteLn;
    +  WriteLn('=== Local variable ===');
    +  Foo();      
    +    
    +  WriteLn;
    +  WriteLn('=== New and Dispose ===');
    +  New(P);
    +  if P^.F1.I <> 1 then
    +    Halt(10);
    +  if P^.F2.S <> 'A' then
    +    Halt(11);
    +  P^.F1.I := 2;
    +  P^.F2.S := 'B';
    +  Dispose(P); 
    +  
    +  WriteLn;
    +  WriteLn('=== InitializeArray and FinalizeArray ===');
    +  GetMem(P, SizeOf(TB));
    +  InitializeArray(P, TypeInfo(TB), 1);
    +  if P^.F1.I <> 1 then
    +    Halt(12);
    +  if P^.F2.S <> 'A' then
    +    Halt(13);
    +  P^.F1.I := 2;  
    +  P^.F2.S := 'B';  
    +  FinalizeArray(P, TypeInfo(TB), 1);
    +  if P^.F1.I <> 3 then
    +    Halt(14);
    +  FreeMem(P);
    +
    +  WriteLn;
    +  WriteLn('=== Initialize and Finalize ===');
    +  GetMem(P, SizeOf(TB));
    +  Initialize(P^);
    +  if P^.F1.I <> 1 then
    +    Halt(15);
    +  if P^.F2.S <> 'A' then
    +    Halt(16);
    +  P^.F1.I := 2;  
    +  P^.F2.S := 'B';  
    +  Finalize(P^);
    +  if P^.F1.I <> 3 then
    +    Halt(17);
    +  FreeMem(P);
    +
    +  WriteLn;
    +  WriteLn('=== Global variable [end] ===');
    +  O.F1.I := 2;
    +  O.F2.S := 'B'; 
    +end. 
    \ No newline at end of file
    diff --git a/tests/test/tmoperator6.pp b/tests/test/tmoperator6.pp
    new file mode 100644
    index 0000000..febef0b
    --- /dev/null
    +++ b/tests/test/tmoperator6.pp
    @@ -0,0 +1,28 @@
    +{ %FAIL }
    +
    +program tmoperator6;
    +
    +{$MODE DELPHI}
    +
    +type
    +
    +  { TFoo }
    +
    +  TFoo = record
    +  private
    +    class operator Initialize(var aFoo: TFoo): Boolean;
    +    class operator Finalize(var aFoo: Pointer);
    +  end;
    +
    +{ TFoo }
    +
    +class operator TFoo.Initialize(var aFoo: TFoo): Boolean;
    +begin
    +end;
    +
    +class operator TFoo.Finalize(var aFoo: Pointer);
    +begin
    +end;
    +
    +begin
    +end. 
    \ No newline at end of file
    diff --git a/tests/test/tmoperator7.pp b/tests/test/tmoperator7.pp
    new file mode 100644
    index 0000000..2f26358
    --- /dev/null
    +++ b/tests/test/tmoperator7.pp
    @@ -0,0 +1,15 @@
    +program tmoperator7;
    +
    +{$MODE DELPHI}
    +
    +uses
    +  TypInfo;
    +
    +type
    +  TFoo = record
    +  end;
    +
    +begin
    +  if GetTypeData(TypeInfo(TFoo)).RecInitTable = nil then
    +    Halt(1);
    +end.
    -- 
    2.9.3.windows.2
    
    
  • 0003-rtti.inc.patch (2,705 bytes)
    From 72f33b5bd604cdad66e3b3cf326989ce8080e880 Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Fri, 30 Sep 2016 00:28:00 +0200
    Subject: [PATCH 03/15] rtti.inc:   - remove empty VMT slots for record
     management operators (for AddRef and Copy), related to r33229
    
    git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33253
    
    ncgrtti.pas, symconst.pas, symtable.pas:
      - remove placeholders for "addref" and "copy" management operators.
    
    git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33229
    ---
     compiler/ncgrtti.pas  | 2 +-
     compiler/symconst.pas | 5 +----
     compiler/symtable.pas | 6 +-----
     rtl/inc/rtti.inc      | 2 --
     4 files changed, 3 insertions(+), 12 deletions(-)
    
    diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas
    index 6752527..796bcf7 100644
    --- a/compiler/ncgrtti.pas
    +++ b/compiler/ncgrtti.pas
    @@ -1049,7 +1049,7 @@ implementation
                if (rt=initrtti) and (trecordsymtable(def.symtable).managementoperators<>[]) then
                  write_record_operators;
     
    -           { guarantee initrtti for any record for fpc_initialize, fpc_finalize, fpc_copy and fpc_addref }
    +           { guarantee initrtti for any record for fpc_initialize, fpc_finalize }
                if (rt = fullrtti) and (ds_init_table_used in def.defstates) and
                   not (ds_init_table_written in def.defstates) then
                  write_rtti(def, initrtti);
    diff --git a/compiler/symconst.pas b/compiler/symconst.pas
    index d7a1899..b926bc0 100644
    --- a/compiler/symconst.pas
    +++ b/compiler/symconst.pas
    @@ -584,10 +584,7 @@ type
     
       tmanagementoperator=(mop_none,
         mop_initialize,
    -    mop_finalize,
    -    { reserved for future usage }
    -    mop_addref,
    -    mop_copy
    +    mop_finalize
       );
       tmanagementoperators=set of tmanagementoperator;
     
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index 1f07544..ca875da 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -438,11 +438,7 @@ interface
           managementoperator2tok:array[tmanagementoperator] of ttoken = (
         { mop_none       }  NOTOKEN,
         { mop_initialize }  _OP_INITIALIZE,
    -    { mop_finalize   }  _OP_FINALIZE,
    -
    -    { reserved for future usage }
    -    { mop_addref     }  NOTOKEN,
    -    { mop_copy       }  NOTOKEN);
    +    { mop_finalize   }  _OP_FINALIZE);
     
     
     implementation
    diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
    index 7104618..ac3db59 100644
    --- a/rtl/inc/rtti.inc
    +++ b/rtl/inc/rtti.inc
    @@ -64,8 +64,6 @@ type
       record
         Initialize: TRTTIRecInitFiniOp;
         Finalize: TRTTIRecInitFiniOp;
    -    Reserved1: CodePointer;
    -    Reserved2: CodePointer;
       end;
     
       PRecordInfoInit=^TRecordInfoInit;
    -- 
    2.9.3.windows.2
    
    
    0003-rtti.inc.patch (2,705 bytes)
  • 0004-RTL-compileable-with-the-FPC-3.0.patch (5,784 bytes)
    From 872450def321b050d2a11f5294a8f6ebf3c7364c Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Fri, 30 Sep 2016 00:36:49 +0200
    Subject: [PATCH 04/15] RTL compileable with the FPC 3.0
    
    git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33381
    ---
     rtl/inc/objpas.inc    |  4 ++++
     rtl/inc/rtti.inc      | 29 +++++++++++++++++++++++++++++
     rtl/objpas/typinfo.pp |  2 ++
     3 files changed, 35 insertions(+)
    
    diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc
    index 0e3caf4..94c8685 100644
    --- a/rtl/inc/objpas.inc
    +++ b/rtl/inc/objpas.inc
    @@ -379,9 +379,11 @@
     
           class function TObject.InitInstance(instance : pointer) : tobject; {$ifdef SYSTEMINLINE} inline; {$ENDIF}
     
    +{$if FPC_FULLVERSION>30100}
             var
                vmt  : PVmt;
                temp : pointer;
    +{$endif FPC_FULLVERSION>30100}
             begin
                { the size is saved at offset 0 }
                fillchar(instance^, InstanceSize, 0);
    @@ -391,6 +393,7 @@
                if {$ifdef VER3_0}PVmt(self)^.vIntfTable <> @emptyintf{$else}assigned(PVmt(self)^.vIntfTable){$endif} then
                  InitInterfacePointers(self,instance);
     
    +{$if FPC_FULLVERSION>30100}
                { for record operators like initialize/finalize call int_initialize }
                vmt := PVmt(self);
                while vmt<>nil do
    @@ -402,6 +405,7 @@
                      RecordRTTI(Instance,Temp,@int_initialize);
                    vmt:= vmt^.vParent;
                  end;
    +{$endif FPC_FULLVERSION>30100}
     
                InitInstance:=TObject(Instance);
             end;
    diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
    index ac3db59..23d9b67 100644
    --- a/rtl/inc/rtti.inc
    +++ b/rtl/inc/rtti.inc
    @@ -49,11 +49,14 @@ type
     {$endif USE_PACKED}
       record
         Size: Longint;
    +{$if FPC_FULLVERSION>30100}
         InitTable: Pointer;
    +{$endif FPC_FULLVERSION>30100}
         Count: Longint;
         { Elements: array[count] of TRecordElement }
       end;
     
    +{$if FPC_FULLVERSION>30100}
       TRTTIRecInitFiniOp=procedure(ARec: Pointer);
     
       PRTTIRecordOpVMT=^TRTTIRecordOpVMT;
    @@ -78,6 +81,7 @@ type
         Count: Longint;
         { Elements: array[count] of TRecordElement }
       end;
    +{$endif FPC_FULLVERSION>30100}
     
       PArrayInfo=^TArrayInfo;
       TArrayInfo=
    @@ -112,6 +116,7 @@ begin
       result:=PRecordInfoFull(typeInfo)^.Size;
     end;
     
    +{$if FPC_FULLVERSION>30100}
     function RTTIRecordOp(typeInfo: Pointer; var initrtti: Pointer): PRecordInfoInit; inline;
     begin
       { find init table and management operators }
    @@ -127,6 +132,7 @@ begin
         result:=aligntoptr(initrtti+2+PByte(initrtti)[1]);
       end
     end;
    +{$endif FPC_FULLVERSION>30100}
     
     function RTTISize(typeInfo: Pointer): SizeInt;
     begin
    @@ -154,8 +160,13 @@ var
       i : longint;
     begin
       typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
    +{$if FPC_FULLVERSION>30100}
       Count:=PRecordInfoInit(typeInfo)^.Count;
       Inc(PRecordInfoInit(typeInfo));
    +{$else FPC_FULLVERSION>30100}
    +  Count:=PRecordInfoFull(typeInfo)^.Count;
    +  Inc(PRecordInfoFull(typeInfo));
    +{$endif FPC_FULLVERSION>30100}
       { Process elements }
       for i:=1 to count Do
         begin
    @@ -215,6 +226,7 @@ begin
         tkObject,
     {$endif FPC_HAS_FEATURE_OBJECTS}
         tkRecord:
    +{$if FPC_FULLVERSION>30100}
           { if possible try to use more optimal initrtti }
           with RTTIRecordOp(typeinfo, typeinfo)^ do
           begin
    @@ -222,6 +234,9 @@ begin
             if Assigned(recordop) and Assigned(recordop^.Initialize) then
               recordop^.Initialize(data);
           end;
    +{$else FPC_FULLVERSION>30100}
    +      recordrtti(data,typeinfo,@int_initialize);
    +{$endif FPC_FULLVERSION>30100}
     {$ifdef FPC_HAS_FEATURE_VARIANTS}
         tkVariant:
           variant_init(PVarData(Data)^);
    @@ -251,6 +266,7 @@ begin
         tkObject,
     {$endif FPC_HAS_FEATURE_OBJECTS}
         tkRecord:
    +{$if FPC_FULLVERSION>30100}
           { if possible try to use more optimal initrtti }
           with RTTIRecordOp(typeinfo, typeinfo)^ do
           begin
    @@ -258,6 +274,9 @@ begin
               recordop^.Finalize(data);
             recordrtti(data,typeinfo,@int_finalize);
           end;
    +{$else FPC_FULLVERSION>30100}
    +      recordrtti(data,typeinfo,@int_finalize);
    +{$endif FPC_FULLVERSION>30100}
         tkInterface:
           Intf_Decr_Ref(PPointer(Data)^);
     {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
    @@ -294,8 +313,10 @@ begin
     {$endif FPC_HAS_FEATURE_OBJECTS}
         tkrecord :
           begin
    +{$if FPC_FULLVERSION>30100}
             { find init table }
             RTTIRecordOp(typeinfo, typeinfo);
    +{$endif FPC_FULLVERSION>30100}
             recordrtti(data,typeinfo,@int_addref);
           end;
     {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
    @@ -369,13 +390,21 @@ begin
     {$endif FPC_HAS_FEATURE_OBJECTS}
         tkrecord:
           begin
    +{$if FPC_FULLVERSION>30100}
             { find init table }
             RTTIRecordOp(typeinfo, typeinfo);
    +{$endif FPC_FULLVERSION>30100}
             Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
     
    +{$if FPC_FULLVERSION>30100}
             Result:=PRecordInfoInit(Temp)^.Size;
             Count:=PRecordInfoInit(Temp)^.Count;
             Inc(PRecordInfoInit(Temp));
    +{$else FPC_FULLVERSION>30100}
    +        Result:=PRecordInfoFull(Temp)^.Size;
    +        Count:=PRecordInfoFull(Temp)^.Count;
    +        Inc(PRecordInfoFull(Temp));
    +{$endif FPC_FULLVERSION>30100}
             expectedoffset:=0;
             { Process elements with rtti }
             for i:=1 to count Do
    diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp
    index 2b66803..5652900 100644
    --- a/rtl/objpas/typinfo.pp
    +++ b/rtl/objpas/typinfo.pp
    @@ -312,7 +312,9 @@ unit typinfo;
                 tkRecord:
                   (
                     RecSize: Integer;
    +{$if FPC_FULLVERSION>30100}
                     RecInitTable: Pointer;
    +{$endif FPC_FULLVERSION>30100}
                     ManagedFldCount: Integer;
                     {ManagedFields: array[1..ManagedFldCount] of TManagedField}
                   );
    -- 
    2.9.3.windows.2
    
    
  • 0005-Allow-Initialize-management-operator-for-SetLength-f.patch (5,778 bytes)
    From 6765369b0b45bacee8a1e34c1c03fb436e2490bd Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Fri, 30 Sep 2016 00:46:26 +0200
    Subject: [PATCH 05/15] Allow Initialize management operator for SetLength for
     dynamic arrays (fix for bug reported by Anthony Walter).
    
    rtl/inc/aliases.inc:
      + new internal alias int_InitializeArray for FPC_INITIALIZE_ARRAY
    rtl/inc/dynarr.inc:
      * use int_InitializeArray in fpc_dynarray_setlength for new elements for array of records and objects
    rtl/inc/rtti.inc:
      * missing semicolon
    
    + added test
    
    git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33384
    ---
     rtl/inc/aliases.inc       |   1 +
     rtl/inc/dynarr.inc        |  11 +++++
     rtl/inc/rtti.inc          |   2 +-
     tests/test/tmoperator8.pp | 105 ++++++++++++++++++++++++++++++++++++++++++++++
     4 files changed, 118 insertions(+), 1 deletion(-)
     create mode 100644 tests/test/tmoperator8.pp
    
    diff --git a/rtl/inc/aliases.inc b/rtl/inc/aliases.inc
    index 04ba0cd..12b0030 100644
    --- a/rtl/inc/aliases.inc
    +++ b/rtl/inc/aliases.inc
    @@ -27,6 +27,7 @@
     Procedure int_Finalize (Data,TypeInfo: Pointer); [external name 'FPC_FINALIZE'];
     Procedure int_Addref (Data,TypeInfo : Pointer); [external name 'FPC_ADDREF'];
     Procedure int_Initialize (Data,TypeInfo: Pointer); [external name 'FPC_INITIALIZE'];
    +procedure int_InitializeArray(data,typeinfo : pointer;count : SizeInt); [external name 'FPC_INITIALIZE_ARRAY'];
     procedure int_FinalizeArray(data,typeinfo : pointer;count : SizeInt); [external name 'FPC_FINALIZE_ARRAY'];
     
     {$if defined(FPC_HAS_FEATURE_RTTI) and not defined(cpujvm)}
    diff --git a/rtl/inc/dynarr.inc b/rtl/inc/dynarr.inc
    index 08d0903..6e43e17 100644
    --- a/rtl/inc/dynarr.inc
    +++ b/rtl/inc/dynarr.inc
    @@ -185,6 +185,11 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
                 exit;
               getmem(newp,size);
               fillchar(newp^,size,0);
    +{$if FPC_FULLVERSION>30100}
    +          { call int_InitializeArray for management operators }
    +          if PByte(eletype)^ in [tkRecord, tkObject] then
    +            int_InitializeArray(pointer(newp)+sizeof(tdynarray), eletype, dims[0]);
    +{$endif FPC_FULLVERSION>30100}
               updatep := true;
            end
          else
    @@ -257,6 +262,12 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
                              reallocmem(realp,size);
                              fillchar((pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1))^,
                                (dims[0]-realp^.high-1)*elesize,0);
    +{$if FPC_FULLVERSION>30100}
    +                         { call int_InitializeArray for management operators }
    +                         if PByte(eletype)^ in [tkRecord, tkObject] then
    +                           int_InitializeArray(pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1),
    +                             eletype, dims[0]-realp^.high-1);
    +{$endif FPC_FULLVERSION>30100}
                           end;
                         newp := realp;
                         updatep := true;
    diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
    index 23d9b67..d65691e 100644
    --- a/rtl/inc/rtti.inc
    +++ b/rtl/inc/rtti.inc
    @@ -447,7 +447,7 @@ begin
     end;
     
     
    -procedure fpc_initialize_array(data,typeinfo : pointer;count : SizeInt); [public,alias:'FPC_INITIALIZE_ARRAY'] compilerproc;
    +procedure fpc_initialize_array(data,typeinfo : pointer;count : SizeInt); [public,alias:'FPC_INITIALIZE_ARRAY']; compilerproc;
       var
          i, size : SizeInt;
       begin
    diff --git a/tests/test/tmoperator8.pp b/tests/test/tmoperator8.pp
    new file mode 100644
    index 0000000..8122274
    --- /dev/null
    +++ b/tests/test/tmoperator8.pp
    @@ -0,0 +1,105 @@
    +program tmoperator8;
    +
    +{$MODE DELPHI}
    +
    +type
    +  TFoo = record
    +  private
    +    class operator Initialize(var aFoo: TFoo);
    +    class operator Finalize(var aFoo: TFoo);
    +  public
    +    I: Integer;
    +  public class var
    +    InitializeCount: Integer;
    +    FinalizeCount: Integer;
    +  end;
    +
    +  TFooObj = object
    +  public
    +    F: TFoo;
    +  end;  
    +
    +  TFooArray = array of TFoo; 
    +  TFooObjArray = array of TFooObj; 
    +
    +{ TFoo }
    +
    +class operator TFoo.Initialize(var aFoo: TFoo);
    +begin
    +  Inc(InitializeCount);
    +  if aFoo.I <> 0 then // for dyn array and old obj
    +    Halt(1);
    +    
    +  WriteLn('TFoo.Initialize');
    +  aFoo.I := 1;
    +end;
    +
    +class operator TFoo.Finalize(var aFoo: TFoo);
    +begin
    +  Inc(FinalizeCount);
    +  if aFoo.I <> 2 then
    +    Halt(2);
    +  WriteLn('TFoo.Finalize');
    +end;
    +
    +procedure CheckFooInit(var AValue: Integer; const AExpectedInitializeCount: Integer);
    +begin
    +  if AValue <> 1 then
    +    Halt(3);
    +  AValue := 2;
    +  
    +  if TFoo.InitializeCount <> AExpectedInitializeCount then
    +    Halt(4); 
    +end;
    +
    +procedure CheckFooFini(const AExpectedFinalizeCount: Integer);
    +begin
    +  if TFoo.FinalizeCount <> AExpectedFinalizeCount then
    +    Halt(5);   
    +end;
    +
    +procedure FooTest;
    +var
    +  Foos: TFooArray;
    +  FoosObj: TFooObjArray;
    +begin
    +  WriteLn('=== DynArray of Records ===');
    +  
    +  SetLength(Foos, 1);
    +  CheckFooInit(Foos[0].I, 1);
    +
    +  SetLength(Foos, 2);
    +  CheckFooInit(Foos[1].I, 2);
    +    
    +  SetLength(Foos, 1);
    +  CheckFooFini(1);
    +
    +  SetLength(Foos, 2);
    +  CheckFooInit(Foos[1].I, 3);
    +
    +  Foos := nil;
    +  CheckFooFini(3);
    +    
    +  WriteLn('=== DynArray of Objects ===');
    +  TFoo.InitializeCount := 0;
    +  TFoo.FinalizeCount := 0;
    +  
    +  SetLength(FoosObj, 1);
    +  CheckFooInit(FoosObj[0].F.I, 1);
    +
    +  SetLength(FoosObj, 2);
    +  CheckFooInit(FoosObj[1].F.I, 2);
    +    
    +  SetLength(FoosObj, 1);
    +  CheckFooFini(1);
    +
    +  SetLength(FoosObj, 2);
    +  CheckFooInit(FoosObj[1].F.I, 3);
    +
    +  FoosObj := nil;
    +  CheckFooFini(3);
    +end;
    +
    +begin
    +  FooTest;
    +end. 
    \ No newline at end of file
    -- 
    2.9.3.windows.2
    
    
  • 0006-New-tokens-proper-parsing-and-new-VMT-slots-for-new-.patch (6,906 bytes)
    From 66a3e530825397ac738aac1a5519ea7115645ba2 Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Fri, 30 Sep 2016 00:54:43 +0200
    Subject: [PATCH 06/15] New tokens, proper parsing and new VMT slots for new
     management operators: AddRef and Copy. New operators require changes to RTL
     (that will be committed next time).
    
    pdecsub.pas:
      + parse new _ADDREF and _COPY tokens as _OP_ADDREF and _OP_COPY
      + proper handling for new operators
    
    symconst.pas, tmanagementoperator:
      + new enum items: mop_addref and mop_copy
    
    symtable.pas:
      * overloaded_names and managementoperator2tok adjusted to new operators
    
    tokens.pas:
      + new tokens for management operators: _ADDREF, _COPY, _OP_ADDREF, _OP_COPY
    
    git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33469
    ---
     compiler/pdecsub.pas  | 24 ++++++++++++++++++++----
     compiler/symconst.pas |  4 +++-
     compiler/symtable.pas |  7 ++++++-
     compiler/tokens.pas   | 10 +++++++++-
     4 files changed, 38 insertions(+), 7 deletions(-)
    
    diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
    index 1ff290c..cb745aa 100644
    --- a/compiler/pdecsub.pas
    +++ b/compiler/pdecsub.pas
    @@ -598,6 +598,8 @@ implementation
                         _DEC:optoken:=_OP_DEC;
                         _INITIALIZE:optoken:=_OP_INITIALIZE;
                         _FINALIZE:optoken:=_OP_FINALIZE;
    +                    _ADDREF:optoken:=_OP_ADDREF;
    +                    _COPY:optoken:=_OP_COPY;
                         else
                         if (m_delphi in current_settings.modeswitches) then
                           case lastidtoken of
    @@ -1426,11 +1428,25 @@ implementation
                     end;
     
                   { operators without result }
    -              if optoken in [_OP_INITIALIZE, _OP_FINALIZE] then
    +              if optoken in [_OP_INITIALIZE, _OP_FINALIZE, _OP_ADDREF, _OP_COPY] then
                     begin
    -                  if (pd.parast.SymList.Count <> 1) or
    -                     (tparavarsym(pd.parast.SymList[0]).vardef<>pd.struct) or
    -                     (tparavarsym(pd.parast.SymList[0]).varspez<>vs_var) then
    +                  { single var parameter to point the record }
    +                  if (optoken in [_OP_INITIALIZE, _OP_FINALIZE, _OP_ADDREF]) and
    +                     (
    +                      (pd.parast.SymList.Count <> 1) or
    +                      (tparavarsym(pd.parast.SymList[0]).vardef<>pd.struct) or
    +                      (tparavarsym(pd.parast.SymList[0]).varspez<>vs_var)
    +                     ) then
    +                    Message(parser_e_overload_impossible)
    +                  { constref (source) and var (dest) parameter to point the records }
    +                  else if (optoken = _OP_COPY) and
    +                     (
    +                      (pd.parast.SymList.Count <> 2) or
    +                      (tparavarsym(pd.parast.SymList[0]).vardef<>pd.struct) or
    +                      (tparavarsym(pd.parast.SymList[0]).varspez<>vs_constref) or
    +                      (tparavarsym(pd.parast.SymList[1]).vardef<>pd.struct) or
    +                      (tparavarsym(pd.parast.SymList[1]).varspez<>vs_var)
    +                     ) then
                         Message(parser_e_overload_impossible);
     
                       trecordsymtable(pd.procsym.Owner).includemanagementoperator(
    diff --git a/compiler/symconst.pas b/compiler/symconst.pas
    index b926bc0..1f7313b 100644
    --- a/compiler/symconst.pas
    +++ b/compiler/symconst.pas
    @@ -584,7 +584,9 @@ type
     
       tmanagementoperator=(mop_none,
         mop_initialize,
    -    mop_finalize
    +    mop_finalize,
    +    mop_addref,
    +    mop_copy
       );
       tmanagementoperators=set of tmanagementoperator;
     
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index ca875da..f981989 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -432,13 +432,18 @@ interface
         { _OP_ENUMERATOR }  'enumerator',
         { _OP_INITIALIZE }  'initialize',
         { _OP_FINALIZE   }  'finalize',    
    +    { _OP_ADDREF     }  'addref',
    +    { _OP_COPY       }  'copy',
         { _OP_INC        }  'inc',
         { _OP_DEC        }  'dec');
     
           managementoperator2tok:array[tmanagementoperator] of ttoken = (
         { mop_none       }  NOTOKEN,
         { mop_initialize }  _OP_INITIALIZE,
    -    { mop_finalize   }  _OP_FINALIZE);
    +    { mop_finalize   }  _OP_FINALIZE,
    +    { mop_addref     }  _OP_ADDREF,
    +    { mop_copy       }  _OP_COPY
    +    );
     
     
     implementation
    diff --git a/compiler/tokens.pas b/compiler/tokens.pas
    index d98a626..1757764 100644
    --- a/compiler/tokens.pas
    +++ b/compiler/tokens.pas
    @@ -58,6 +58,8 @@ type
         _OP_ENUMERATOR,
         _OP_INITIALIZE,
         _OP_FINALIZE,    
    +    _OP_ADDREF,
    +    _OP_COPY,
         _OP_INC,
         _OP_DEC,
         { special chars }
    @@ -131,6 +133,7 @@ type
         _VAR,
         _XOR,
         _CASE,
    +    _COPY,
         _CVAR,
         _ELSE,
         _EXIT,
    @@ -166,6 +169,7 @@ type
         _UNTIL,
         _WHILE,
         _WRITE,
    +    _ADDREF,
         _DISPID,
         _DIVIDE,
         _DOWNTO,
    @@ -325,7 +329,7 @@ const
       last_overloaded  = _OP_DEC;
       last_operator = _GENERICSPECIALTOKEN;
       first_managment_operator = _OP_INITIALIZE;
    -  last_managment_operator = _OP_FINALIZE;
    +  last_managment_operator = _OP_COPY;
     
       highest_precedence = oppower;
     
    @@ -387,6 +391,8 @@ const
           (str:'enumerator'    ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'initialize'    ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'finalize'      ;special:true ;keyword:[m_none];op:NOTOKEN),
    +      (str:'addref'        ;special:true ;keyword:[m_none];op:NOTOKEN),
    +      (str:'copy'          ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'inc'           ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'dec'           ;special:true ;keyword:[m_none];op:NOTOKEN),
         { Special chars }
    @@ -460,6 +466,7 @@ const
           (str:'VAR'           ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
           (str:'XOR'           ;special:false;keyword:alllanguagemodes;op:_OP_XOR),
           (str:'CASE'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
    +      (str:'COPY'          ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'CVAR'          ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'ELSE'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
           (str:'EXIT'          ;special:false;keyword:[m_none];op:NOTOKEN),
    @@ -495,6 +502,7 @@ const
           (str:'UNTIL'         ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
           (str:'WHILE'         ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
           (str:'WRITE'         ;special:false;keyword:[m_none];op:NOTOKEN),
    +      (str:'ADDREF'        ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'DISPID'        ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'DIVIDE'        ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
           (str:'DOWNTO'        ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
    -- 
    2.9.3.windows.2
    
    
  • 0007-Missing-conversion-token-operator-for-new-management.patch (1,336 bytes)
    From cf7f9b47e7845495ffae3af27c8b6f5b97a730a1 Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Fri, 30 Sep 2016 00:57:29 +0200
    Subject: [PATCH 07/15] Missing conversion token/operator for new management
     operators AddRef and Copy for previous commit r33469
    
    htypechk.pas:
      + _OP_ADDREF and _OP_COPY to mop_addref and mop_copy
    
    git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33475
    ---
     compiler/htypechk.pas | 6 ++++--
     1 file changed, 4 insertions(+), 2 deletions(-)
    
    diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
    index ec9bb07..787e5a5 100644
    --- a/compiler/htypechk.pas
    +++ b/compiler/htypechk.pas
    @@ -137,10 +137,12 @@ interface
             (tok:_OP_DEC     ;nod:inlinen;inr:in_dec_x;op_overloading_supported:true) { unary overloading supported }
           );
     
    -      tok2ops=2;
    +      tok2ops=4;
           tok2op: array[1..tok2ops] of ttok2oprec = (
             (tok:_OP_INITIALIZE; managementoperator: mop_initialize),
    -        (tok:_OP_FINALIZE  ; managementoperator: mop_finalize)
    +        (tok:_OP_FINALIZE  ; managementoperator: mop_finalize),
    +        (tok:_OP_ADDREF    ; managementoperator: mop_addref),
    +        (tok:_OP_COPY      ; managementoperator: mop_copy)
           );
     
           { true, if we are parsing stuff which allows array constructors }
    -- 
    2.9.3.windows.2
    
    
  • 0008-Copy-operator-if-declared-is-executed-instead-of-def.patch (9,053 bytes)
    From 6588e0472cbcca31704fe9c20a067095b4dfc359 Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Fri, 30 Sep 2016 01:13:52 +0200
    Subject: [PATCH 08/15] Copy operator (if declared) is executed instead of
     default fpc_Copy code (any other behavior has no sense).
    
    rtti.inc:
      * modified fpc_Copy for mentioned behavior
    
    * Test toperator96.pp modified
    
    git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33486
    
    RTL support for new management operators AddRef and Copy (NOTE: names can be changed). AddRef operator is used when record is passed as parameter to method/function by value (for records to large to copy (when only the address is pushed)). AddRef is used also for dynamic array operations (temporary for SetLength operation and for Copy operation for already copied data by move).
    
    rtti.inc:
      * Rename TRTTIRecInitFiniOp to TRTTIRecVarOp (is used for Initialize, Finalize and AddRef operator)
      + New operator function type for Copy like operator: TRTTIRecCopyOp
      + New VMT slots for AddRef and Operators in TRTTIRecordOpVMT
      * Adjusted fpc_Addref function to support AddRef operator
      * Adjusted fpc_Copy function to support Copy operator
    
    + added test
    
    git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33478
    ---
     rtl/inc/rtti.inc          |  71 +++++++++++++---------
     tests/test/tmoperator9.pp | 148 ++++++++++++++++++++++++++++++++++++++++++++++
     2 files changed, 190 insertions(+), 29 deletions(-)
     create mode 100644 tests/test/tmoperator9.pp
    
    diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
    index d65691e..754f026 100644
    --- a/rtl/inc/rtti.inc
    +++ b/rtl/inc/rtti.inc
    @@ -57,7 +57,8 @@ type
       end;
     
     {$if FPC_FULLVERSION>30100}
    -  TRTTIRecInitFiniOp=procedure(ARec: Pointer);
    +  TRTTIRecVarOp=procedure(ARec: Pointer);
    +  TRTTIRecCopyOp=procedure(ASrc, ADest: Pointer);
     
       PRTTIRecordOpVMT=^TRTTIRecordOpVMT;
       TRTTIRecordOpVMT=
    @@ -65,8 +66,10 @@ type
       packed
     {$endif USE_PACKED}
       record
    -    Initialize: TRTTIRecInitFiniOp;
    -    Finalize: TRTTIRecInitFiniOp;
    +    Initialize: TRTTIRecVarOp;
    +    Finalize: TRTTIRecVarOp;
    +    AddRef: TRTTIRecVarOp;
    +    Copy: TRTTIRecCopyOp;
       end;
     
       PRecordInfoInit=^TRecordInfoInit;
    @@ -312,12 +315,16 @@ begin
         tkobject,
     {$endif FPC_HAS_FEATURE_OBJECTS}
         tkrecord :
    -      begin
     {$if FPC_FULLVERSION>30100}
    -        { find init table }
    -        RTTIRecordOp(typeinfo, typeinfo);
    +      { find init table }
    +      with RTTIRecordOp(typeinfo, typeinfo)^ do
     {$endif FPC_FULLVERSION>30100}
    +      begin
             recordrtti(data,typeinfo,@int_addref);
    +{$if FPC_FULLVERSION>30100}
    +        if Assigned(recordop) and Assigned(recordop^.AddRef) then
    +          recordop^.AddRef(Data);
    +{$endif FPC_FULLVERSION>30100}
           end;
     {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
         tkDynArray:
    @@ -391,35 +398,41 @@ begin
         tkrecord:
           begin
     {$if FPC_FULLVERSION>30100}
    -        { find init table }
    -        RTTIRecordOp(typeinfo, typeinfo);
    +      { find init table }
    +      with RTTIRecordOp(typeinfo, typeinfo)^ do
     {$endif FPC_FULLVERSION>30100}
    +      begin
             Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
    -
     {$if FPC_FULLVERSION>30100}
    -        Result:=PRecordInfoInit(Temp)^.Size;
    -        Count:=PRecordInfoInit(Temp)^.Count;
    -        Inc(PRecordInfoInit(Temp));
    +        if Assigned(recordop) and Assigned(recordop^.Copy) then
    +          recordop^.Copy(Src,Dest)
    +        else
    +          begin
    +            Result:=Size;
    +            Inc(PRecordInfoInit(Temp));
     {$else FPC_FULLVERSION>30100}
    -        Result:=PRecordInfoFull(Temp)^.Size;
    -        Count:=PRecordInfoFull(Temp)^.Count;
    -        Inc(PRecordInfoFull(Temp));
    +            Result:=PRecordInfoFull(Temp)^.Size;
    +            Count:=PRecordInfoFull(Temp)^.Count;
    +            Inc(PRecordInfoFull(Temp));
     {$endif FPC_FULLVERSION>30100}
    -        expectedoffset:=0;
    -        { Process elements with rtti }
    -        for i:=1 to count Do
    -          begin
    -            Info:=PRecordElement(Temp)^.TypeInfo{$ifndef VER3_0}^{$endif};
    -            Offset:=PRecordElement(Temp)^.Offset;
    -            Inc(PRecordElement(Temp));
    -            if Offset>expectedoffset then
    -              move((Src+expectedoffset)^,(Dest+expectedoffset)^,Offset-expectedoffset);
    -            copiedsize:=fpc_Copy_internal(Src+Offset,Dest+Offset,Info);
    -            expectedoffset:=Offset+copiedsize;
    +            expectedoffset:=0;
    +            { Process elements with rtti }
    +            for i:=1 to Count Do
    +              begin
    +                Info:=PRecordElement(Temp)^.TypeInfo{$ifndef VER3_0}^{$endif};
    +                Offset:=PRecordElement(Temp)^.Offset;
    +                Inc(PRecordElement(Temp));
    +                if Offset>expectedoffset then
    +                  move((Src+expectedoffset)^,(Dest+expectedoffset)^,Offset-expectedoffset);
    +                copiedsize:=fpc_Copy_internal(Src+Offset,Dest+Offset,Info);
    +                expectedoffset:=Offset+copiedsize;
    +              end;
    +            { elements remaining? }
    +            if result>expectedoffset then
    +              move((Src+expectedoffset)^,(Dest+expectedoffset)^,Result-expectedoffset);
    +{$if FPC_FULLVERSION>30100}
               end;
    -        { elements remaining? }
    -        if result>expectedoffset then
    -          move((Src+expectedoffset)^,(Dest+expectedoffset)^,Result-expectedoffset);
    +{$endif FPC_FULLVERSION>30100}
           end;
     {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
         tkDynArray:
    diff --git a/tests/test/tmoperator9.pp b/tests/test/tmoperator9.pp
    new file mode 100644
    index 0000000..0e00e92
    --- /dev/null
    +++ b/tests/test/tmoperator9.pp
    @@ -0,0 +1,148 @@
    +program tmoperator9;
    +
    +{$MODE DELPHI}
    +
    +type
    +  TCopyState = (csNone, csSource, csDest);
    +  PFoo = ^TFoo;
    +  TFoo = record
    +  private
    +    class operator Initialize(var aFoo: TFoo);
    +    class operator Finalize(var aFoo: TFoo);
    +    class operator AddRef(var aFoo: TFoo);
    +    class operator Copy(constref aSrc: TFoo; var aDst: TFoo);
    +  public
    +    CopyState: TCopyState;
    +    Ref: Boolean;
    +    F, Test: Integer;
    +  end;
    +
    +  TFooArray = array of TFoo;
    +
    +procedure TestFoo(const AValue: TFoo; AF, ATest: Integer; ARef: Boolean; ACopyState: TCopyState);
    +begin
    +  WriteLn('    AValue.F = ', AValue.F);
    +  if AValue.F <> AF then
    +    Halt(1);
    +  WriteLn('    AValue.Test = ', AValue.Test);
    +  if AValue.Test <> ATest then
    +    Halt(2);
    +  WriteLn('    AValue.Ref = ', AValue.Ref);
    +  if AValue.Ref <> ARef then
    +    Halt(4);
    +  WriteLn('    AValue.CopyState = ', Ord(AValue.CopyState));
    +  if AValue.CopyState <> ACopyState then
    +    Halt(3);
    +end;
    +
    +class operator TFoo.Initialize(var aFoo: TFoo);
    +begin
    +  WriteLn('TFoo.Initialize');
    +  aFoo.F := 1;
    +  aFoo.Ref := False;
    +  aFoo.Test := 0;
    +  aFoo.CopyState := csNone;
    +end;
    +
    +class operator TFoo.Finalize(var aFoo: TFoo);
    +begin
    +  WriteLn('TFoo.Finalize');
    +  if (aFoo.F <> 2) and not ((aFoo.F = 3) and aFoo.Ref) then
    +    Halt(5);
    +  aFoo.F := 4;
    +end;
    +
    +class operator TFoo.AddRef(var aFoo: TFoo);
    +begin
    +  WriteLn('TFoo.AddRef');
    +  aFoo.F := 3;
    +  aFoo.Test := aFoo.Test + 1;
    +  aFoo.Ref := True;
    +end;
    +
    +class operator TFoo.Copy(constref aSrc: TFoo; var aDst: TFoo);
    +var
    +  LSrc: PFoo;
    +begin
    +  WriteLn('TFoo.Copy');
    +  LSrc := @aSrc;
    +  LSrc.CopyState := csSource;
    +  aDst.CopyState := csDest;
    +  aDst.Test := aSrc.Test + 1;
    +  aDst.F := aSrc.F;
    +end;
    +
    +procedure TestValue(Value: TFoo);
    +begin
    +  writeln('  *Test without modifier:');
    +  TestFoo(Value, 3, 1, True, csNone);
    +end;
    +
    +procedure TestOut(out Value: TFoo);
    +begin
    +  WriteLn('  *Test out modifier:');
    +  TestFoo(Value, 1, 0, False, csNone);
    +  Value.F := 2;
    +end;
    +
    +procedure TestVar(var Value: TFoo);
    +begin
    +  writeln('  *Test var modifier:');
    +  TestFoo(Value, 2, 0, False, csNone);
    +end;
    +
    +procedure TestConst(const Value: TFoo);
    +begin
    +  writeln('  *Test const modifier:');
    +  TestFoo(Value, 2, 0, False, csNone);
    +end;
    +
    +procedure TestConstref(constref Value: TFoo);
    +begin
    +  WriteLn('  *Test constref modifier:');
    +  TestFoo(Value, 2, 0, False, csNone);
    +end;
    +
    +procedure Test;
    +var
    +  Foos: TFooArray;
    +  Foos2: TFooArray;
    +  A, B, C: TFoo;
    +  i: Integer;
    +begin
    +  WriteLn('*** Test for variable copy');
    +  TestFoo(B, 1, 0, False, csNone);
    +  B.F := 2;
    +  A := B;
    +  TestFoo(B, 2, 0, False, csSource);
    +  TestFoo(A, 2, 1, False, csDest);
    +
    +  WriteLn('*** Test for Copy(dyn array)');
    +  SetLength(Foos, 5);
    +  for i := 0 to 4 do
    +  begin
    +    Foos[i].F := 2;
    +    Foos[i].Test := i;
    +  end;
    +
    +  Foos2 := Copy(Foos);
    +
    +  for i := 0 to 4 do
    +  begin
    +    TestFoo(Foos[i], 2, i, False, csNone);
    +    TestFoo(Foos2[i], 3, i + 1, True, csNone);
    +  end;
    +
    +  WriteLn('*** Test for parameters modifiers');
    +  TestValue(C);
    +  C.F := 2; // reset F to pass finalize before out parameter
    +  TestOut(C);
    +  TestVar(C);
    +  TestConst(C);
    +  TestConstref(C);
    +end;
    +
    +begin
    +  Test;
    +  WriteLn('end');
    +end.
    -- 
    2.9.3.windows.2
    
    
  • 0009-Rename-for-management-operators-proposed-by-Florian-.patch (9,448 bytes)
    From bbb60bef74a539a02eb82304020b33c547c3ab6f Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Fri, 30 Sep 2016 01:31:00 +0200
    Subject: [PATCH 09/15] Rename for management operators (proposed by Florian):
     AddRef -> Copy and Copy -> Clone
    
    git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33657
    ---
     compiler/htypechk.pas     |  4 ++--
     compiler/pdecsub.pas      |  8 ++++----
     compiler/symconst.pas     |  4 ++--
     compiler/symtable.pas     |  6 +++---
     compiler/tokens.pas       | 10 +++++-----
     rtl/inc/rtti.inc          | 14 +++++++-------
     tests/test/tmoperator9.pp | 12 ++++++------
     7 files changed, 29 insertions(+), 29 deletions(-)
    
    diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
    index 787e5a5..0856853 100644
    --- a/compiler/htypechk.pas
    +++ b/compiler/htypechk.pas
    @@ -141,8 +141,8 @@ interface
           tok2op: array[1..tok2ops] of ttok2oprec = (
             (tok:_OP_INITIALIZE; managementoperator: mop_initialize),
             (tok:_OP_FINALIZE  ; managementoperator: mop_finalize),
    -        (tok:_OP_ADDREF    ; managementoperator: mop_addref),
    -        (tok:_OP_COPY      ; managementoperator: mop_copy)
    +        (tok:_OP_COPY      ; managementoperator: mop_copy),
    +        (tok:_OP_CLONE     ; managementoperator: mop_clone)
           );
     
           { true, if we are parsing stuff which allows array constructors }
    diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
    index cb745aa..b503a37 100644
    --- a/compiler/pdecsub.pas
    +++ b/compiler/pdecsub.pas
    @@ -598,7 +598,7 @@ implementation
                         _DEC:optoken:=_OP_DEC;
                         _INITIALIZE:optoken:=_OP_INITIALIZE;
                         _FINALIZE:optoken:=_OP_FINALIZE;
    -                    _ADDREF:optoken:=_OP_ADDREF;
    +                    _CLONE:optoken:=_OP_CLONE;
                         _COPY:optoken:=_OP_COPY;
                         else
                         if (m_delphi in current_settings.modeswitches) then
    @@ -1428,10 +1428,10 @@ implementation
                     end;
     
                   { operators without result }
    -              if optoken in [_OP_INITIALIZE, _OP_FINALIZE, _OP_ADDREF, _OP_COPY] then
    +              if optoken in [_OP_INITIALIZE, _OP_FINALIZE, _OP_COPY, _OP_CLONE] then
                     begin
                       { single var parameter to point the record }
    -                  if (optoken in [_OP_INITIALIZE, _OP_FINALIZE, _OP_ADDREF]) and
    +                  if (optoken in [_OP_INITIALIZE, _OP_FINALIZE, _OP_COPY]) and
                          (
                           (pd.parast.SymList.Count <> 1) or
                           (tparavarsym(pd.parast.SymList[0]).vardef<>pd.struct) or
    @@ -1439,7 +1439,7 @@ implementation
                          ) then
                         Message(parser_e_overload_impossible)
                       { constref (source) and var (dest) parameter to point the records }
    -                  else if (optoken = _OP_COPY) and
    +                  else if (optoken = _OP_CLONE) and
                          (
                           (pd.parast.SymList.Count <> 2) or
                           (tparavarsym(pd.parast.SymList[0]).vardef<>pd.struct) or
    diff --git a/compiler/symconst.pas b/compiler/symconst.pas
    index 1f7313b..bf8fb04 100644
    --- a/compiler/symconst.pas
    +++ b/compiler/symconst.pas
    @@ -585,8 +585,8 @@ type
       tmanagementoperator=(mop_none,
         mop_initialize,
         mop_finalize,
    -    mop_addref,
    -    mop_copy
    +    mop_copy,
    +    mop_clone
       );
       tmanagementoperators=set of tmanagementoperator;
     
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index f981989..a527904 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -432,8 +432,8 @@ interface
         { _OP_ENUMERATOR }  'enumerator',
         { _OP_INITIALIZE }  'initialize',
         { _OP_FINALIZE   }  'finalize',    
    -    { _OP_ADDREF     }  'addref',
         { _OP_COPY       }  'copy',
    +    { _OP_CLONE      }  'clone',
         { _OP_INC        }  'inc',
         { _OP_DEC        }  'dec');
     
    @@ -441,8 +441,8 @@ interface
         { mop_none       }  NOTOKEN,
         { mop_initialize }  _OP_INITIALIZE,
         { mop_finalize   }  _OP_FINALIZE,
    -    { mop_addref     }  _OP_ADDREF,
    -    { mop_copy       }  _OP_COPY
    +    { mop_copy       }  _OP_COPY,
    +    { mop_clone      }  _OP_CLONE
         );
     
     
    diff --git a/compiler/tokens.pas b/compiler/tokens.pas
    index 1757764..b379d91 100644
    --- a/compiler/tokens.pas
    +++ b/compiler/tokens.pas
    @@ -58,8 +58,8 @@ type
         _OP_ENUMERATOR,
         _OP_INITIALIZE,
         _OP_FINALIZE,    
    -    _OP_ADDREF,
         _OP_COPY,
    +    _OP_CLONE,
         _OP_INC,
         _OP_DEC,
         { special chars }
    @@ -158,6 +158,7 @@ type
         _BREAK,
         _CDECL,
         _CLASS,
    +    _CLONE,
         _CONST,
         _EQUAL,
         _FAR16,
    @@ -169,7 +170,6 @@ type
         _UNTIL,
         _WHILE,
         _WRITE,
    -    _ADDREF,
         _DISPID,
         _DIVIDE,
         _DOWNTO,
    @@ -329,7 +329,7 @@ const
       last_overloaded  = _OP_DEC;
       last_operator = _GENERICSPECIALTOKEN;
       first_managment_operator = _OP_INITIALIZE;
    -  last_managment_operator = _OP_COPY;
    +  last_managment_operator = _OP_CLONE;
     
       highest_precedence = oppower;
     
    @@ -391,8 +391,8 @@ const
           (str:'enumerator'    ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'initialize'    ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'finalize'      ;special:true ;keyword:[m_none];op:NOTOKEN),
    -      (str:'addref'        ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'copy'          ;special:true ;keyword:[m_none];op:NOTOKEN),
    +      (str:'clone'          ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'inc'           ;special:true ;keyword:[m_none];op:NOTOKEN),
           (str:'dec'           ;special:true ;keyword:[m_none];op:NOTOKEN),
         { Special chars }
    @@ -491,6 +491,7 @@ const
           (str:'BREAK'         ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'CDECL'         ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'CLASS'         ;special:false;keyword:[m_class];op:NOTOKEN),
    +      (str:'CLONE'        ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'CONST'         ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
           (str:'EQUAL'         ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
           (str:'FAR16'         ;special:false;keyword:[m_none];op:NOTOKEN),
    @@ -502,7 +503,6 @@ const
           (str:'UNTIL'         ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
           (str:'WHILE'         ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
           (str:'WRITE'         ;special:false;keyword:[m_none];op:NOTOKEN),
    -      (str:'ADDREF'        ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'DISPID'        ;special:false;keyword:[m_none];op:NOTOKEN),
           (str:'DIVIDE'        ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
           (str:'DOWNTO'        ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
    diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
    index 754f026..dbfb891 100644
    --- a/rtl/inc/rtti.inc
    +++ b/rtl/inc/rtti.inc
    @@ -58,7 +58,7 @@ type
     
     {$if FPC_FULLVERSION>30100}
       TRTTIRecVarOp=procedure(ARec: Pointer);
    -  TRTTIRecCopyOp=procedure(ASrc, ADest: Pointer);
    +  TRTTIRecCloneOp=procedure(ASrc, ADest: Pointer);
     
       PRTTIRecordOpVMT=^TRTTIRecordOpVMT;
       TRTTIRecordOpVMT=
    @@ -68,8 +68,8 @@ type
       record
         Initialize: TRTTIRecVarOp;
         Finalize: TRTTIRecVarOp;
    -    AddRef: TRTTIRecVarOp;
    -    Copy: TRTTIRecCopyOp;
    +    Copy: TRTTIRecVarOp;
    +    Clone: TRTTIRecCloneOp;
       end;
     
       PRecordInfoInit=^TRecordInfoInit;
    @@ -322,8 +322,8 @@ begin
           begin
             recordrtti(data,typeinfo,@int_addref);
     {$if FPC_FULLVERSION>30100}
    -        if Assigned(recordop) and Assigned(recordop^.AddRef) then
    -          recordop^.AddRef(Data);
    +        if Assigned(recordop) and Assigned(recordop^.Copy) then
    +          recordop^.Copy(Data);
     {$endif FPC_FULLVERSION>30100}
           end;
     {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
    @@ -404,8 +404,8 @@ begin
           begin
             Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
     {$if FPC_FULLVERSION>30100}
    -        if Assigned(recordop) and Assigned(recordop^.Copy) then
    -          recordop^.Copy(Src,Dest)
    +        if Assigned(recordop) and Assigned(recordop^.Clone) then
    +          recordop^.Clone(Src,Dest)
             else
               begin
                 Result:=Size;
    diff --git a/tests/test/tmoperator9.pp b/tests/test/tmoperator9.pp
    index 0e00e92..9126c92 100644
    --- a/tests/test/tmoperator9.pp
    +++ b/tests/test/tmoperator9.pp
    @@ -9,8 +9,8 @@ type
       private
         class operator Initialize(var aFoo: TFoo);
         class operator Finalize(var aFoo: TFoo);
    -    class operator AddRef(var aFoo: TFoo);
    -    class operator Copy(constref aSrc: TFoo; var aDst: TFoo);
    +    class operator Copy(var aFoo: TFoo);
    +    class operator Clone(constref aSrc: TFoo; var aDst: TFoo);
       public
         CopyState: TCopyState;
         Ref: Boolean;
    @@ -52,19 +52,19 @@ begin
       aFoo.F := 4;
     end;
     
    -class operator TFoo.AddRef(var aFoo: TFoo);
    +class operator TFoo.Copy(var aFoo: TFoo);
     begin
    -  WriteLn('TFoo.AddRef');
    +  WriteLn('TFoo.Copy');
       aFoo.F := 3;
       aFoo.Test := aFoo.Test + 1;
       aFoo.Ref := True;
     end;
     
    -class operator TFoo.Copy(constref aSrc: TFoo; var aDst: TFoo);
    +class operator TFoo.Clone(constref aSrc: TFoo; var aDst: TFoo);
     var
       LSrc: PFoo;
     begin
    -  WriteLn('TFoo.Copy');
    +  WriteLn('TFoo.Clone');
       LSrc := @aSrc;
       LSrc.CopyState := csSource;
       aDst.CopyState := csDest;
    -- 
    2.9.3.windows.2
    
    
  • 0010-Fix-for-small-compiling-issue-small-mistake-during-m.patch (646 bytes)
    From 5326a8c0d6c82c0e3b3d2d68ed3ba994abb64205 Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Fri, 30 Sep 2016 01:43:52 +0200
    Subject: [PATCH 10/15] Fix for small compiling issue (small mistake during
     merge)
    
    ---
     rtl/inc/rtti.inc | 1 -
     1 file changed, 1 deletion(-)
    
    diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
    index dbfb891..d066d5a 100644
    --- a/rtl/inc/rtti.inc
    +++ b/rtl/inc/rtti.inc
    @@ -396,7 +396,6 @@ begin
         tkobject,
     {$endif FPC_HAS_FEATURE_OBJECTS}
         tkrecord:
    -      begin
     {$if FPC_FULLVERSION>30100}
           { find init table }
           with RTTIRecordOp(typeinfo, typeinfo)^ do
    -- 
    2.9.3.windows.2
    
    
  • 0011-Adjustment-for-new-interface-for-DefineAsmSymbol-cha.patch (887 bytes)
    From 9cbd66ed67e3e25e4111be93cfbd9d7bcc61f8f3 Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Fri, 30 Sep 2016 10:38:49 +0200
    Subject: [PATCH 11/15] Adjustment for new interface for DefineAsmSymbol
     (changed in r34164)
    
    ---
     compiler/ncgrtti.pas | 2 +-
     1 file changed, 1 insertion(+), 1 deletion(-)
    
    diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas
    index 796bcf7..a41e2f0 100644
    --- a/compiler/ncgrtti.pas
    +++ b/compiler/ncgrtti.pas
    @@ -983,7 +983,7 @@ implementation
               begin
                 rttilab := current_asmdata.DefineAsmSymbol(
                     internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),
    -                AB_GLOBAL,AT_DATA);
    +                AB_GLOBAL,AT_DATA,def);
                 tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable]);
     
                 tcb.begin_anonymous_record(
    -- 
    2.9.3.windows.2
    
    
  • 0012-New-define-FPC_HAS_MANAGEMENT_OPERATORS.patch (783 bytes)
    From e797d83bf20898bbf4aeef1d279986afb3787fa1 Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Fri, 30 Sep 2016 11:04:04 +0200
    Subject: [PATCH 12/15] New define FPC_HAS_MANAGEMENT_OPERATORS
    
    ---
     compiler/options.pas | 1 +
     1 file changed, 1 insertion(+)
    
    diff --git a/compiler/options.pas b/compiler/options.pas
    index 4c16178..78c06d2 100644
    --- a/compiler/options.pas
    +++ b/compiler/options.pas
    @@ -3324,6 +3324,7 @@ begin
     {$if defined(x86_64) or defined(i386) or defined(arm) or defined(aarch64)}
       def_system_macro('FPC_HAS_EXTENDEDINTERFACERTTI');
     {$endif x86_64 or i386 or arm or aarch64}
    +  def_system_macro('FPC_HAS_MANAGEMENT_OPERATORS');
     
       def_system_macro('FPC_HAS_UNICODESTRING');
       def_system_macro('FPC_RTTI_PACKSET1');
    -- 
    2.9.3.windows.2
    
    
  • 0013-Create-indirect-symbol-fo-record-RTTI-to-initrtti-st.patch (2,975 bytes)
    From 273b8da24a40505939977601e50d8099dfd9a7d7 Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Mon, 3 Oct 2016 00:22:17 +0200
    Subject: [PATCH 13/15] * Create indirect symbol  fo record RTTI to initrtti
     structure which contains record operators VMT and "real" managed fields list.
     * Use Create_nil_dataptr instead of Create_nil_codeptr in right places.
    
    ---
     compiler/ncgrtti.pas | 11 ++++++-----
     rtl/inc/rtti.inc     |  4 ++--
     2 files changed, 8 insertions(+), 7 deletions(-)
    
    diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas
    index a41e2f0..d5561d2 100644
    --- a/compiler/ncgrtti.pas
    +++ b/compiler/ncgrtti.pas
    @@ -1030,12 +1030,13 @@ implementation
                { store rtti management operators only for init table }
                if (rt=initrtti) then
                begin
    -             tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
    +             tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
                  if (trecordsymtable(def.symtable).managementoperators=[]) then
    -               tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype)
    +               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,0),voidpointertype);
    +                 internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),
    +                 AT_DATA_FORCEINDIRECT,0),voidpointertype);
                end else
                begin
                  Include(def.defstates, ds_init_table_used);
    @@ -1187,9 +1188,9 @@ implementation
               begin
                 tcb.emit_ord_const(def.size, u32inttype);
                 { inittable terminator for vmt vInitTable }
    -            tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
    +            tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
                 { pointer to management operators }
    -            tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
    +            tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
                 { enclosing record takes care of alignment }
                 fields_write_rtti_data(tcb,def,rt);
               end;
    diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
    index d066d5a..6a1f081 100644
    --- a/rtl/inc/rtti.inc
    +++ b/rtl/inc/rtti.inc
    @@ -50,7 +50,7 @@ type
       record
         Size: Longint;
     {$if FPC_FULLVERSION>30100}
    -    InitTable: Pointer;
    +    InitTable: PPointer;
     {$endif FPC_FULLVERSION>30100}
         Count: Longint;
         { Elements: array[count] of TRecordElement }
    @@ -130,7 +130,7 @@ begin
       if Assigned(result^.Terminator) then
       begin
         { point to more optimal initrtti }
    -    initrtti:=PRecordInfoFull(result)^.InitTable;
    +    initrtti:=PRecordInfoFull(result)^.InitTable^;
         { and point to management operators in our init table }
         result:=aligntoptr(initrtti+2+PByte(initrtti)[1]);
       end
    -- 
    2.9.3.windows.2
    
    
  • 0014-Invoke-management-operators-even-for-records-with-si.patch (7,016 bytes)
    From 46fe321885c30b0384f405c37e4a55b452d83e88 Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Mon, 3 Oct 2016 15:56:28 +0200
    Subject: [PATCH 14/15] Invoke management operators even for records with size
     = 0.
    
    rtti.inc:
      + New function RTTISizeAndOp to get size and operator if exist (for FPC > 3.1.0)
      + Related type TRTTIRecOpType to RTTISizeAndOp (to get right management operator context)
      - Remove RTTISize for (for FPC > 3.1.0)
      * fpc_initialize_array, fpc_finalize_array, fpc_addref_array and CopyArray modifications for new RTTISizeAndOp
    
    + added tests
    ---
     rtl/inc/rtti.inc           | 73 +++++++++++++++++++++++++++++++++++++++-------
     tests/test/tmoperator10.pp | 55 ++++++++++++++++++++++++++++++++++
     tests/test/tmoperator11.pp | 24 +++++++++++++++
     3 files changed, 142 insertions(+), 10 deletions(-)
     create mode 100644 tests/test/tmoperator10.pp
     create mode 100644 tests/test/tmoperator11.pp
    
    diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
    index 6a1f081..d9ca49a 100644
    --- a/rtl/inc/rtti.inc
    +++ b/rtl/inc/rtti.inc
    @@ -59,7 +59,7 @@ type
     {$if FPC_FULLVERSION>30100}
       TRTTIRecVarOp=procedure(ARec: Pointer);
       TRTTIRecCloneOp=procedure(ASrc, ADest: Pointer);
    -
    +  TRTTIRecOpType=(rotAny, rotInitialize, rotFinalize, rotCopy, rotClone);
       PRTTIRecordOpVMT=^TRTTIRecordOpVMT;
       TRTTIRecordOpVMT=
     {$ifdef USE_PACKED}
    @@ -137,8 +137,15 @@ begin
     end;
     {$endif FPC_FULLVERSION>30100}
     
    +{$if FPC_FULLVERSION>30100}
    +function RTTISizeAndOp(typeInfo: Pointer;
    +  const expectedManagementOp: TRTTIRecOpType; out hasManagementOp: boolean): SizeInt;
    +begin
    +  hasManagementOp:=false;
    +{$else}
     function RTTISize(typeInfo: Pointer): SizeInt;
     begin
    +{$endif}
       case PByte(typeinfo)^ of
         tkAString,tkWString,tkUString,
         tkInterface,tkDynarray:
    @@ -149,8 +156,26 @@ begin
     {$endif FPC_HAS_FEATURE_VARIANTS}
         tkArray:
           result:=RTTIArraySize(typeinfo);
    +{$if FPC_FULLVERSION>30100}
    +    tkObject:
    +      result:=RTTIRecordSize(typeinfo);
    +    tkRecord:
    +      with RTTIRecordOp(typeInfo,typeInfo)^ do
    +        begin
    +          result:=Size;
    +          hasManagementOp := Assigned(RecordOp);
    +          if hasManagementOp then
    +            case expectedManagementOp of
    +              rotInitialize: hasManagementOp:=Assigned(RecordOp^.Initialize);
    +              rotFinalize: hasManagementOp:=Assigned(RecordOp^.Finalize);
    +              rotCopy: hasManagementOp:=Assigned(RecordOp^.Copy);
    +              rotClone: hasManagementOp:=Assigned(RecordOp^.Clone);
    +            end;
    +        end;
    +{$else FPC_FULLVERSION>30100}
         tkObject,tkRecord:
           result:=RTTIRecordSize(typeinfo);
    +{$endif FPC_FULLVERSION>30100}
       else
         result:=-1;
       end;
    @@ -462,30 +487,51 @@ end;
     procedure fpc_initialize_array(data,typeinfo : pointer;count : SizeInt); [public,alias:'FPC_INITIALIZE_ARRAY']; compilerproc;
       var
          i, size : SizeInt;
    +{$if FPC_FULLVERSION>30100}
    +    hasManagementOp: boolean;
       begin
    -     size:=RTTISize(typeinfo);
    -     if size>0 then
    -       for i:=0 to count-1 do
    -         int_initialize(data+size*i,typeinfo);
    +    size:=RTTISizeAndOp(typeinfo, rotInitialize, hasManagementOp);
    +    if (size>0) or hasManagementOp then
    +{$else FPC_FULLVERSION>30100}
    +  begin    
    +    size:=RTTISize(typeInfo);
    +    if size>0 then
    +{$endif FPC_FULLVERSION>30100}
    +      for i:=0 to count-1 do
    +        int_initialize(data+size*i,typeinfo);
       end;
     
     
     procedure fpc_finalize_array(data,typeinfo : pointer;count : SizeInt); [Public,Alias:'FPC_FINALIZE_ARRAY'];  compilerproc;
       var
          i, size: SizeInt;
    +{$if FPC_FULLVERSION>30100}
    +    hasManagementOp: boolean;
       begin
    -     size:=RTTISize(typeinfo);
    -     if size>0 then
    -       for i:=0 to count-1 do
    -         int_finalize(data+size*i,typeinfo);
    +    size:=RTTISizeAndOp(typeinfo, rotFinalize, hasManagementOp);
    +    if (size>0) or hasManagementOp then
    +{$else FPC_FULLVERSION>30100}
    +  begin    
    +    size:=RTTISize(typeInfo);
    +    if size>0 then
    +{$endif FPC_FULLVERSION>30100}
    +      for i:=0 to count-1 do
    +        int_finalize(data+size*i,typeinfo);
       end;
     
     procedure fpc_addref_array(data,typeinfo: pointer; count: SizeInt); [public,alias:'FPC_ADDREF_ARRAY']; compilerproc;
       var
         i, size: SizeInt;
    +{$if FPC_FULLVERSION>30100}
    +    hasManagementOp: boolean;
       begin
    -    size:=RTTISize(typeinfo);
    +    size:=RTTISizeAndOp(typeinfo, rotCopy, hasManagementOp);
    +    if (size>0) or hasManagementOp then
    +{$else FPC_FULLVERSION>30100}
    +  begin    
    +    size:=RTTISize(typeInfo);
         if size>0 then
    +{$endif FPC_FULLVERSION>30100}
           for i:=0 to count-1 do
             int_addref(data+size*i,typeinfo);
       end;
    @@ -510,9 +556,16 @@ procedure FinalizeArray(p, typeInfo: Pointer; count: SizeInt);
     procedure CopyArray(dest, source, typeInfo: Pointer; count: SizeInt);
       var
         i, size: SizeInt;
    +{$if FPC_FULLVERSION>30100}
    +    hasManagementOp: boolean;
       begin
    +    size:=RTTISizeAndOp(typeinfo, rotClone, hasManagementOp);
    +    if (size>0) or hasManagementOp then
    +{$else FPC_FULLVERSION>30100}
    +  begin    
         size:=RTTISize(typeInfo);
         if size>0 then
    +{$endif FPC_FULLVERSION>30100}
           for i:=0 to count-1 do
             fpc_Copy_internal(source+size*i, dest+size*i, typeInfo);
       end;
    diff --git a/tests/test/tmoperator10.pp b/tests/test/tmoperator10.pp
    new file mode 100644
    index 0000000..4f8f7de
    --- /dev/null
    +++ b/tests/test/tmoperator10.pp
    @@ -0,0 +1,55 @@
    +program tmoperator10;
    +
    +{$MODE DELPHI}
    +
    +type
    +
    +  { TFoo }
    +
    +  PFoo = ^TFoo;
    +  TFoo = record
    +  private
    +    class operator Initialize(var aFoo: TFoo);
    +    class operator Finalize(var aFoo: TFoo);
    +  end;
    +
    +{ TFoo }
    +
    +var
    +  ok_initialize: boolean = false;
    +  ok_finalize: boolean = false;
    +
    +class operator TFoo.Initialize(var aFoo: TFoo);
    +begin
    +  ok_initialize := true;
    +end;
    +
    +class operator TFoo.Finalize(var aFoo: TFoo);
    +begin
    +  ok_finalize := true;
    +end;
    +
    +var
    +  PF: PFoo;
    +begin
    +  { init rtti test }
    +  New(PF);
    +  if not ok_initialize then
    +    Halt(1);
    +  Dispose(PF);
    +  if not ok_finalize then
    +    Halt(2);
    +
    +  ok_initialize := false;
    +  ok_finalize := false;
    +
    +  { regular rtti test }
    +  GetMem(PF, SizeOf(TFoo));
    +  InitializeArray(PF, TypeInfo(TFoo), 1);
    +  if not ok_initialize then
    +    Halt(3);
    +  FinalizeArray(PF, TypeInfo(TFoo), 1);
    +  if not ok_finalize then
    +    Halt(4);
    +  FreeMem(PF);
    +end. 
    \ No newline at end of file
    diff --git a/tests/test/tmoperator11.pp b/tests/test/tmoperator11.pp
    new file mode 100644
    index 0000000..c487346
    --- /dev/null
    +++ b/tests/test/tmoperator11.pp
    @@ -0,0 +1,24 @@
    +program tmoperator11;
    +
    +{$MODE DELPHI}
    +
    +uses
    +  TypInfo;
    +
    +type
    +  TFoo = record
    +  private
    +    class operator Initialize(var aFoo: TFoo);
    +  end;
    +  TFooArray = array of TFoo;
    +
    +class operator TFoo.Initialize(var aFoo: TFoo);
    +begin
    +end;
    +
    +begin
    +  if GetTypeData(TypeInfo(TFooArray))^.ElType = nil then
    +    Halt(1);
    +  if GetTypeData(TypeInfo(TFooArray))^.ElType2 = nil then
    +    Halt(2);
    +end. 
    \ No newline at end of file
    -- 
    2.9.3.windows.2
    
    
  • 0015-Speed-up-SetLength-if-record-is-not-managed-has-no-m.patch (1,855 bytes)
    From 42cd4099ea9fc7d46de9288181712b6c6d03b7a2 Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Mon, 3 Oct 2016 19:56:08 +0200
    Subject: [PATCH 15/15] Speed up SetLength if record is not managed (has no
     management operators nor managed fields)
    
    ---
     rtl/inc/dynarr.inc | 6 +++---
     1 file changed, 3 insertions(+), 3 deletions(-)
    
    diff --git a/rtl/inc/dynarr.inc b/rtl/inc/dynarr.inc
    index 6e43e17..2d828c7 100644
    --- a/rtl/inc/dynarr.inc
    +++ b/rtl/inc/dynarr.inc
    @@ -34,7 +34,7 @@ type
           thus use packed also in this case }
         {$ifdef VER3_0_0}
           packed
    -    {$endif VER"_0_0}
    +    {$endif VER3_0_0}
       {$endif powerpc64}
     
     {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    @@ -187,7 +187,7 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
               fillchar(newp^,size,0);
     {$if FPC_FULLVERSION>30100}
               { call int_InitializeArray for management operators }
    -          if PByte(eletype)^ in [tkRecord, tkObject] then
    +          if assigned(eletypemngd) and (PByte(eletype)^ in [tkRecord, tkObject]) then
                 int_InitializeArray(pointer(newp)+sizeof(tdynarray), eletype, dims[0]);
     {$endif FPC_FULLVERSION>30100}
               updatep := true;
    @@ -264,7 +264,7 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
                                (dims[0]-realp^.high-1)*elesize,0);
     {$if FPC_FULLVERSION>30100}
                              { call int_InitializeArray for management operators }
    -                         if PByte(eletype)^ in [tkRecord, tkObject] then
    +                         if assigned(eletypemngd) and (PByte(eletype)^ in [tkRecord, tkObject]) then
                                int_InitializeArray(pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1),
                                  eletype, dims[0]-realp^.high-1);
     {$endif FPC_FULLVERSION>30100}
    -- 
    2.9.3.windows.2
    
    
  • 0001-typinfo.pp-Small-correction-more-proper-declaration-.patch (880 bytes)
    From 718fd0b9c20ea7b3aad0e87c55e2f78a8a845d26 Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Sun, 9 Oct 2016 14:55:44 +0200
    Subject: [PATCH] typinfo.pp: Small correction (more proper declaration) for
     indirect RTTI symbol for TTypeData for RecInitTable field.
    
    ---
     rtl/objpas/typinfo.pp | 2 +-
     1 file changed, 1 insertion(+), 1 deletion(-)
    
    diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp
    index 5652900..173ab1f 100644
    --- a/rtl/objpas/typinfo.pp
    +++ b/rtl/objpas/typinfo.pp
    @@ -313,7 +313,7 @@ unit typinfo;
                   (
                     RecSize: Integer;
     {$if FPC_FULLVERSION>30100}
    -                RecInitTable: Pointer;
    +                RecInitTable: PPointer;
     {$endif FPC_FULLVERSION>30100}
                     ManagedFldCount: Integer;
                     {ManagedFields: array[1..ManagedFldCount] of TManagedField}
    -- 
    2.9.3.windows.2
    
    
  • 0001-Use-more-readable-FPC_HAS_MANAGEMENT_OPERATORS-inste.patch (13,374 bytes)
    From a8f4f122cccf7f35f88e89798f23d3dbc6030644 Mon Sep 17 00:00:00 2001
    From: maciej-izak <hnb.code@gmail.com>
    Date: Sun, 23 Oct 2016 11:54:04 +0200
    Subject: [PATCH] Use more readable FPC_HAS_MANAGEMENT_OPERATORS instead of
     FPC_FULLVERSION>30100 for RTL part
    
    ---
     rtl/inc/dynarr.inc    |  8 ++---
     rtl/inc/objpas.inc    |  8 ++---
     rtl/inc/rtti.inc      | 88 +++++++++++++++++++++++++--------------------------
     rtl/objpas/typinfo.pp |  4 +--
     4 files changed, 54 insertions(+), 54 deletions(-)
    
    diff --git a/rtl/inc/dynarr.inc b/rtl/inc/dynarr.inc
    index 2d828c7..1724dd3 100644
    --- a/rtl/inc/dynarr.inc
    +++ b/rtl/inc/dynarr.inc
    @@ -185,11 +185,11 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
                 exit;
               getmem(newp,size);
               fillchar(newp^,size,0);
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
               { call int_InitializeArray for management operators }
               if assigned(eletypemngd) and (PByte(eletype)^ in [tkRecord, tkObject]) then
                 int_InitializeArray(pointer(newp)+sizeof(tdynarray), eletype, dims[0]);
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
               updatep := true;
            end
          else
    @@ -262,12 +262,12 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
                              reallocmem(realp,size);
                              fillchar((pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1))^,
                                (dims[0]-realp^.high-1)*elesize,0);
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
                              { call int_InitializeArray for management operators }
                              if assigned(eletypemngd) and (PByte(eletype)^ in [tkRecord, tkObject]) then
                                int_InitializeArray(pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1),
                                  eletype, dims[0]-realp^.high-1);
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
                           end;
                         newp := realp;
                         updatep := true;
    diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc
    index 3072923..8fdfe79 100644
    --- a/rtl/inc/objpas.inc
    +++ b/rtl/inc/objpas.inc
    @@ -379,11 +379,11 @@
     
           class function TObject.InitInstance(instance : pointer) : tobject; {$ifdef SYSTEMINLINE} inline; {$ENDIF}
     
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
             var
                vmt  : PVmt;
                temp : pointer;
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
             begin
                { the size is saved at offset 0 }
                fillchar(instance^, InstanceSize, 0);
    @@ -393,7 +393,7 @@
                if {$ifdef VER3_0}PVmt(self)^.vIntfTable <> @emptyintf{$else}assigned(PVmt(self)^.vIntfTable){$endif} then
                  InitInterfacePointers(self,instance);
     
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
                { for record operators like initialize/finalize call int_initialize }
                vmt := PVmt(self);
                while vmt<>nil do
    @@ -405,7 +405,7 @@
                      RecordRTTI(Instance,Temp,@int_initialize);
                    vmt:= vmt^.vParent;
                  end;
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
     
                InitInstance:=TObject(Instance);
             end;
    diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
    index d9ca49a..9e28bd5 100644
    --- a/rtl/inc/rtti.inc
    +++ b/rtl/inc/rtti.inc
    @@ -49,14 +49,14 @@ type
     {$endif USE_PACKED}
       record
         Size: Longint;
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
         InitTable: PPointer;
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
         Count: Longint;
         { Elements: array[count] of TRecordElement }
       end;
     
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
       TRTTIRecVarOp=procedure(ARec: Pointer);
       TRTTIRecCloneOp=procedure(ASrc, ADest: Pointer);
       TRTTIRecOpType=(rotAny, rotInitialize, rotFinalize, rotCopy, rotClone);
    @@ -84,7 +84,7 @@ type
         Count: Longint;
         { Elements: array[count] of TRecordElement }
       end;
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
     
       PArrayInfo=^TArrayInfo;
       TArrayInfo=
    @@ -119,7 +119,7 @@ begin
       result:=PRecordInfoFull(typeInfo)^.Size;
     end;
     
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
     function RTTIRecordOp(typeInfo: Pointer; var initrtti: Pointer): PRecordInfoInit; inline;
     begin
       { find init table and management operators }
    @@ -135,17 +135,17 @@ begin
         result:=aligntoptr(initrtti+2+PByte(initrtti)[1]);
       end
     end;
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
     
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
     function RTTISizeAndOp(typeInfo: Pointer;
       const expectedManagementOp: TRTTIRecOpType; out hasManagementOp: boolean): SizeInt;
     begin
       hasManagementOp:=false;
    -{$else}
    +{$else FPC_HAS_MANAGEMENT_OPERATORS}
     function RTTISize(typeInfo: Pointer): SizeInt;
     begin
    -{$endif}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
       case PByte(typeinfo)^ of
         tkAString,tkWString,tkUString,
         tkInterface,tkDynarray:
    @@ -156,7 +156,7 @@ begin
     {$endif FPC_HAS_FEATURE_VARIANTS}
         tkArray:
           result:=RTTIArraySize(typeinfo);
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
         tkObject:
           result:=RTTIRecordSize(typeinfo);
         tkRecord:
    @@ -172,10 +172,10 @@ begin
                   rotClone: hasManagementOp:=Assigned(RecordOp^.Clone);
                 end;
             end;
    -{$else FPC_FULLVERSION>30100}
    +{$else FPC_HAS_MANAGEMENT_OPERATORS}
         tkObject,tkRecord:
           result:=RTTIRecordSize(typeinfo);
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
       else
         result:=-1;
       end;
    @@ -188,13 +188,13 @@ var
       i : longint;
     begin
       typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
       Count:=PRecordInfoInit(typeInfo)^.Count;
       Inc(PRecordInfoInit(typeInfo));
    -{$else FPC_FULLVERSION>30100}
    +{$else FPC_HAS_MANAGEMENT_OPERATORS}
       Count:=PRecordInfoFull(typeInfo)^.Count;
       Inc(PRecordInfoFull(typeInfo));
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
       { Process elements }
       for i:=1 to count Do
         begin
    @@ -254,7 +254,7 @@ begin
         tkObject,
     {$endif FPC_HAS_FEATURE_OBJECTS}
         tkRecord:
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
           { if possible try to use more optimal initrtti }
           with RTTIRecordOp(typeinfo, typeinfo)^ do
           begin
    @@ -262,9 +262,9 @@ begin
             if Assigned(recordop) and Assigned(recordop^.Initialize) then
               recordop^.Initialize(data);
           end;
    -{$else FPC_FULLVERSION>30100}
    +{$else FPC_HAS_MANAGEMENT_OPERATORS}
           recordrtti(data,typeinfo,@int_initialize);
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
     {$ifdef FPC_HAS_FEATURE_VARIANTS}
         tkVariant:
           variant_init(PVarData(Data)^);
    @@ -294,7 +294,7 @@ begin
         tkObject,
     {$endif FPC_HAS_FEATURE_OBJECTS}
         tkRecord:
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
           { if possible try to use more optimal initrtti }
           with RTTIRecordOp(typeinfo, typeinfo)^ do
           begin
    @@ -302,9 +302,9 @@ begin
               recordop^.Finalize(data);
             recordrtti(data,typeinfo,@int_finalize);
           end;
    -{$else FPC_FULLVERSION>30100}
    +{$else FPC_HAS_MANAGEMENT_OPERATORS}
           recordrtti(data,typeinfo,@int_finalize);
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
         tkInterface:
           Intf_Decr_Ref(PPointer(Data)^);
     {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
    @@ -340,16 +340,16 @@ begin
         tkobject,
     {$endif FPC_HAS_FEATURE_OBJECTS}
         tkrecord :
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
           { find init table }
           with RTTIRecordOp(typeinfo, typeinfo)^ do
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
           begin
             recordrtti(data,typeinfo,@int_addref);
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
             if Assigned(recordop) and Assigned(recordop^.Copy) then
               recordop^.Copy(Data);
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
           end;
     {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
         tkDynArray:
    @@ -421,24 +421,24 @@ begin
         tkobject,
     {$endif FPC_HAS_FEATURE_OBJECTS}
         tkrecord:
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
           { find init table }
           with RTTIRecordOp(typeinfo, typeinfo)^ do
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
           begin
             Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
             if Assigned(recordop) and Assigned(recordop^.Clone) then
               recordop^.Clone(Src,Dest)
             else
               begin
                 Result:=Size;
                 Inc(PRecordInfoInit(Temp));
    -{$else FPC_FULLVERSION>30100}
    +{$else FPC_HAS_MANAGEMENT_OPERATORS}
                 Result:=PRecordInfoFull(Temp)^.Size;
                 Count:=PRecordInfoFull(Temp)^.Count;
                 Inc(PRecordInfoFull(Temp));
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
                 expectedoffset:=0;
                 { Process elements with rtti }
                 for i:=1 to Count Do
    @@ -454,9 +454,9 @@ begin
                 { elements remaining? }
                 if result>expectedoffset then
                   move((Src+expectedoffset)^,(Dest+expectedoffset)^,Result-expectedoffset);
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
               end;
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
           end;
     {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
         tkDynArray:
    @@ -487,16 +487,16 @@ end;
     procedure fpc_initialize_array(data,typeinfo : pointer;count : SizeInt); [public,alias:'FPC_INITIALIZE_ARRAY']; compilerproc;
       var
          i, size : SizeInt;
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
         hasManagementOp: boolean;
       begin
         size:=RTTISizeAndOp(typeinfo, rotInitialize, hasManagementOp);
         if (size>0) or hasManagementOp then
    -{$else FPC_FULLVERSION>30100}
    +{$else FPC_HAS_MANAGEMENT_OPERATORS}
       begin    
         size:=RTTISize(typeInfo);
         if size>0 then
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
           for i:=0 to count-1 do
             int_initialize(data+size*i,typeinfo);
       end;
    @@ -505,16 +505,16 @@ procedure fpc_initialize_array(data,typeinfo : pointer;count : SizeInt); [public
     procedure fpc_finalize_array(data,typeinfo : pointer;count : SizeInt); [Public,Alias:'FPC_FINALIZE_ARRAY'];  compilerproc;
       var
          i, size: SizeInt;
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
         hasManagementOp: boolean;
       begin
         size:=RTTISizeAndOp(typeinfo, rotFinalize, hasManagementOp);
         if (size>0) or hasManagementOp then
    -{$else FPC_FULLVERSION>30100}
    +{$else FPC_HAS_MANAGEMENT_OPERATORS}
       begin    
         size:=RTTISize(typeInfo);
         if size>0 then
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
           for i:=0 to count-1 do
             int_finalize(data+size*i,typeinfo);
       end;
    @@ -522,16 +522,16 @@ procedure fpc_finalize_array(data,typeinfo : pointer;count : SizeInt); [Public,A
     procedure fpc_addref_array(data,typeinfo: pointer; count: SizeInt); [public,alias:'FPC_ADDREF_ARRAY']; compilerproc;
       var
         i, size: SizeInt;
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
         hasManagementOp: boolean;
       begin
         size:=RTTISizeAndOp(typeinfo, rotCopy, hasManagementOp);
         if (size>0) or hasManagementOp then
    -{$else FPC_FULLVERSION>30100}
    +{$else FPC_HAS_MANAGEMENT_OPERATORS}
       begin    
         size:=RTTISize(typeInfo);
         if size>0 then
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
           for i:=0 to count-1 do
             int_addref(data+size*i,typeinfo);
       end;
    @@ -556,16 +556,16 @@ procedure FinalizeArray(p, typeInfo: Pointer; count: SizeInt);
     procedure CopyArray(dest, source, typeInfo: Pointer; count: SizeInt);
       var
         i, size: SizeInt;
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
         hasManagementOp: boolean;
       begin
         size:=RTTISizeAndOp(typeinfo, rotClone, hasManagementOp);
         if (size>0) or hasManagementOp then
    -{$else FPC_FULLVERSION>30100}
    +{$else FPC_HAS_MANAGEMENT_OPERATORS}
       begin    
         size:=RTTISize(typeInfo);
         if size>0 then
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
           for i:=0 to count-1 do
             fpc_Copy_internal(source+size*i, dest+size*i, typeInfo);
       end;
    diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp
    index 173ab1f..d801f7b 100644
    --- a/rtl/objpas/typinfo.pp
    +++ b/rtl/objpas/typinfo.pp
    @@ -312,9 +312,9 @@ unit typinfo;
                 tkRecord:
                   (
                     RecSize: Integer;
    -{$if FPC_FULLVERSION>30100}
    +{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
                     RecInitTable: PPointer;
    -{$endif FPC_FULLVERSION>30100}
    +{$endif FPC_HAS_MANAGEMENT_OPERATORS}
                     ManagedFldCount: Integer;
                     {ManagedFields: array[1..ManagedFldCount] of TManagedField}
                   );
    -- 
    2.9.3.windows.2
    
    
  • mo-patch-final.zip (28,207 bytes)

Activities

Maciej Izak

2016-10-03 21:51

reporter  

0001-Fix-small-typo-don-t-use-COPY-token-as-keyword.patch (5,417 bytes)
From f687dedb86d89ffdf3db4ae03464b736f8eed791 Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Thu, 29 Sep 2016 23:25:25 +0200
Subject: [PATCH 01/15] * Fix small typo - don't use 'COPY' token as keyword

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33118

* New tokens for new record operators: Initialize, Copy and Finalize. Small adjustments in compiler for new tokens.

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33115
---
 compiler/pstatmnt.pas |  4 ++--
 compiler/symtable.pas |  3 +++
 compiler/tokens.pas   | 14 ++++++++++++++
 3 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas
index 0f3e232..1a74d3c 100644
--- a/compiler/pstatmnt.pas
+++ b/compiler/pstatmnt.pas
@@ -1355,7 +1355,7 @@ implementation
          filepos:=current_tokenpos;
          consume(starttoken);
 
-         while not(token in [_END,_FINALIZATION]) do
+         while not((token = _END) or (token = _FINALIZATION)) do
            begin
               if first=nil then
                 begin
@@ -1367,7 +1367,7 @@ implementation
                    tstatementnode(last).right:=cstatementnode.create(statement,nil);
                    last:=tstatementnode(last).right;
                 end;
-              if (token in [_END,_FINALIZATION]) then
+              if ((token = _END) or (token = _FINALIZATION)) then
                 break
               else
                 begin
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 3a46c8b..3672b4d 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -422,6 +422,9 @@ interface
     { _ASSIGNMENT    }  'assign',
     { _OP_EXPLICIT   }  'explicit',
     { _OP_ENUMERATOR }  'enumerator',
+    { _OP_INITIALIZE }  'initialize',
+    { _OP_COPY       }  'copy',
+    { _OP_FINALIZE   }  'finalize',    
     { _OP_INC        }  'inc',
     { _OP_DEC        }  'dec');
 
diff --git a/compiler/tokens.pas b/compiler/tokens.pas
index bb1d1eb..3283b5f 100644
--- a/compiler/tokens.pas
+++ b/compiler/tokens.pas
@@ -56,6 +56,9 @@ type
     _ASSIGNMENT,
     _OP_EXPLICIT,
     _OP_ENUMERATOR,
+    _OP_INITIALIZE,
+    _OP_COPY,
+    _OP_FINALIZE,    
     _OP_INC,
     _OP_DEC,
     { special chars }
@@ -129,6 +132,7 @@ type
     _VAR,
     _XOR,
     _CASE,
+    _COPY,
     _CVAR,
     _ELSE,
     _EXIT,
@@ -220,6 +224,7 @@ type
     _CPPCLASS,
     _EXPLICIT,
     _EXTERNAL,
+    _FINALIZE,
     _FUNCTION,
     _IMPLICIT,
     _LESSTHAN,
@@ -271,6 +276,7 @@ type
     _DESTRUCTOR,
     _ENUMERATOR,
     _IMPLEMENTS,
+    _INITIALIZE,
     _INTERNPROC,
     _LOGICALAND,
     _LOGICALNOT,
@@ -320,6 +326,8 @@ const
   first_overloaded = succ(NOTOKEN);
   last_overloaded  = _OP_DEC;
   last_operator = _GENERICSPECIALTOKEN;
+  first_managment_operator = _OP_INITIALIZE;
+  last_managment_operator = _OP_FINALIZE;
 
   highest_precedence = oppower;
 
@@ -379,6 +387,9 @@ const
       (str:':='            ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'explicit'      ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'enumerator'    ;special:true ;keyword:[m_none];op:NOTOKEN),
+      (str:'initialize'    ;special:true ;keyword:[m_none];op:NOTOKEN),
+      (str:'copy'          ;special:true ;keyword:[m_none];op:NOTOKEN),
+      (str:'finalize'      ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'inc'           ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'dec'           ;special:true ;keyword:[m_none];op:NOTOKEN),
     { Special chars }
@@ -452,6 +463,7 @@ const
       (str:'VAR'           ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'XOR'           ;special:false;keyword:alllanguagemodes;op:_OP_XOR),
       (str:'CASE'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
+      (str:'COPY'          ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'CVAR'          ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'ELSE'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'EXIT'          ;special:false;keyword:[m_none];op:NOTOKEN),
@@ -543,6 +555,7 @@ const
       (str:'CPPCLASS'      ;special:false;keyword:[m_fpc];op:NOTOKEN),
       (str:'EXPLICIT'      ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
       (str:'EXTERNAL'      ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'FINALIZE'      ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'FUNCTION'      ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'IMPLICIT'      ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
       (str:'LESSTHAN'      ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
@@ -594,6 +607,7 @@ const
       (str:'DESTRUCTOR'    ;special:false;keyword:alllanguagemodes-[m_iso,m_extpas];op:NOTOKEN),
       (str:'ENUMERATOR'    ;special:false;keyword:[m_none];op:_OP_ENUMERATOR),
       (str:'IMPLEMENTS'    ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'INITIALIZE'    ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'INTERNPROC'    ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'LOGICALAND'    ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
       (str:'LOGICALNOT'    ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
-- 
2.9.3.windows.2

Maciej Izak

2016-10-03 21:52

reporter  

0002-Add-support-for-new-record-operators-management-oper.patch (41,318 bytes)
From db3cd91bbdadb776103a87331682823df87a1b57 Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Fri, 30 Sep 2016 00:17:04 +0200
Subject: [PATCH 02/15] Add support for new record operators (management
 operators): Initialize, Finalize. They working like low level auto-executed
 constructor/destructor for records.

rtl/objpas/typinfo.pp, TTypeData:
  + new field RecInitTable, pointer to init table

rtl/inc/rtti.inc:
  * rename TRecordInfo to TRecordInfoFull, is realated to fullrtti (rtti table)
  + new field for TRecordInfoFull: InitTable (pointer to init table)
  + new record TRecordInfoInit, related to initrtti (init table)
  + new record TRTTIRecordOpVMT to handle record management operators (has 2 reserved slots for addref and copy operators)
  + new function RTTIRecordOp to obtain init table pointer and record management operators (both are related)
  * adjust existing code to new RTTI. Affected functions: RecordRTTI, fpc_Initialize, fpc_finalize, fpc_Addref, fpc_Copy

rtl/inc/objpas.inc, TObject.InitInstance:
  * allow to call Initialize operator for object fields

tokens.pas:
  - temporary remove _OP_COPY token

symtable.pas:
  + trecordsymtable: new field managementoperators for storing included management operators
  + trecordsymtable: new method includemanagementoperator to include new management operator
  + new function search_management_operator
  + new const managementoperator2tok for conversion tmanagementoperator to ttoken

symdef.pas:
  * store set trecordsymtable.managementoperators into ppu file
  * add new condition into trecorddef.needs_inittable (returns true when any of management operators is used)

symconst.pas:
  + new enum tmanagementoperator and related set tmanagementoperators for storing new operators Initialize, Finalize and for future operators: addref and copy
  + new item itp_init_record_operators in tinternaltypeprefix enum for storing management operators into init table
  + new position '$init_record_operators$' in internaltypeprefixName const, related to itp_init_record_operators

ppu.pas:
  * increase ppu version (CurrentPPUVersion), related to new trecordsymtable.managementoperators

pdecsub.pas:
  * add new operators tokens _INITIALIZE, _FINALIZE into parse_operator_name function
  * parse_proc_dec_finish: class operator is always static so always include po_staticmethod into pd.procoptions for potype_operator
  * parse_proc_dec_finish: parse in correct way new operators (first class operators without result)

ncgrtti.pas:
  + new procedure write_record_operators for storing management operators
  * recorddef_rtti: init rtti and full rtti is different for better performance and for less memory usage (see TRecordInfoFull and TRecordInfoInit in rtl/inc/rtti.inc). Allow to save initrtti for fullrtti, guarantee initrtti for any record for fpc_initialize, fpc_finalize, fpc_copy and fpc_addref. Related to

trtti10.pp test.
  * objectdef_rtti_fields: adjust rtti for objects to new rtti.

htypechk.pas:
  + new Ttok2opRec record
  + new tok2op const for conversion ttoken to tmanagementoperator
  + new function token2managementoperator

hlcgobj.pas, thlcgobj.initialize_data:
  * allow checking global variables (affects only records and classic pascal objects) for management operators. In the case of management operator, "initialize data node" is needed.

+ added tests
git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33200
---
 compiler/htypechk.pas     |  24 ++++++++
 compiler/ncgrtti.pas      |  74 +++++++++++++++++++++++++
 compiler/ngenutil.pas     |  13 ++++-
 compiler/pdecsub.pas      |  82 ++++++++++++++++-----------
 compiler/symconst.pas     |  11 ++++
 compiler/symdef.pas       |   5 +-
 compiler/symtable.pas     |  50 ++++++++++++++++-
 compiler/tokens.pas       |   4 --
 rtl/inc/objpas.inc        |  16 ++++++
 rtl/inc/rtti.inc          |  84 ++++++++++++++++++++++++----
 rtl/objpas/typinfo.pp     |   1 +
 tests/test/tmoperator1.pp |  29 ++++++++++
 tests/test/tmoperator2.pp | 129 +++++++++++++++++++++++++++++++++++++++++++
 tests/test/tmoperator3.pp | 104 ++++++++++++++++++++++++++++++++++
 tests/test/tmoperator4.pp |  81 +++++++++++++++++++++++++++
 tests/test/tmoperator5.pp | 138 ++++++++++++++++++++++++++++++++++++++++++++++
 tests/test/tmoperator6.pp |  28 ++++++++++
 tests/test/tmoperator7.pp |  15 +++++
 18 files changed, 839 insertions(+), 49 deletions(-)
 create mode 100644 tests/test/tmoperator1.pp
 create mode 100644 tests/test/tmoperator2.pp
 create mode 100644 tests/test/tmoperator3.pp
 create mode 100644 tests/test/tmoperator4.pp
 create mode 100644 tests/test/tmoperator5.pp
 create mode 100644 tests/test/tmoperator6.pp
 create mode 100644 tests/test/tmoperator7.pp

diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index a908d42..ec9bb07 100644
--- a/compiler/htypechk.pas
+++ b/compiler/htypechk.pas
@@ -39,6 +39,11 @@ interface
         op_overloading_supported : boolean;
       end;
 
+      Ttok2opRec=record
+        tok : ttoken;
+        managementoperator: tmanagementoperator;
+      end;
+
       pcandidate = ^tcandidate;
       tcandidate = record
          next         : pcandidate;
@@ -132,10 +137,17 @@ interface
         (tok:_OP_DEC     ;nod:inlinen;inr:in_dec_x;op_overloading_supported:true) { unary overloading supported }
       );
 
+      tok2ops=2;
+      tok2op: array[1..tok2ops] of ttok2oprec = (
+        (tok:_OP_INITIALIZE; managementoperator: mop_initialize),
+        (tok:_OP_FINALIZE  ; managementoperator: mop_finalize)
+      );
+
       { true, if we are parsing stuff which allows array constructors }
       allow_array_constructor : boolean = false;
 
     function node2opstr(nt:tnodetype):string;
+    function token2managementoperator(optoken : ttoken): tmanagementoperator;
 
     { check operator args and result type }
     function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
@@ -217,6 +229,18 @@ implementation
             end;
        end;
 
+    function token2managementoperator(optoken: ttoken): tmanagementoperator;
+      var
+        i : integer;
+      begin
+        result:=mop_none;
+        for i:=1 to tok2ops do
+          if tok2op[i].tok=optoken then
+            begin
+              result:=tok2op[i].managementoperator;
+              break;
+            end;
+      end;
 
     function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
 
diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas
index eafff74..6752527 100644
--- a/compiler/ncgrtti.pas
+++ b/compiler/ncgrtti.pas
@@ -972,6 +972,51 @@ implementation
         end;
 
         procedure recorddef_rtti(def:trecorddef);
+
+          procedure write_record_operators;
+          var
+            rttilab: Tasmsymbol;
+            rttidef: tdef;
+            tcb: ttai_typedconstbuilder;
+            mop: tmanagementoperator;
+            procdef: tprocdef;
+          begin
+            rttilab := current_asmdata.DefineAsmSymbol(
+                internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),
+                AB_GLOBAL,AT_DATA);
+            tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable]);
+
+            tcb.begin_anonymous_record(
+              rttilab.Name,
+              defaultpacking,reqalign,
+              targetinfos[target_info.system]^.alignment.recordalignmin,
+              targetinfos[target_info.system]^.alignment.maxCrecordalign
+            );
+
+            { use "succ" to omit first enum item "mop_none" }
+            for mop := succ(low(tmanagementoperator)) to high(tmanagementoperator) do
+            begin
+              if not (mop in trecordsymtable(def.symtable).managementoperators) then
+                tcb.emit_tai(Tai_const.Create_nil_codeptr,voidcodepointertype)
+              else
+                begin
+                  procdef := search_management_operator(mop, def);
+                  if procdef = nil then
+                    internalerror(201603021)
+                  else
+                    tcb.emit_tai(Tai_const.Createname(procdef.mangledname,AT_FUNCTION,0),
+                      cprocvardef.getreusableprocaddr(procdef));
+                end;
+            end;
+
+            rttidef := tcb.end_anonymous_record;
+
+            current_asmdata.AsmLists[al_rtti].concatList(
+              tcb.get_final_asmlist(rttilab,rttidef,sec_rodata,rttilab.name,
+              const_align(sizeof(pint))));
+            tcb.free;
+          end;
+
         begin
            write_header(tcb,def,tkRecord);
            { need extra reqalign record, because otherwise the u32 int will
@@ -981,8 +1026,33 @@ implementation
              targetinfos[target_info.system]^.alignment.recordalignmin,
              targetinfos[target_info.system]^.alignment.maxCrecordalign);
            tcb.emit_ord_const(def.size,u32inttype);
+
+           { store rtti management operators only for init table }
+           if (rt=initrtti) then
+           begin
+             tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
+             if (trecordsymtable(def.symtable).managementoperators=[]) then
+               tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype)
+             else
+               tcb.emit_tai(Tai_const.Createname(
+                 internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),AT_DATA,0),voidpointertype);
+           end else
+           begin
+             Include(def.defstates, ds_init_table_used);
+             write_rtti_reference(tcb,def,initrtti);
+           end;
+
            fields_write_rtti_data(tcb,def,rt);
            tcb.end_anonymous_record;
+
+           { write pointers to operators if needed }
+           if (rt=initrtti) and (trecordsymtable(def.symtable).managementoperators<>[]) then
+             write_record_operators;
+
+           { guarantee initrtti for any record for fpc_initialize, fpc_finalize, fpc_copy and fpc_addref }
+           if (rt = fullrtti) and (ds_init_table_used in def.defstates) and
+              not (ds_init_table_written in def.defstates) then
+             write_rtti(def, initrtti);
         end;
 
 
@@ -1116,6 +1186,10 @@ implementation
           procedure objectdef_rtti_fields(def:tobjectdef);
           begin
             tcb.emit_ord_const(def.size, u32inttype);
+            { inittable terminator for vmt vInitTable }
+            tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
+            { pointer to management operators }
+            tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
             { enclosing record takes care of alignment }
             fields_write_rtti_data(tcb,def,rt);
           end;
diff --git a/compiler/ngenutil.pas b/compiler/ngenutil.pas
index dfc3214..66e9aef 100644
--- a/compiler/ngenutil.pas
+++ b/compiler/ngenutil.pas
@@ -308,7 +308,18 @@ implementation
 
   class procedure tnodeutils.sym_maybe_initialize(p: TObject; arg: pointer);
     begin
-      if (tsym(p).typ = localvarsym) and
+      if ((tsym(p).typ = localvarsym) or
+          { check staticvarsym for record management opeators and for objects}
+          ((tsym(p).typ = staticvarsym) and
+           (
+            (tabstractvarsym(p).vardef is trecorddef) or
+            (
+             (tabstractvarsym(p).vardef is tobjectdef) and
+             (tobjectdef(tabstractvarsym(p).vardef).objecttype = odt_object)
+            )
+           )
+          )
+         ) and
          { local (procedure or unit) variables only need initialization if
            they are used }
          ((tabstractvarsym(p).refs>0) or
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index 837fb92..1ff290c 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -596,6 +596,8 @@ implementation
                     _EXPLICIT:optoken:=_OP_EXPLICIT;
                     _INC:optoken:=_OP_INC;
                     _DEC:optoken:=_OP_DEC;
+                    _INITIALIZE:optoken:=_OP_INITIALIZE;
+                    _FINALIZE:optoken:=_OP_FINALIZE;
                     else
                     if (m_delphi in current_settings.modeswitches) then
                       case lastidtoken of
@@ -1407,7 +1409,11 @@ implementation
               if pd.parast.symtablelevel>normal_function_level then
                 Message(parser_e_no_local_operator);
               if isclassmethod then
+              begin
                 include(pd.procoptions,po_classmethod);
+                { any class operator is also static }
+                include(pd.procoptions,po_staticmethod);
+              end;
               if token<>_ID then
                 begin
                    if not(m_result in current_settings.modeswitches) then
@@ -1418,40 +1424,54 @@ implementation
                   pd.resultname:=stringdup(orgpattern);
                   consume(_ID);
                 end;
-              if not try_to_consume(_COLON) then
+
+              { operators without result }
+              if optoken in [_OP_INITIALIZE, _OP_FINALIZE] then
                 begin
-                  consume(_COLON);
-                  pd.returndef:=generrordef;
-                  consume_all_until(_SEMICOLON);
+                  if (pd.parast.SymList.Count <> 1) or
+                     (tparavarsym(pd.parast.SymList[0]).vardef<>pd.struct) or
+                     (tparavarsym(pd.parast.SymList[0]).varspez<>vs_var) then
+                    Message(parser_e_overload_impossible);
+
+                  trecordsymtable(pd.procsym.Owner).includemanagementoperator(
+                    token2managementoperator(optoken));
+                  pd.returndef:=voidtype
                 end
               else
-               begin
-                 read_returndef(pd);
-                 { check that class operators have either return type of structure or }
-                 { at least one argument of that type                                 }
-                 if (po_classmethod in pd.procoptions) and
-                    (pd.returndef <> pd.struct) then
-                   begin
-                     found:=false;
-                     for i := 0 to pd.parast.SymList.Count - 1 do
-                       if tparavarsym(pd.parast.SymList[i]).vardef=pd.struct then
-                         begin
-                           found:=true;
-                           break;
-                         end;
-                     if not found then
-                       if assigned(pd.struct) then
-                         Message1(parser_e_at_least_one_argument_must_be_of_type,pd.struct.RttiName)
-                       else
-                         MessagePos(pd.fileinfo,type_e_type_id_expected);
-                   end;
-                 if (optoken in [_ASSIGNMENT,_OP_EXPLICIT]) and
-                    equal_defs(pd.returndef,tparavarsym(pd.parast.SymList[0]).vardef) and
-                    (pd.returndef.typ<>undefineddef) and (tparavarsym(pd.parast.SymList[0]).vardef.typ<>undefineddef) then
-                   message(parser_e_no_such_assignment)
-                 else if not isoperatoracceptable(pd,optoken) then
-                   Message(parser_e_overload_impossible);
-               end;
+                if not try_to_consume(_COLON) then
+                  begin
+                    consume(_COLON);
+                    pd.returndef:=generrordef;
+                    consume_all_until(_SEMICOLON);
+                  end
+                else
+                 begin
+                   read_returndef(pd);
+                   { check that class operators have either return type of structure or }
+                   { at least one argument of that type                                 }
+                   if (po_classmethod in pd.procoptions) and
+                      (pd.returndef <> pd.struct) then
+                     begin
+                       found:=false;
+                       for i := 0 to pd.parast.SymList.Count - 1 do
+                         if tparavarsym(pd.parast.SymList[i]).vardef=pd.struct then
+                           begin
+                             found:=true;
+                             break;
+                           end;
+                       if not found then
+                         if assigned(pd.struct) then
+                           Message1(parser_e_at_least_one_argument_must_be_of_type,pd.struct.RttiName)
+                         else
+                           MessagePos(pd.fileinfo,type_e_type_id_expected);
+                     end;
+                   if (optoken in [_ASSIGNMENT,_OP_EXPLICIT]) and
+                      equal_defs(pd.returndef,tparavarsym(pd.parast.SymList[0]).vardef) and
+                      (pd.returndef.typ<>undefineddef) and (tparavarsym(pd.parast.SymList[0]).vardef.typ<>undefineddef) then
+                     message(parser_e_no_such_assignment)
+                   else if not isoperatoracceptable(pd,optoken) then
+                     Message(parser_e_overload_impossible);
+                 end;
             end;
           else
             internalerror(2015052202);
diff --git a/compiler/symconst.pas b/compiler/symconst.pas
index e043ac7..d7a1899 100644
--- a/compiler/symconst.pas
+++ b/compiler/symconst.pas
@@ -582,6 +582,15 @@ type
   );
   tvaroptions=set of tvaroption;
 
+  tmanagementoperator=(mop_none,
+    mop_initialize,
+    mop_finalize,
+    { reserved for future usage }
+    mop_addref,
+    mop_copy
+  );
+  tmanagementoperators=set of tmanagementoperator;
+
   { register variable }
   tvarregable=(vr_none,
     vr_intreg,
@@ -701,6 +710,7 @@ type
     itp_rtti_normal_array,
     itp_rtti_dyn_array,
     itp_rtti_proc_param,
+    itp_init_record_operators,
     itp_rtti_enum_size_start_rec,
     itp_rtti_enum_min_max_rec,
     itp_rtti_enum_basetype_array_rec,
@@ -842,6 +852,7 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
        '$rtti_normal_array$',
        '$rtti_dyn_array$',
        '$rtti_proc_param$',
+       '$init_record_operators$',
        '$rtti_enum_size_start_rec$',
        '$rtti_enum_min_max_rec$',
        '$rtti_enum_basetype_array_rec$',
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index e264845..5a230b6 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -4436,6 +4436,7 @@ implementation
              trecordsymtable(symtable).recordalignmin:=shortint(ppufile.getbyte);
              trecordsymtable(symtable).datasize:=ppufile.getasizeint;
              trecordsymtable(symtable).paddingsize:=ppufile.getword;
+             ppufile.getsmallset(trecordsymtable(symtable).managementoperators);
              trecordsymtable(symtable).ppuload(ppufile);
              { the variantrecdesc is needed only for iso-like new statements new(prec,1,2,3 ...);
                but because iso mode supports no units, there is no need to store the variantrecdesc
@@ -4494,7 +4495,8 @@ implementation
 
     function trecorddef.needs_inittable : boolean;
       begin
-        needs_inittable:=trecordsymtable(symtable).needs_init_final
+        needs_inittable:=(trecordsymtable(symtable).managementoperators<>[]) or
+          trecordsymtable(symtable).needs_init_final
       end;
 
     function trecorddef.needs_separate_initrtti : boolean;
@@ -4581,6 +4583,7 @@ implementation
              ppufile.putbyte(byte(trecordsymtable(symtable).recordalignmin));
              ppufile.putasizeint(trecordsymtable(symtable).datasize);
              ppufile.putword(trecordsymtable(symtable).paddingsize);
+             ppufile.putsmallset(trecordsymtable(symtable).managementoperators);
              { the variantrecdesc is needed only for iso-like new statements new(prec,1,2,3 ...);
                but because iso mode supports no units, there is no need to store the variantrecdesc
                in the ppu
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 3672b4d..1f07544 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -135,8 +135,15 @@ interface
 
        trecordsymtable = class(tabstractrecordsymtable)
        public
+          { maybe someday is worth to move managementoperators to              }
+          { tabstractrecordsymtable to perform management class operators for  }
+          { object/classes. In XE5 and newer is possible to use class operator }
+          { for classes (like for Delphi .NET before) only for Delphi NEXTGEN  }
+          managementoperators : tmanagementoperators;
+
           constructor create(const n:string;usealign,recordminalign,recordmaxCalign:shortint);
           procedure insertunionst(unionst : trecordsymtable;offset : longint);
+          procedure includemanagementoperator(mop:tmanagementoperator);
        end;
 
        tObjectSymtable = class(tabstractrecordsymtable)
@@ -339,6 +346,7 @@ interface
     function  search_struct_member_no_helper(pd : tabstractrecorddef;const s : string):tsym;
     function  search_assignment_operator(from_def,to_def:Tdef;explicit:boolean):Tprocdef;
     function  search_enumerator_operator(from_def,to_def:Tdef):Tprocdef;
+    function  search_management_operator(mop:tmanagementoperator;pd:Tdef):Tprocdef;
     { searches for the helper definition that's currently active for pd }
     function  search_last_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean;
     { searches whether the symbol s is available in the currently active }
@@ -423,11 +431,18 @@ interface
     { _OP_EXPLICIT   }  'explicit',
     { _OP_ENUMERATOR }  'enumerator',
     { _OP_INITIALIZE }  'initialize',
-    { _OP_COPY       }  'copy',
     { _OP_FINALIZE   }  'finalize',    
     { _OP_INC        }  'inc',
     { _OP_DEC        }  'dec');
 
+      managementoperator2tok:array[tmanagementoperator] of ttoken = (
+    { mop_none       }  NOTOKEN,
+    { mop_initialize }  _OP_INITIALIZE,
+    { mop_finalize   }  _OP_FINALIZE,
+
+    { reserved for future usage }
+    { mop_addref     }  NOTOKEN,
+    { mop_copy       }  NOTOKEN);
 
 
 implementation
@@ -1728,6 +1743,14 @@ implementation
       end;
 
 
+    procedure trecordsymtable.includemanagementoperator(mop: tmanagementoperator);
+      begin
+        if mop in managementoperators then
+          exit;
+        include(managementoperators,mop);
+      end;
+
+
 {****************************************************************************
                               TObjectSymtable
 ****************************************************************************}
@@ -3750,6 +3773,31 @@ implementation
     end;
 
 
+    function search_management_operator(mop: tmanagementoperator; pd: Tdef): Tprocdef;
+      var
+        sym : Tprocsym;
+        hashedid : THashedIDString;
+        optoken: ttoken;
+      begin
+        optoken := managementoperator2tok[mop];
+        if (optoken<first_managment_operator) or
+           (optoken>last_managment_operator) then
+          internalerror(201602280);
+        hashedid.id:=overloaded_names[optoken];
+        if not (pd.typ in [recorddef]) then
+          internalerror(201602281);
+        sym:=Tprocsym(tabstractrecorddef(pd).symtable.FindWithHash(hashedid));
+        if sym<>nil then
+          begin
+            if sym.typ<>procsym then
+              internalerror(201602282);
+            result:=sym.find_procdef_bytype(potype_operator);
+          end
+        else
+          result:=nil;
+      end;
+
+
     function search_system_type(const s: TIDString): ttypesym;
       var
         sym : tsym;
diff --git a/compiler/tokens.pas b/compiler/tokens.pas
index 3283b5f..d98a626 100644
--- a/compiler/tokens.pas
+++ b/compiler/tokens.pas
@@ -57,7 +57,6 @@ type
     _OP_EXPLICIT,
     _OP_ENUMERATOR,
     _OP_INITIALIZE,
-    _OP_COPY,
     _OP_FINALIZE,    
     _OP_INC,
     _OP_DEC,
@@ -132,7 +131,6 @@ type
     _VAR,
     _XOR,
     _CASE,
-    _COPY,
     _CVAR,
     _ELSE,
     _EXIT,
@@ -388,7 +386,6 @@ const
       (str:'explicit'      ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'enumerator'    ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'initialize'    ;special:true ;keyword:[m_none];op:NOTOKEN),
-      (str:'copy'          ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'finalize'      ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'inc'           ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'dec'           ;special:true ;keyword:[m_none];op:NOTOKEN),
@@ -463,7 +460,6 @@ const
       (str:'VAR'           ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'XOR'           ;special:false;keyword:alllanguagemodes;op:_OP_XOR),
       (str:'CASE'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
-      (str:'COPY'          ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'CVAR'          ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'ELSE'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'EXIT'          ;special:false;keyword:[m_none];op:NOTOKEN),
diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc
index f8157a8..0e3caf4 100644
--- a/rtl/inc/objpas.inc
+++ b/rtl/inc/objpas.inc
@@ -379,6 +379,9 @@
 
       class function TObject.InitInstance(instance : pointer) : tobject; {$ifdef SYSTEMINLINE} inline; {$ENDIF}
 
+        var
+           vmt  : PVmt;
+           temp : pointer;
         begin
            { the size is saved at offset 0 }
            fillchar(instance^, InstanceSize, 0);
@@ -387,6 +390,19 @@
            ppointer(instance)^:=pointer(self);
            if {$ifdef VER3_0}PVmt(self)^.vIntfTable <> @emptyintf{$else}assigned(PVmt(self)^.vIntfTable){$endif} then
              InitInterfacePointers(self,instance);
+
+           { for record operators like initialize/finalize call int_initialize }
+           vmt := PVmt(self);
+           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);
+               vmt:= vmt^.vParent;
+             end;
+
            InitInstance:=TObject(Instance);
         end;
 
diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
index 6587bad..7104618 100644
--- a/rtl/inc/rtti.inc
+++ b/rtl/inc/rtti.inc
@@ -42,13 +42,41 @@ type
     {$endif}
   end;
 
-  PRecordInfo=^TRecordInfo;
-  TRecordInfo=
+  PRecordInfoFull=^TRecordInfoFull;
+  TRecordInfoFull=
 {$ifdef USE_PACKED}
   packed
 {$endif USE_PACKED}
   record
     Size: Longint;
+    InitTable: Pointer;
+    Count: Longint;
+    { Elements: array[count] of TRecordElement }
+  end;
+
+  TRTTIRecInitFiniOp=procedure(ARec: Pointer);
+
+  PRTTIRecordOpVMT=^TRTTIRecordOpVMT;
+  TRTTIRecordOpVMT=
+{$ifdef USE_PACKED}
+  packed
+{$endif USE_PACKED}
+  record
+    Initialize: TRTTIRecInitFiniOp;
+    Finalize: TRTTIRecInitFiniOp;
+    Reserved1: CodePointer;
+    Reserved2: CodePointer;
+  end;
+
+  PRecordInfoInit=^TRecordInfoInit;
+  TRecordInfoInit=
+{$ifdef USE_PACKED}
+  packed
+{$endif USE_PACKED}
+  record
+    Size: Longint;
+    Terminator: Pointer;
+    RecordOp: PRTTIRecordOpVMT;
     Count: Longint;
     { Elements: array[count] of TRecordElement }
   end;
@@ -83,7 +111,23 @@ end;
 function RTTIRecordSize(typeInfo: Pointer): SizeInt;
 begin
   typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
-  result:=PRecordInfo(typeInfo)^.Size;
+  result:=PRecordInfoFull(typeInfo)^.Size;
+end;
+
+function RTTIRecordOp(typeInfo: Pointer; var initrtti: Pointer): PRecordInfoInit; inline;
+begin
+  { find init table and management operators }
+  typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+  result:=typeInfo;
+
+  { check terminator, maybe we are already in init table }
+  if Assigned(result^.Terminator) then
+  begin
+    { point to more optimal initrtti }
+    initrtti:=PRecordInfoFull(result)^.InitTable;
+    { and point to management operators in our init table }
+    result:=aligntoptr(initrtti+2+PByte(initrtti)[1]);
+  end
 end;
 
 function RTTISize(typeInfo: Pointer): SizeInt;
@@ -112,8 +156,8 @@ var
   i : longint;
 begin
   typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
-  Count:=PRecordInfo(typeInfo)^.Count;
-  Inc(PRecordInfo(typeInfo));
+  Count:=PRecordInfoInit(typeInfo)^.Count;
+  Inc(PRecordInfoInit(typeInfo));
   { Process elements }
   for i:=1 to count Do
     begin
@@ -173,7 +217,13 @@ begin
     tkObject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkRecord:
-      recordrtti(data,typeinfo,@int_initialize);
+      { if possible try to use more optimal initrtti }
+      with RTTIRecordOp(typeinfo, typeinfo)^ do
+      begin
+        recordrtti(data,typeinfo,@int_initialize);
+        if Assigned(recordop) and Assigned(recordop^.Initialize) then
+          recordop^.Initialize(data);
+      end;
 {$ifdef FPC_HAS_FEATURE_VARIANTS}
     tkVariant:
       variant_init(PVarData(Data)^);
@@ -203,7 +253,13 @@ begin
     tkObject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkRecord:
-      recordrtti(data,typeinfo,@int_finalize);
+      { if possible try to use more optimal initrtti }
+      with RTTIRecordOp(typeinfo, typeinfo)^ do
+      begin
+        if Assigned(recordop) and Assigned(recordop^.Finalize) then
+          recordop^.Finalize(data);
+        recordrtti(data,typeinfo,@int_finalize);
+      end;
     tkInterface:
       Intf_Decr_Ref(PPointer(Data)^);
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
@@ -239,7 +295,11 @@ begin
     tkobject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord :
-      recordrtti(data,typeinfo,@int_addref);
+      begin
+        { find init table }
+        RTTIRecordOp(typeinfo, typeinfo);
+        recordrtti(data,typeinfo,@int_addref);
+      end;
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray:
       fpc_dynarray_incr_ref(PPointer(Data)^);
@@ -311,11 +371,13 @@ begin
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord:
       begin
+        { find init table }
+        RTTIRecordOp(typeinfo, typeinfo);
         Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
 
-        Result:=PRecordInfo(Temp)^.Size;
-        Count:=PRecordInfo(Temp)^.Count;
-        Inc(PRecordInfo(Temp));
+        Result:=PRecordInfoInit(Temp)^.Size;
+        Count:=PRecordInfoInit(Temp)^.Count;
+        Inc(PRecordInfoInit(Temp));
         expectedoffset:=0;
         { Process elements with rtti }
         for i:=1 to count Do
diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp
index 6517913..2b66803 100644
--- a/rtl/objpas/typinfo.pp
+++ b/rtl/objpas/typinfo.pp
@@ -312,6 +312,7 @@ unit typinfo;
             tkRecord:
               (
                 RecSize: Integer;
+                RecInitTable: Pointer;
                 ManagedFldCount: Integer;
                 {ManagedFields: array[1..ManagedFldCount] of TManagedField}
               );
diff --git a/tests/test/tmoperator1.pp b/tests/test/tmoperator1.pp
new file mode 100644
index 0000000..2fb3ac3
--- /dev/null
+++ b/tests/test/tmoperator1.pp
@@ -0,0 +1,29 @@
+{ %NORUN }
+
+program tmoperator1;
+
+{$MODE OBJFPC}
+{$modeswitch advancedrecords}
+
+type
+
+  { TFoo }
+
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+    class operator Finalize(var aFoo: TFoo);
+  end;
+
+{ TFoo }
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+end;
+
+class operator TFoo.Finalize(var aFoo: TFoo);
+begin
+end;
+
+begin
+end. 
\ No newline at end of file
diff --git a/tests/test/tmoperator2.pp b/tests/test/tmoperator2.pp
new file mode 100644
index 0000000..4721430
--- /dev/null
+++ b/tests/test/tmoperator2.pp
@@ -0,0 +1,129 @@
+program tmoperator2;
+
+{$MODE DELPHI}
+
+type
+
+  { TFoo }
+
+  PFoo = ^TFoo;
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+    class operator Finalize(var aFoo: TFoo);
+  public
+    F: Integer;
+    S: string;
+  end;
+
+{ TFoo }
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+  WriteLn;
+  WriteLn('TFoo.Initialize');
+  if aFoo.S <> '' then
+    Halt(1);
+  aFoo.F := 1;
+  aFoo.S := 'A';
+end;
+
+class operator TFoo.Finalize(var aFoo: TFoo);
+begin
+  if aFoo.F <> 2 then
+    Halt(2);
+  if aFoo.S <> 'B' then
+    Halt(3);
+  aFoo.F := 3;
+  WriteLn('TFoo.Finalize');
+  WriteLn;
+end;
+
+{ TBar }
+type 
+  TBar = class
+  private 
+    F: TFoo;
+  end;
+
+procedure Foo();
+var
+  F: TFoo;
+begin
+  if F.F <> 1 then
+    Halt(4);
+  if F.S <> 'A' then
+    Halt(5);
+  F.F := 2;
+  F.S := 'B';
+end;
+
+var
+  F: TFoo;
+  B: TBar;
+  PF: PFoo;
+begin
+  WriteLn('=== Global variable [begin] ===');
+  WriteLn;
+  
+  if F.F <> 1 then
+    Halt(6);
+
+  if F.S <> 'A' then
+    Halt(7);
+    
+  WriteLn('=== Local variable ===');
+  Foo();  
+    
+  WriteLn('=== Field in class ===');
+  B := TBar.Create();
+  if B.F.F <> 1 then
+    Halt(8);
+  if B.F.S <> 'A' then
+    Halt(9);
+  B.F.F := 2;
+  B.F.S := 'B';
+  B.Free; 
+    
+  WriteLn('=== New and Dispose ===');
+  New(PF);
+  if PF^.F <> 1 then
+    Halt(10);
+  if PF^.S <> 'A' then
+    Halt(11);
+  PF^.F := 2;
+  PF^.S := 'B';
+  Dispose(PF); 
+  
+  WriteLn('=== InitializeArray and FinalizeArray ===');
+  GetMem(PF, SizeOf(TFoo));
+  InitializeArray(PF, TypeInfo(TFoo), 1);
+  if PF^.F <> 1 then
+    Halt(12);
+  if PF^.S <> 'A' then
+    Halt(13);
+  PF^.F := 2;  
+  PF^.S := 'B';  
+  FinalizeArray(PF, TypeInfo(TFoo), 1);
+  if PF^.F <> 3 then
+    Halt(14);
+  FreeMem(PF);
+
+  WriteLn('=== Initialize and Finalize ===');
+  GetMem(PF, SizeOf(TFoo));
+  Initialize(PF^);
+  if PF^.F <> 1 then
+    Halt(15);
+  if PF^.S <> 'A' then
+    Halt(16);
+  PF^.F := 2;  
+  PF^.S := 'B';  
+  Finalize(PF^);
+  if PF^.F <> 3 then
+    Halt(17);
+  FreeMem(PF);
+    
+  WriteLn('=== Global variable [end] ===');
+  F.F := 2;
+  F.S := 'B';
+end. 
\ No newline at end of file
diff --git a/tests/test/tmoperator3.pp b/tests/test/tmoperator3.pp
new file mode 100644
index 0000000..ae28d02
--- /dev/null
+++ b/tests/test/tmoperator3.pp
@@ -0,0 +1,104 @@
+program tmoperator3;
+
+{$MODE DELPHI}
+
+type
+
+  { TFoo }
+
+  PFoo = ^TFoo;
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+    class operator Finalize(var aFoo: TFoo);
+  public
+    F: Integer;
+  end;
+
+{ TFoo }
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+  WriteLn;
+  WriteLn('TFoo.Initialize');
+  aFoo.F := 1;
+end;
+
+class operator TFoo.Finalize(var aFoo: TFoo);
+begin
+  if aFoo.F <> 2 then
+    Halt(2);
+  aFoo.F := 3;
+  WriteLn('TFoo.Finalize');
+  WriteLn;
+end;
+
+{ TBar }
+type 
+  TBar = class
+  private 
+    F: TFoo;
+  end;
+
+procedure Foo();
+var
+  F: TFoo;
+begin
+  if F.F <> 1 then
+    Halt(3);
+  F.F := 2;
+end;
+
+var
+  F: TFoo;
+  B: TBar;
+  PF: PFoo;
+begin
+  WriteLn('=== Global variable [begin] ===');
+  WriteLn;
+  
+  if F.F <> 1 then
+    Halt(4);
+    
+  WriteLn('=== Local variable ===');
+  Foo();  
+    
+  WriteLn('=== Field in class ===');
+  B := TBar.Create();
+  if B.F.F <> 1 then
+    Halt(5);
+  B.F.F := 2;
+  B.Free; 
+    
+  WriteLn('=== New and Dispose ===');
+  New(PF);
+  if PF.F <> 1 then
+    Halt(6);
+  PF^.F := 2;
+  Dispose(PF); 
+  
+  WriteLn('=== InitializeArray and FinalizeArray ===');
+  GetMem(PF, SizeOf(TFoo));
+  InitializeArray(PF, TypeInfo(TFoo), 1);
+  if PF.F <> 1 then
+    Halt(7);
+  PF^.F := 2;  
+  FinalizeArray(PF, TypeInfo(TFoo), 1);
+  if PF^.F <> 3 then
+    Halt(8);
+  FreeMem(PF);
+
+  WriteLn('=== Initialize and Finalize ===');
+  GetMem(PF, SizeOf(TFoo));
+  Initialize(PF^);
+  if PF.F <> 1 then
+    Halt(9);
+  PF^.F := 2;  
+  Finalize(PF^);
+  if PF^.F <> 3 then
+    Halt(10);
+  FreeMem(PF);
+    
+  F.F := 2;
+  WriteLn('=== Global variable [end] ===');
+end. 
\ No newline at end of file
diff --git a/tests/test/tmoperator4.pp b/tests/test/tmoperator4.pp
new file mode 100644
index 0000000..e624003
--- /dev/null
+++ b/tests/test/tmoperator4.pp
@@ -0,0 +1,81 @@
+program tmoperator4;
+
+{$MODE DELPHI}
+
+type
+  TR1 = record
+  private
+    class operator Initialize(var aR1: TR1);
+    class operator Finalize(var aR1: TR1);
+  public
+    I: Integer;
+  end;
+
+  TR2 = record
+  private
+    class operator Initialize(var aR2: TR2);
+    class operator Finalize(var aR2: TR2);
+  public
+    S: string;
+  end;
+
+{ TR1 }
+
+class operator TR1.Initialize(var aR1: TR1);
+begin
+  WriteLn('TR1.Initialize');
+  aR1.I := 1;
+end;
+
+class operator TR1.Finalize(var aR1: TR1);
+begin
+  if aR1.I <> 2 then
+    Halt(1);
+  WriteLn('TR1.Finalize');
+end;
+
+{ TR2 }
+
+class operator TR2.Initialize(var aR2: TR2);
+begin
+  WriteLn('TR2.Initialize');
+  aR2.S := 'A';
+end;
+
+class operator TR2.Finalize(var aR2: TR2);
+begin
+  if aR2.S <> 'B' then
+    Halt(2);
+  WriteLn('TR2.Finalize');
+end;
+
+{ TA }
+
+type 
+  TA = class
+  public 
+    F1: TR1;
+  end;
+
+  TB = class(TA)
+  public
+    F2: TR2;
+  end;
+
+var
+  O: TB;
+begin
+  O := TB.Create;
+  
+  if O.F1.I <> 1 then
+    Halt(3);
+  if O.F2.S <> 'A' then
+    Halt(4);
+    
+  O.F1.I := 2;
+  O.F2.S := 'B'; 
+  
+  O.Free;
+  
+  WriteLn('end');
+end. 
\ No newline at end of file
diff --git a/tests/test/tmoperator5.pp b/tests/test/tmoperator5.pp
new file mode 100644
index 0000000..bc7d386
--- /dev/null
+++ b/tests/test/tmoperator5.pp
@@ -0,0 +1,138 @@
+program tmoperator5;
+
+{$MODE DELPHI}
+
+type
+  TR1 = record
+  private
+    class operator Initialize(var aR1: TR1);
+    class operator Finalize(var aR1: TR1);
+  public
+    I: Integer;
+  end;
+
+  TR2 = record
+  private
+    class operator Initialize(var aR2: TR2);
+    class operator Finalize(var aR2: TR2);
+  public
+    S: string;
+  end;
+
+{ TR1 }
+
+class operator TR1.Initialize(var aR1: TR1);
+begin
+  WriteLn('TR1.Initialize');
+  aR1.I := 1;
+end;
+
+class operator TR1.Finalize(var aR1: TR1);
+begin
+  if aR1.I <> 2 then
+    Halt(1);
+  aR1.I := 3;
+  WriteLn('TR1.Finalize');
+end;
+
+{ TR2 }
+
+class operator TR2.Initialize(var aR2: TR2);
+begin
+  WriteLn('TR2.Initialize');
+  aR2.S := 'A';
+end;
+
+class operator TR2.Finalize(var aR2: TR2);
+begin
+  if aR2.S <> 'B' then
+    Halt(2);
+  WriteLn('TR2.Finalize');
+end;
+
+{ TA }
+
+type 
+  TA = object
+  public 
+    F1: TR1;
+  end;
+
+  TB = object(TA)
+  public
+    F2: TR2;
+  end;
+  
+procedure Foo();
+var
+  LO: TB;
+begin
+  if LO.F1.I <> 1 then
+    Halt(4);
+  if LO.F2.S <> 'A' then
+    Halt(5);
+  LO.F1.I := 2;
+  LO.F2.S := 'B';
+end;
+
+var
+  O: TB;
+  P: ^TB;
+begin
+  WriteLn('=== Global object variable [begin] ===');
+  
+  if O.F1.I <> 1 then
+    Halt(3);
+  if O.F2.S <> 'A' then
+    Halt(4);
+    
+  WriteLn;
+  WriteLn('=== Local variable ===');
+  Foo();      
+    
+  WriteLn;
+  WriteLn('=== New and Dispose ===');
+  New(P);
+  if P^.F1.I <> 1 then
+    Halt(10);
+  if P^.F2.S <> 'A' then
+    Halt(11);
+  P^.F1.I := 2;
+  P^.F2.S := 'B';
+  Dispose(P); 
+  
+  WriteLn;
+  WriteLn('=== InitializeArray and FinalizeArray ===');
+  GetMem(P, SizeOf(TB));
+  InitializeArray(P, TypeInfo(TB), 1);
+  if P^.F1.I <> 1 then
+    Halt(12);
+  if P^.F2.S <> 'A' then
+    Halt(13);
+  P^.F1.I := 2;  
+  P^.F2.S := 'B';  
+  FinalizeArray(P, TypeInfo(TB), 1);
+  if P^.F1.I <> 3 then
+    Halt(14);
+  FreeMem(P);
+
+  WriteLn;
+  WriteLn('=== Initialize and Finalize ===');
+  GetMem(P, SizeOf(TB));
+  Initialize(P^);
+  if P^.F1.I <> 1 then
+    Halt(15);
+  if P^.F2.S <> 'A' then
+    Halt(16);
+  P^.F1.I := 2;  
+  P^.F2.S := 'B';  
+  Finalize(P^);
+  if P^.F1.I <> 3 then
+    Halt(17);
+  FreeMem(P);
+
+  WriteLn;
+  WriteLn('=== Global variable [end] ===');
+  O.F1.I := 2;
+  O.F2.S := 'B'; 
+end. 
\ No newline at end of file
diff --git a/tests/test/tmoperator6.pp b/tests/test/tmoperator6.pp
new file mode 100644
index 0000000..febef0b
--- /dev/null
+++ b/tests/test/tmoperator6.pp
@@ -0,0 +1,28 @@
+{ %FAIL }
+
+program tmoperator6;
+
+{$MODE DELPHI}
+
+type
+
+  { TFoo }
+
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo): Boolean;
+    class operator Finalize(var aFoo: Pointer);
+  end;
+
+{ TFoo }
+
+class operator TFoo.Initialize(var aFoo: TFoo): Boolean;
+begin
+end;
+
+class operator TFoo.Finalize(var aFoo: Pointer);
+begin
+end;
+
+begin
+end. 
\ No newline at end of file
diff --git a/tests/test/tmoperator7.pp b/tests/test/tmoperator7.pp
new file mode 100644
index 0000000..2f26358
--- /dev/null
+++ b/tests/test/tmoperator7.pp
@@ -0,0 +1,15 @@
+program tmoperator7;
+
+{$MODE DELPHI}
+
+uses
+  TypInfo;
+
+type
+  TFoo = record
+  end;
+
+begin
+  if GetTypeData(TypeInfo(TFoo)).RecInitTable = nil then
+    Halt(1);
+end.
-- 
2.9.3.windows.2

Maciej Izak

2016-10-03 21:52

reporter  

0003-rtti.inc.patch (2,705 bytes)
From 72f33b5bd604cdad66e3b3cf326989ce8080e880 Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Fri, 30 Sep 2016 00:28:00 +0200
Subject: [PATCH 03/15] rtti.inc:   - remove empty VMT slots for record
 management operators (for AddRef and Copy), related to r33229

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33253

ncgrtti.pas, symconst.pas, symtable.pas:
  - remove placeholders for "addref" and "copy" management operators.

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33229
---
 compiler/ncgrtti.pas  | 2 +-
 compiler/symconst.pas | 5 +----
 compiler/symtable.pas | 6 +-----
 rtl/inc/rtti.inc      | 2 --
 4 files changed, 3 insertions(+), 12 deletions(-)

diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas
index 6752527..796bcf7 100644
--- a/compiler/ncgrtti.pas
+++ b/compiler/ncgrtti.pas
@@ -1049,7 +1049,7 @@ implementation
            if (rt=initrtti) and (trecordsymtable(def.symtable).managementoperators<>[]) then
              write_record_operators;
 
-           { guarantee initrtti for any record for fpc_initialize, fpc_finalize, fpc_copy and fpc_addref }
+           { guarantee initrtti for any record for fpc_initialize, fpc_finalize }
            if (rt = fullrtti) and (ds_init_table_used in def.defstates) and
               not (ds_init_table_written in def.defstates) then
              write_rtti(def, initrtti);
diff --git a/compiler/symconst.pas b/compiler/symconst.pas
index d7a1899..b926bc0 100644
--- a/compiler/symconst.pas
+++ b/compiler/symconst.pas
@@ -584,10 +584,7 @@ type
 
   tmanagementoperator=(mop_none,
     mop_initialize,
-    mop_finalize,
-    { reserved for future usage }
-    mop_addref,
-    mop_copy
+    mop_finalize
   );
   tmanagementoperators=set of tmanagementoperator;
 
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 1f07544..ca875da 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -438,11 +438,7 @@ interface
       managementoperator2tok:array[tmanagementoperator] of ttoken = (
     { mop_none       }  NOTOKEN,
     { mop_initialize }  _OP_INITIALIZE,
-    { mop_finalize   }  _OP_FINALIZE,
-
-    { reserved for future usage }
-    { mop_addref     }  NOTOKEN,
-    { mop_copy       }  NOTOKEN);
+    { mop_finalize   }  _OP_FINALIZE);
 
 
 implementation
diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
index 7104618..ac3db59 100644
--- a/rtl/inc/rtti.inc
+++ b/rtl/inc/rtti.inc
@@ -64,8 +64,6 @@ type
   record
     Initialize: TRTTIRecInitFiniOp;
     Finalize: TRTTIRecInitFiniOp;
-    Reserved1: CodePointer;
-    Reserved2: CodePointer;
   end;
 
   PRecordInfoInit=^TRecordInfoInit;
-- 
2.9.3.windows.2

0003-rtti.inc.patch (2,705 bytes)

Maciej Izak

2016-10-03 21:52

reporter  

0004-RTL-compileable-with-the-FPC-3.0.patch (5,784 bytes)
From 872450def321b050d2a11f5294a8f6ebf3c7364c Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Fri, 30 Sep 2016 00:36:49 +0200
Subject: [PATCH 04/15] RTL compileable with the FPC 3.0

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33381
---
 rtl/inc/objpas.inc    |  4 ++++
 rtl/inc/rtti.inc      | 29 +++++++++++++++++++++++++++++
 rtl/objpas/typinfo.pp |  2 ++
 3 files changed, 35 insertions(+)

diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc
index 0e3caf4..94c8685 100644
--- a/rtl/inc/objpas.inc
+++ b/rtl/inc/objpas.inc
@@ -379,9 +379,11 @@
 
       class function TObject.InitInstance(instance : pointer) : tobject; {$ifdef SYSTEMINLINE} inline; {$ENDIF}
 
+{$if FPC_FULLVERSION>30100}
         var
            vmt  : PVmt;
            temp : pointer;
+{$endif FPC_FULLVERSION>30100}
         begin
            { the size is saved at offset 0 }
            fillchar(instance^, InstanceSize, 0);
@@ -391,6 +393,7 @@
            if {$ifdef VER3_0}PVmt(self)^.vIntfTable <> @emptyintf{$else}assigned(PVmt(self)^.vIntfTable){$endif} then
              InitInterfacePointers(self,instance);
 
+{$if FPC_FULLVERSION>30100}
            { for record operators like initialize/finalize call int_initialize }
            vmt := PVmt(self);
            while vmt<>nil do
@@ -402,6 +405,7 @@
                  RecordRTTI(Instance,Temp,@int_initialize);
                vmt:= vmt^.vParent;
              end;
+{$endif FPC_FULLVERSION>30100}
 
            InitInstance:=TObject(Instance);
         end;
diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
index ac3db59..23d9b67 100644
--- a/rtl/inc/rtti.inc
+++ b/rtl/inc/rtti.inc
@@ -49,11 +49,14 @@ type
 {$endif USE_PACKED}
   record
     Size: Longint;
+{$if FPC_FULLVERSION>30100}
     InitTable: Pointer;
+{$endif FPC_FULLVERSION>30100}
     Count: Longint;
     { Elements: array[count] of TRecordElement }
   end;
 
+{$if FPC_FULLVERSION>30100}
   TRTTIRecInitFiniOp=procedure(ARec: Pointer);
 
   PRTTIRecordOpVMT=^TRTTIRecordOpVMT;
@@ -78,6 +81,7 @@ type
     Count: Longint;
     { Elements: array[count] of TRecordElement }
   end;
+{$endif FPC_FULLVERSION>30100}
 
   PArrayInfo=^TArrayInfo;
   TArrayInfo=
@@ -112,6 +116,7 @@ begin
   result:=PRecordInfoFull(typeInfo)^.Size;
 end;
 
+{$if FPC_FULLVERSION>30100}
 function RTTIRecordOp(typeInfo: Pointer; var initrtti: Pointer): PRecordInfoInit; inline;
 begin
   { find init table and management operators }
@@ -127,6 +132,7 @@ begin
     result:=aligntoptr(initrtti+2+PByte(initrtti)[1]);
   end
 end;
+{$endif FPC_FULLVERSION>30100}
 
 function RTTISize(typeInfo: Pointer): SizeInt;
 begin
@@ -154,8 +160,13 @@ var
   i : longint;
 begin
   typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+{$if FPC_FULLVERSION>30100}
   Count:=PRecordInfoInit(typeInfo)^.Count;
   Inc(PRecordInfoInit(typeInfo));
+{$else FPC_FULLVERSION>30100}
+  Count:=PRecordInfoFull(typeInfo)^.Count;
+  Inc(PRecordInfoFull(typeInfo));
+{$endif FPC_FULLVERSION>30100}
   { Process elements }
   for i:=1 to count Do
     begin
@@ -215,6 +226,7 @@ begin
     tkObject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkRecord:
+{$if FPC_FULLVERSION>30100}
       { if possible try to use more optimal initrtti }
       with RTTIRecordOp(typeinfo, typeinfo)^ do
       begin
@@ -222,6 +234,9 @@ begin
         if Assigned(recordop) and Assigned(recordop^.Initialize) then
           recordop^.Initialize(data);
       end;
+{$else FPC_FULLVERSION>30100}
+      recordrtti(data,typeinfo,@int_initialize);
+{$endif FPC_FULLVERSION>30100}
 {$ifdef FPC_HAS_FEATURE_VARIANTS}
     tkVariant:
       variant_init(PVarData(Data)^);
@@ -251,6 +266,7 @@ begin
     tkObject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkRecord:
+{$if FPC_FULLVERSION>30100}
       { if possible try to use more optimal initrtti }
       with RTTIRecordOp(typeinfo, typeinfo)^ do
       begin
@@ -258,6 +274,9 @@ begin
           recordop^.Finalize(data);
         recordrtti(data,typeinfo,@int_finalize);
       end;
+{$else FPC_FULLVERSION>30100}
+      recordrtti(data,typeinfo,@int_finalize);
+{$endif FPC_FULLVERSION>30100}
     tkInterface:
       Intf_Decr_Ref(PPointer(Data)^);
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
@@ -294,8 +313,10 @@ begin
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord :
       begin
+{$if FPC_FULLVERSION>30100}
         { find init table }
         RTTIRecordOp(typeinfo, typeinfo);
+{$endif FPC_FULLVERSION>30100}
         recordrtti(data,typeinfo,@int_addref);
       end;
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
@@ -369,13 +390,21 @@ begin
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord:
       begin
+{$if FPC_FULLVERSION>30100}
         { find init table }
         RTTIRecordOp(typeinfo, typeinfo);
+{$endif FPC_FULLVERSION>30100}
         Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
 
+{$if FPC_FULLVERSION>30100}
         Result:=PRecordInfoInit(Temp)^.Size;
         Count:=PRecordInfoInit(Temp)^.Count;
         Inc(PRecordInfoInit(Temp));
+{$else FPC_FULLVERSION>30100}
+        Result:=PRecordInfoFull(Temp)^.Size;
+        Count:=PRecordInfoFull(Temp)^.Count;
+        Inc(PRecordInfoFull(Temp));
+{$endif FPC_FULLVERSION>30100}
         expectedoffset:=0;
         { Process elements with rtti }
         for i:=1 to count Do
diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp
index 2b66803..5652900 100644
--- a/rtl/objpas/typinfo.pp
+++ b/rtl/objpas/typinfo.pp
@@ -312,7 +312,9 @@ unit typinfo;
             tkRecord:
               (
                 RecSize: Integer;
+{$if FPC_FULLVERSION>30100}
                 RecInitTable: Pointer;
+{$endif FPC_FULLVERSION>30100}
                 ManagedFldCount: Integer;
                 {ManagedFields: array[1..ManagedFldCount] of TManagedField}
               );
-- 
2.9.3.windows.2

Maciej Izak

2016-10-03 21:52

reporter  

0005-Allow-Initialize-management-operator-for-SetLength-f.patch (5,778 bytes)
From 6765369b0b45bacee8a1e34c1c03fb436e2490bd Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Fri, 30 Sep 2016 00:46:26 +0200
Subject: [PATCH 05/15] Allow Initialize management operator for SetLength for
 dynamic arrays (fix for bug reported by Anthony Walter).

rtl/inc/aliases.inc:
  + new internal alias int_InitializeArray for FPC_INITIALIZE_ARRAY
rtl/inc/dynarr.inc:
  * use int_InitializeArray in fpc_dynarray_setlength for new elements for array of records and objects
rtl/inc/rtti.inc:
  * missing semicolon

+ added test

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33384
---
 rtl/inc/aliases.inc       |   1 +
 rtl/inc/dynarr.inc        |  11 +++++
 rtl/inc/rtti.inc          |   2 +-
 tests/test/tmoperator8.pp | 105 ++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 118 insertions(+), 1 deletion(-)
 create mode 100644 tests/test/tmoperator8.pp

diff --git a/rtl/inc/aliases.inc b/rtl/inc/aliases.inc
index 04ba0cd..12b0030 100644
--- a/rtl/inc/aliases.inc
+++ b/rtl/inc/aliases.inc
@@ -27,6 +27,7 @@
 Procedure int_Finalize (Data,TypeInfo: Pointer); [external name 'FPC_FINALIZE'];
 Procedure int_Addref (Data,TypeInfo : Pointer); [external name 'FPC_ADDREF'];
 Procedure int_Initialize (Data,TypeInfo: Pointer); [external name 'FPC_INITIALIZE'];
+procedure int_InitializeArray(data,typeinfo : pointer;count : SizeInt); [external name 'FPC_INITIALIZE_ARRAY'];
 procedure int_FinalizeArray(data,typeinfo : pointer;count : SizeInt); [external name 'FPC_FINALIZE_ARRAY'];
 
 {$if defined(FPC_HAS_FEATURE_RTTI) and not defined(cpujvm)}
diff --git a/rtl/inc/dynarr.inc b/rtl/inc/dynarr.inc
index 08d0903..6e43e17 100644
--- a/rtl/inc/dynarr.inc
+++ b/rtl/inc/dynarr.inc
@@ -185,6 +185,11 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
             exit;
           getmem(newp,size);
           fillchar(newp^,size,0);
+{$if FPC_FULLVERSION>30100}
+          { call int_InitializeArray for management operators }
+          if PByte(eletype)^ in [tkRecord, tkObject] then
+            int_InitializeArray(pointer(newp)+sizeof(tdynarray), eletype, dims[0]);
+{$endif FPC_FULLVERSION>30100}
           updatep := true;
        end
      else
@@ -257,6 +262,12 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
                          reallocmem(realp,size);
                          fillchar((pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1))^,
                            (dims[0]-realp^.high-1)*elesize,0);
+{$if FPC_FULLVERSION>30100}
+                         { call int_InitializeArray for management operators }
+                         if PByte(eletype)^ in [tkRecord, tkObject] then
+                           int_InitializeArray(pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1),
+                             eletype, dims[0]-realp^.high-1);
+{$endif FPC_FULLVERSION>30100}
                       end;
                     newp := realp;
                     updatep := true;
diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
index 23d9b67..d65691e 100644
--- a/rtl/inc/rtti.inc
+++ b/rtl/inc/rtti.inc
@@ -447,7 +447,7 @@ begin
 end;
 
 
-procedure fpc_initialize_array(data,typeinfo : pointer;count : SizeInt); [public,alias:'FPC_INITIALIZE_ARRAY'] compilerproc;
+procedure fpc_initialize_array(data,typeinfo : pointer;count : SizeInt); [public,alias:'FPC_INITIALIZE_ARRAY']; compilerproc;
   var
      i, size : SizeInt;
   begin
diff --git a/tests/test/tmoperator8.pp b/tests/test/tmoperator8.pp
new file mode 100644
index 0000000..8122274
--- /dev/null
+++ b/tests/test/tmoperator8.pp
@@ -0,0 +1,105 @@
+program tmoperator8;
+
+{$MODE DELPHI}
+
+type
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+    class operator Finalize(var aFoo: TFoo);
+  public
+    I: Integer;
+  public class var
+    InitializeCount: Integer;
+    FinalizeCount: Integer;
+  end;
+
+  TFooObj = object
+  public
+    F: TFoo;
+  end;  
+
+  TFooArray = array of TFoo; 
+  TFooObjArray = array of TFooObj; 
+
+{ TFoo }
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+  Inc(InitializeCount);
+  if aFoo.I <> 0 then // for dyn array and old obj
+    Halt(1);
+    
+  WriteLn('TFoo.Initialize');
+  aFoo.I := 1;
+end;
+
+class operator TFoo.Finalize(var aFoo: TFoo);
+begin
+  Inc(FinalizeCount);
+  if aFoo.I <> 2 then
+    Halt(2);
+  WriteLn('TFoo.Finalize');
+end;
+
+procedure CheckFooInit(var AValue: Integer; const AExpectedInitializeCount: Integer);
+begin
+  if AValue <> 1 then
+    Halt(3);
+  AValue := 2;
+  
+  if TFoo.InitializeCount <> AExpectedInitializeCount then
+    Halt(4); 
+end;
+
+procedure CheckFooFini(const AExpectedFinalizeCount: Integer);
+begin
+  if TFoo.FinalizeCount <> AExpectedFinalizeCount then
+    Halt(5);   
+end;
+
+procedure FooTest;
+var
+  Foos: TFooArray;
+  FoosObj: TFooObjArray;
+begin
+  WriteLn('=== DynArray of Records ===');
+  
+  SetLength(Foos, 1);
+  CheckFooInit(Foos[0].I, 1);
+
+  SetLength(Foos, 2);
+  CheckFooInit(Foos[1].I, 2);
+    
+  SetLength(Foos, 1);
+  CheckFooFini(1);
+
+  SetLength(Foos, 2);
+  CheckFooInit(Foos[1].I, 3);
+
+  Foos := nil;
+  CheckFooFini(3);
+    
+  WriteLn('=== DynArray of Objects ===');
+  TFoo.InitializeCount := 0;
+  TFoo.FinalizeCount := 0;
+  
+  SetLength(FoosObj, 1);
+  CheckFooInit(FoosObj[0].F.I, 1);
+
+  SetLength(FoosObj, 2);
+  CheckFooInit(FoosObj[1].F.I, 2);
+    
+  SetLength(FoosObj, 1);
+  CheckFooFini(1);
+
+  SetLength(FoosObj, 2);
+  CheckFooInit(FoosObj[1].F.I, 3);
+
+  FoosObj := nil;
+  CheckFooFini(3);
+end;
+
+begin
+  FooTest;
+end. 
\ No newline at end of file
-- 
2.9.3.windows.2

Maciej Izak

2016-10-03 21:52

reporter  

0006-New-tokens-proper-parsing-and-new-VMT-slots-for-new-.patch (6,906 bytes)
From 66a3e530825397ac738aac1a5519ea7115645ba2 Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Fri, 30 Sep 2016 00:54:43 +0200
Subject: [PATCH 06/15] New tokens, proper parsing and new VMT slots for new
 management operators: AddRef and Copy. New operators require changes to RTL
 (that will be committed next time).

pdecsub.pas:
  + parse new _ADDREF and _COPY tokens as _OP_ADDREF and _OP_COPY
  + proper handling for new operators

symconst.pas, tmanagementoperator:
  + new enum items: mop_addref and mop_copy

symtable.pas:
  * overloaded_names and managementoperator2tok adjusted to new operators

tokens.pas:
  + new tokens for management operators: _ADDREF, _COPY, _OP_ADDREF, _OP_COPY

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33469
---
 compiler/pdecsub.pas  | 24 ++++++++++++++++++++----
 compiler/symconst.pas |  4 +++-
 compiler/symtable.pas |  7 ++++++-
 compiler/tokens.pas   | 10 +++++++++-
 4 files changed, 38 insertions(+), 7 deletions(-)

diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index 1ff290c..cb745aa 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -598,6 +598,8 @@ implementation
                     _DEC:optoken:=_OP_DEC;
                     _INITIALIZE:optoken:=_OP_INITIALIZE;
                     _FINALIZE:optoken:=_OP_FINALIZE;
+                    _ADDREF:optoken:=_OP_ADDREF;
+                    _COPY:optoken:=_OP_COPY;
                     else
                     if (m_delphi in current_settings.modeswitches) then
                       case lastidtoken of
@@ -1426,11 +1428,25 @@ implementation
                 end;
 
               { operators without result }
-              if optoken in [_OP_INITIALIZE, _OP_FINALIZE] then
+              if optoken in [_OP_INITIALIZE, _OP_FINALIZE, _OP_ADDREF, _OP_COPY] then
                 begin
-                  if (pd.parast.SymList.Count <> 1) or
-                     (tparavarsym(pd.parast.SymList[0]).vardef<>pd.struct) or
-                     (tparavarsym(pd.parast.SymList[0]).varspez<>vs_var) then
+                  { single var parameter to point the record }
+                  if (optoken in [_OP_INITIALIZE, _OP_FINALIZE, _OP_ADDREF]) and
+                     (
+                      (pd.parast.SymList.Count <> 1) or
+                      (tparavarsym(pd.parast.SymList[0]).vardef<>pd.struct) or
+                      (tparavarsym(pd.parast.SymList[0]).varspez<>vs_var)
+                     ) then
+                    Message(parser_e_overload_impossible)
+                  { constref (source) and var (dest) parameter to point the records }
+                  else if (optoken = _OP_COPY) and
+                     (
+                      (pd.parast.SymList.Count <> 2) or
+                      (tparavarsym(pd.parast.SymList[0]).vardef<>pd.struct) or
+                      (tparavarsym(pd.parast.SymList[0]).varspez<>vs_constref) or
+                      (tparavarsym(pd.parast.SymList[1]).vardef<>pd.struct) or
+                      (tparavarsym(pd.parast.SymList[1]).varspez<>vs_var)
+                     ) then
                     Message(parser_e_overload_impossible);
 
                   trecordsymtable(pd.procsym.Owner).includemanagementoperator(
diff --git a/compiler/symconst.pas b/compiler/symconst.pas
index b926bc0..1f7313b 100644
--- a/compiler/symconst.pas
+++ b/compiler/symconst.pas
@@ -584,7 +584,9 @@ type
 
   tmanagementoperator=(mop_none,
     mop_initialize,
-    mop_finalize
+    mop_finalize,
+    mop_addref,
+    mop_copy
   );
   tmanagementoperators=set of tmanagementoperator;
 
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index ca875da..f981989 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -432,13 +432,18 @@ interface
     { _OP_ENUMERATOR }  'enumerator',
     { _OP_INITIALIZE }  'initialize',
     { _OP_FINALIZE   }  'finalize',    
+    { _OP_ADDREF     }  'addref',
+    { _OP_COPY       }  'copy',
     { _OP_INC        }  'inc',
     { _OP_DEC        }  'dec');
 
       managementoperator2tok:array[tmanagementoperator] of ttoken = (
     { mop_none       }  NOTOKEN,
     { mop_initialize }  _OP_INITIALIZE,
-    { mop_finalize   }  _OP_FINALIZE);
+    { mop_finalize   }  _OP_FINALIZE,
+    { mop_addref     }  _OP_ADDREF,
+    { mop_copy       }  _OP_COPY
+    );
 
 
 implementation
diff --git a/compiler/tokens.pas b/compiler/tokens.pas
index d98a626..1757764 100644
--- a/compiler/tokens.pas
+++ b/compiler/tokens.pas
@@ -58,6 +58,8 @@ type
     _OP_ENUMERATOR,
     _OP_INITIALIZE,
     _OP_FINALIZE,    
+    _OP_ADDREF,
+    _OP_COPY,
     _OP_INC,
     _OP_DEC,
     { special chars }
@@ -131,6 +133,7 @@ type
     _VAR,
     _XOR,
     _CASE,
+    _COPY,
     _CVAR,
     _ELSE,
     _EXIT,
@@ -166,6 +169,7 @@ type
     _UNTIL,
     _WHILE,
     _WRITE,
+    _ADDREF,
     _DISPID,
     _DIVIDE,
     _DOWNTO,
@@ -325,7 +329,7 @@ const
   last_overloaded  = _OP_DEC;
   last_operator = _GENERICSPECIALTOKEN;
   first_managment_operator = _OP_INITIALIZE;
-  last_managment_operator = _OP_FINALIZE;
+  last_managment_operator = _OP_COPY;
 
   highest_precedence = oppower;
 
@@ -387,6 +391,8 @@ const
       (str:'enumerator'    ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'initialize'    ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'finalize'      ;special:true ;keyword:[m_none];op:NOTOKEN),
+      (str:'addref'        ;special:true ;keyword:[m_none];op:NOTOKEN),
+      (str:'copy'          ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'inc'           ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'dec'           ;special:true ;keyword:[m_none];op:NOTOKEN),
     { Special chars }
@@ -460,6 +466,7 @@ const
       (str:'VAR'           ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'XOR'           ;special:false;keyword:alllanguagemodes;op:_OP_XOR),
       (str:'CASE'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
+      (str:'COPY'          ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'CVAR'          ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'ELSE'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'EXIT'          ;special:false;keyword:[m_none];op:NOTOKEN),
@@ -495,6 +502,7 @@ const
       (str:'UNTIL'         ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'WHILE'         ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'WRITE'         ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'ADDREF'        ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'DISPID'        ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'DIVIDE'        ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
       (str:'DOWNTO'        ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
-- 
2.9.3.windows.2

Maciej Izak

2016-10-03 21:53

reporter  

0007-Missing-conversion-token-operator-for-new-management.patch (1,336 bytes)
From cf7f9b47e7845495ffae3af27c8b6f5b97a730a1 Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Fri, 30 Sep 2016 00:57:29 +0200
Subject: [PATCH 07/15] Missing conversion token/operator for new management
 operators AddRef and Copy for previous commit r33469

htypechk.pas:
  + _OP_ADDREF and _OP_COPY to mop_addref and mop_copy

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33475
---
 compiler/htypechk.pas | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index ec9bb07..787e5a5 100644
--- a/compiler/htypechk.pas
+++ b/compiler/htypechk.pas
@@ -137,10 +137,12 @@ interface
         (tok:_OP_DEC     ;nod:inlinen;inr:in_dec_x;op_overloading_supported:true) { unary overloading supported }
       );
 
-      tok2ops=2;
+      tok2ops=4;
       tok2op: array[1..tok2ops] of ttok2oprec = (
         (tok:_OP_INITIALIZE; managementoperator: mop_initialize),
-        (tok:_OP_FINALIZE  ; managementoperator: mop_finalize)
+        (tok:_OP_FINALIZE  ; managementoperator: mop_finalize),
+        (tok:_OP_ADDREF    ; managementoperator: mop_addref),
+        (tok:_OP_COPY      ; managementoperator: mop_copy)
       );
 
       { true, if we are parsing stuff which allows array constructors }
-- 
2.9.3.windows.2

Maciej Izak

2016-10-03 21:53

reporter  

0008-Copy-operator-if-declared-is-executed-instead-of-def.patch (9,053 bytes)
From 6588e0472cbcca31704fe9c20a067095b4dfc359 Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Fri, 30 Sep 2016 01:13:52 +0200
Subject: [PATCH 08/15] Copy operator (if declared) is executed instead of
 default fpc_Copy code (any other behavior has no sense).

rtti.inc:
  * modified fpc_Copy for mentioned behavior

* Test toperator96.pp modified

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33486

RTL support for new management operators AddRef and Copy (NOTE: names can be changed). AddRef operator is used when record is passed as parameter to method/function by value (for records to large to copy (when only the address is pushed)). AddRef is used also for dynamic array operations (temporary for SetLength operation and for Copy operation for already copied data by move).

rtti.inc:
  * Rename TRTTIRecInitFiniOp to TRTTIRecVarOp (is used for Initialize, Finalize and AddRef operator)
  + New operator function type for Copy like operator: TRTTIRecCopyOp
  + New VMT slots for AddRef and Operators in TRTTIRecordOpVMT
  * Adjusted fpc_Addref function to support AddRef operator
  * Adjusted fpc_Copy function to support Copy operator

+ added test

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33478
---
 rtl/inc/rtti.inc          |  71 +++++++++++++---------
 tests/test/tmoperator9.pp | 148 ++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 190 insertions(+), 29 deletions(-)
 create mode 100644 tests/test/tmoperator9.pp

diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
index d65691e..754f026 100644
--- a/rtl/inc/rtti.inc
+++ b/rtl/inc/rtti.inc
@@ -57,7 +57,8 @@ type
   end;
 
 {$if FPC_FULLVERSION>30100}
-  TRTTIRecInitFiniOp=procedure(ARec: Pointer);
+  TRTTIRecVarOp=procedure(ARec: Pointer);
+  TRTTIRecCopyOp=procedure(ASrc, ADest: Pointer);
 
   PRTTIRecordOpVMT=^TRTTIRecordOpVMT;
   TRTTIRecordOpVMT=
@@ -65,8 +66,10 @@ type
   packed
 {$endif USE_PACKED}
   record
-    Initialize: TRTTIRecInitFiniOp;
-    Finalize: TRTTIRecInitFiniOp;
+    Initialize: TRTTIRecVarOp;
+    Finalize: TRTTIRecVarOp;
+    AddRef: TRTTIRecVarOp;
+    Copy: TRTTIRecCopyOp;
   end;
 
   PRecordInfoInit=^TRecordInfoInit;
@@ -312,12 +315,16 @@ begin
     tkobject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord :
-      begin
 {$if FPC_FULLVERSION>30100}
-        { find init table }
-        RTTIRecordOp(typeinfo, typeinfo);
+      { find init table }
+      with RTTIRecordOp(typeinfo, typeinfo)^ do
 {$endif FPC_FULLVERSION>30100}
+      begin
         recordrtti(data,typeinfo,@int_addref);
+{$if FPC_FULLVERSION>30100}
+        if Assigned(recordop) and Assigned(recordop^.AddRef) then
+          recordop^.AddRef(Data);
+{$endif FPC_FULLVERSION>30100}
       end;
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray:
@@ -391,35 +398,41 @@ begin
     tkrecord:
       begin
 {$if FPC_FULLVERSION>30100}
-        { find init table }
-        RTTIRecordOp(typeinfo, typeinfo);
+      { find init table }
+      with RTTIRecordOp(typeinfo, typeinfo)^ do
 {$endif FPC_FULLVERSION>30100}
+      begin
         Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
-
 {$if FPC_FULLVERSION>30100}
-        Result:=PRecordInfoInit(Temp)^.Size;
-        Count:=PRecordInfoInit(Temp)^.Count;
-        Inc(PRecordInfoInit(Temp));
+        if Assigned(recordop) and Assigned(recordop^.Copy) then
+          recordop^.Copy(Src,Dest)
+        else
+          begin
+            Result:=Size;
+            Inc(PRecordInfoInit(Temp));
 {$else FPC_FULLVERSION>30100}
-        Result:=PRecordInfoFull(Temp)^.Size;
-        Count:=PRecordInfoFull(Temp)^.Count;
-        Inc(PRecordInfoFull(Temp));
+            Result:=PRecordInfoFull(Temp)^.Size;
+            Count:=PRecordInfoFull(Temp)^.Count;
+            Inc(PRecordInfoFull(Temp));
 {$endif FPC_FULLVERSION>30100}
-        expectedoffset:=0;
-        { Process elements with rtti }
-        for i:=1 to count Do
-          begin
-            Info:=PRecordElement(Temp)^.TypeInfo{$ifndef VER3_0}^{$endif};
-            Offset:=PRecordElement(Temp)^.Offset;
-            Inc(PRecordElement(Temp));
-            if Offset>expectedoffset then
-              move((Src+expectedoffset)^,(Dest+expectedoffset)^,Offset-expectedoffset);
-            copiedsize:=fpc_Copy_internal(Src+Offset,Dest+Offset,Info);
-            expectedoffset:=Offset+copiedsize;
+            expectedoffset:=0;
+            { Process elements with rtti }
+            for i:=1 to Count Do
+              begin
+                Info:=PRecordElement(Temp)^.TypeInfo{$ifndef VER3_0}^{$endif};
+                Offset:=PRecordElement(Temp)^.Offset;
+                Inc(PRecordElement(Temp));
+                if Offset>expectedoffset then
+                  move((Src+expectedoffset)^,(Dest+expectedoffset)^,Offset-expectedoffset);
+                copiedsize:=fpc_Copy_internal(Src+Offset,Dest+Offset,Info);
+                expectedoffset:=Offset+copiedsize;
+              end;
+            { elements remaining? }
+            if result>expectedoffset then
+              move((Src+expectedoffset)^,(Dest+expectedoffset)^,Result-expectedoffset);
+{$if FPC_FULLVERSION>30100}
           end;
-        { elements remaining? }
-        if result>expectedoffset then
-          move((Src+expectedoffset)^,(Dest+expectedoffset)^,Result-expectedoffset);
+{$endif FPC_FULLVERSION>30100}
       end;
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray:
diff --git a/tests/test/tmoperator9.pp b/tests/test/tmoperator9.pp
new file mode 100644
index 0000000..0e00e92
--- /dev/null
+++ b/tests/test/tmoperator9.pp
@@ -0,0 +1,148 @@
+program tmoperator9;
+
+{$MODE DELPHI}
+
+type
+  TCopyState = (csNone, csSource, csDest);
+  PFoo = ^TFoo;
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+    class operator Finalize(var aFoo: TFoo);
+    class operator AddRef(var aFoo: TFoo);
+    class operator Copy(constref aSrc: TFoo; var aDst: TFoo);
+  public
+    CopyState: TCopyState;
+    Ref: Boolean;
+    F, Test: Integer;
+  end;
+
+  TFooArray = array of TFoo;
+
+procedure TestFoo(const AValue: TFoo; AF, ATest: Integer; ARef: Boolean; ACopyState: TCopyState);
+begin
+  WriteLn('    AValue.F = ', AValue.F);
+  if AValue.F <> AF then
+    Halt(1);
+  WriteLn('    AValue.Test = ', AValue.Test);
+  if AValue.Test <> ATest then
+    Halt(2);
+  WriteLn('    AValue.Ref = ', AValue.Ref);
+  if AValue.Ref <> ARef then
+    Halt(4);
+  WriteLn('    AValue.CopyState = ', Ord(AValue.CopyState));
+  if AValue.CopyState <> ACopyState then
+    Halt(3);
+end;
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+  WriteLn('TFoo.Initialize');
+  aFoo.F := 1;
+  aFoo.Ref := False;
+  aFoo.Test := 0;
+  aFoo.CopyState := csNone;
+end;
+
+class operator TFoo.Finalize(var aFoo: TFoo);
+begin
+  WriteLn('TFoo.Finalize');
+  if (aFoo.F <> 2) and not ((aFoo.F = 3) and aFoo.Ref) then
+    Halt(5);
+  aFoo.F := 4;
+end;
+
+class operator TFoo.AddRef(var aFoo: TFoo);
+begin
+  WriteLn('TFoo.AddRef');
+  aFoo.F := 3;
+  aFoo.Test := aFoo.Test + 1;
+  aFoo.Ref := True;
+end;
+
+class operator TFoo.Copy(constref aSrc: TFoo; var aDst: TFoo);
+var
+  LSrc: PFoo;
+begin
+  WriteLn('TFoo.Copy');
+  LSrc := @aSrc;
+  LSrc.CopyState := csSource;
+  aDst.CopyState := csDest;
+  aDst.Test := aSrc.Test + 1;
+  aDst.F := aSrc.F;
+end;
+
+procedure TestValue(Value: TFoo);
+begin
+  writeln('  *Test without modifier:');
+  TestFoo(Value, 3, 1, True, csNone);
+end;
+
+procedure TestOut(out Value: TFoo);
+begin
+  WriteLn('  *Test out modifier:');
+  TestFoo(Value, 1, 0, False, csNone);
+  Value.F := 2;
+end;
+
+procedure TestVar(var Value: TFoo);
+begin
+  writeln('  *Test var modifier:');
+  TestFoo(Value, 2, 0, False, csNone);
+end;
+
+procedure TestConst(const Value: TFoo);
+begin
+  writeln('  *Test const modifier:');
+  TestFoo(Value, 2, 0, False, csNone);
+end;
+
+procedure TestConstref(constref Value: TFoo);
+begin
+  WriteLn('  *Test constref modifier:');
+  TestFoo(Value, 2, 0, False, csNone);
+end;
+
+procedure Test;
+var
+  Foos: TFooArray;
+  Foos2: TFooArray;
+  A, B, C: TFoo;
+  i: Integer;
+begin
+  WriteLn('*** Test for variable copy');
+  TestFoo(B, 1, 0, False, csNone);
+  B.F := 2;
+  A := B;
+  TestFoo(B, 2, 0, False, csSource);
+  TestFoo(A, 2, 1, False, csDest);
+
+  WriteLn('*** Test for Copy(dyn array)');
+  SetLength(Foos, 5);
+  for i := 0 to 4 do
+  begin
+    Foos[i].F := 2;
+    Foos[i].Test := i;
+  end;
+
+  Foos2 := Copy(Foos);
+
+  for i := 0 to 4 do
+  begin
+    TestFoo(Foos[i], 2, i, False, csNone);
+    TestFoo(Foos2[i], 3, i + 1, True, csNone);
+  end;
+
+  WriteLn('*** Test for parameters modifiers');
+  TestValue(C);
+  C.F := 2; // reset F to pass finalize before out parameter
+  TestOut(C);
+  TestVar(C);
+  TestConst(C);
+  TestConstref(C);
+end;
+
+begin
+  Test;
+  WriteLn('end');
+end.
-- 
2.9.3.windows.2

Maciej Izak

2016-10-03 21:53

reporter  

0009-Rename-for-management-operators-proposed-by-Florian-.patch (9,448 bytes)
From bbb60bef74a539a02eb82304020b33c547c3ab6f Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Fri, 30 Sep 2016 01:31:00 +0200
Subject: [PATCH 09/15] Rename for management operators (proposed by Florian):
 AddRef -> Copy and Copy -> Clone

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/maciej/smart_pointers@33657
---
 compiler/htypechk.pas     |  4 ++--
 compiler/pdecsub.pas      |  8 ++++----
 compiler/symconst.pas     |  4 ++--
 compiler/symtable.pas     |  6 +++---
 compiler/tokens.pas       | 10 +++++-----
 rtl/inc/rtti.inc          | 14 +++++++-------
 tests/test/tmoperator9.pp | 12 ++++++------
 7 files changed, 29 insertions(+), 29 deletions(-)

diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index 787e5a5..0856853 100644
--- a/compiler/htypechk.pas
+++ b/compiler/htypechk.pas
@@ -141,8 +141,8 @@ interface
       tok2op: array[1..tok2ops] of ttok2oprec = (
         (tok:_OP_INITIALIZE; managementoperator: mop_initialize),
         (tok:_OP_FINALIZE  ; managementoperator: mop_finalize),
-        (tok:_OP_ADDREF    ; managementoperator: mop_addref),
-        (tok:_OP_COPY      ; managementoperator: mop_copy)
+        (tok:_OP_COPY      ; managementoperator: mop_copy),
+        (tok:_OP_CLONE     ; managementoperator: mop_clone)
       );
 
       { true, if we are parsing stuff which allows array constructors }
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index cb745aa..b503a37 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -598,7 +598,7 @@ implementation
                     _DEC:optoken:=_OP_DEC;
                     _INITIALIZE:optoken:=_OP_INITIALIZE;
                     _FINALIZE:optoken:=_OP_FINALIZE;
-                    _ADDREF:optoken:=_OP_ADDREF;
+                    _CLONE:optoken:=_OP_CLONE;
                     _COPY:optoken:=_OP_COPY;
                     else
                     if (m_delphi in current_settings.modeswitches) then
@@ -1428,10 +1428,10 @@ implementation
                 end;
 
               { operators without result }
-              if optoken in [_OP_INITIALIZE, _OP_FINALIZE, _OP_ADDREF, _OP_COPY] then
+              if optoken in [_OP_INITIALIZE, _OP_FINALIZE, _OP_COPY, _OP_CLONE] then
                 begin
                   { single var parameter to point the record }
-                  if (optoken in [_OP_INITIALIZE, _OP_FINALIZE, _OP_ADDREF]) and
+                  if (optoken in [_OP_INITIALIZE, _OP_FINALIZE, _OP_COPY]) and
                      (
                       (pd.parast.SymList.Count <> 1) or
                       (tparavarsym(pd.parast.SymList[0]).vardef<>pd.struct) or
@@ -1439,7 +1439,7 @@ implementation
                      ) then
                     Message(parser_e_overload_impossible)
                   { constref (source) and var (dest) parameter to point the records }
-                  else if (optoken = _OP_COPY) and
+                  else if (optoken = _OP_CLONE) and
                      (
                       (pd.parast.SymList.Count <> 2) or
                       (tparavarsym(pd.parast.SymList[0]).vardef<>pd.struct) or
diff --git a/compiler/symconst.pas b/compiler/symconst.pas
index 1f7313b..bf8fb04 100644
--- a/compiler/symconst.pas
+++ b/compiler/symconst.pas
@@ -585,8 +585,8 @@ type
   tmanagementoperator=(mop_none,
     mop_initialize,
     mop_finalize,
-    mop_addref,
-    mop_copy
+    mop_copy,
+    mop_clone
   );
   tmanagementoperators=set of tmanagementoperator;
 
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index f981989..a527904 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -432,8 +432,8 @@ interface
     { _OP_ENUMERATOR }  'enumerator',
     { _OP_INITIALIZE }  'initialize',
     { _OP_FINALIZE   }  'finalize',    
-    { _OP_ADDREF     }  'addref',
     { _OP_COPY       }  'copy',
+    { _OP_CLONE      }  'clone',
     { _OP_INC        }  'inc',
     { _OP_DEC        }  'dec');
 
@@ -441,8 +441,8 @@ interface
     { mop_none       }  NOTOKEN,
     { mop_initialize }  _OP_INITIALIZE,
     { mop_finalize   }  _OP_FINALIZE,
-    { mop_addref     }  _OP_ADDREF,
-    { mop_copy       }  _OP_COPY
+    { mop_copy       }  _OP_COPY,
+    { mop_clone      }  _OP_CLONE
     );
 
 
diff --git a/compiler/tokens.pas b/compiler/tokens.pas
index 1757764..b379d91 100644
--- a/compiler/tokens.pas
+++ b/compiler/tokens.pas
@@ -58,8 +58,8 @@ type
     _OP_ENUMERATOR,
     _OP_INITIALIZE,
     _OP_FINALIZE,    
-    _OP_ADDREF,
     _OP_COPY,
+    _OP_CLONE,
     _OP_INC,
     _OP_DEC,
     { special chars }
@@ -158,6 +158,7 @@ type
     _BREAK,
     _CDECL,
     _CLASS,
+    _CLONE,
     _CONST,
     _EQUAL,
     _FAR16,
@@ -169,7 +170,6 @@ type
     _UNTIL,
     _WHILE,
     _WRITE,
-    _ADDREF,
     _DISPID,
     _DIVIDE,
     _DOWNTO,
@@ -329,7 +329,7 @@ const
   last_overloaded  = _OP_DEC;
   last_operator = _GENERICSPECIALTOKEN;
   first_managment_operator = _OP_INITIALIZE;
-  last_managment_operator = _OP_COPY;
+  last_managment_operator = _OP_CLONE;
 
   highest_precedence = oppower;
 
@@ -391,8 +391,8 @@ const
       (str:'enumerator'    ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'initialize'    ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'finalize'      ;special:true ;keyword:[m_none];op:NOTOKEN),
-      (str:'addref'        ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'copy'          ;special:true ;keyword:[m_none];op:NOTOKEN),
+      (str:'clone'          ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'inc'           ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'dec'           ;special:true ;keyword:[m_none];op:NOTOKEN),
     { Special chars }
@@ -491,6 +491,7 @@ const
       (str:'BREAK'         ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'CDECL'         ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'CLASS'         ;special:false;keyword:[m_class];op:NOTOKEN),
+      (str:'CLONE'        ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'CONST'         ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'EQUAL'         ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
       (str:'FAR16'         ;special:false;keyword:[m_none];op:NOTOKEN),
@@ -502,7 +503,6 @@ const
       (str:'UNTIL'         ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'WHILE'         ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'WRITE'         ;special:false;keyword:[m_none];op:NOTOKEN),
-      (str:'ADDREF'        ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'DISPID'        ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'DIVIDE'        ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
       (str:'DOWNTO'        ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
index 754f026..dbfb891 100644
--- a/rtl/inc/rtti.inc
+++ b/rtl/inc/rtti.inc
@@ -58,7 +58,7 @@ type
 
 {$if FPC_FULLVERSION>30100}
   TRTTIRecVarOp=procedure(ARec: Pointer);
-  TRTTIRecCopyOp=procedure(ASrc, ADest: Pointer);
+  TRTTIRecCloneOp=procedure(ASrc, ADest: Pointer);
 
   PRTTIRecordOpVMT=^TRTTIRecordOpVMT;
   TRTTIRecordOpVMT=
@@ -68,8 +68,8 @@ type
   record
     Initialize: TRTTIRecVarOp;
     Finalize: TRTTIRecVarOp;
-    AddRef: TRTTIRecVarOp;
-    Copy: TRTTIRecCopyOp;
+    Copy: TRTTIRecVarOp;
+    Clone: TRTTIRecCloneOp;
   end;
 
   PRecordInfoInit=^TRecordInfoInit;
@@ -322,8 +322,8 @@ begin
       begin
         recordrtti(data,typeinfo,@int_addref);
 {$if FPC_FULLVERSION>30100}
-        if Assigned(recordop) and Assigned(recordop^.AddRef) then
-          recordop^.AddRef(Data);
+        if Assigned(recordop) and Assigned(recordop^.Copy) then
+          recordop^.Copy(Data);
 {$endif FPC_FULLVERSION>30100}
       end;
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
@@ -404,8 +404,8 @@ begin
       begin
         Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
 {$if FPC_FULLVERSION>30100}
-        if Assigned(recordop) and Assigned(recordop^.Copy) then
-          recordop^.Copy(Src,Dest)
+        if Assigned(recordop) and Assigned(recordop^.Clone) then
+          recordop^.Clone(Src,Dest)
         else
           begin
             Result:=Size;
diff --git a/tests/test/tmoperator9.pp b/tests/test/tmoperator9.pp
index 0e00e92..9126c92 100644
--- a/tests/test/tmoperator9.pp
+++ b/tests/test/tmoperator9.pp
@@ -9,8 +9,8 @@ type
   private
     class operator Initialize(var aFoo: TFoo);
     class operator Finalize(var aFoo: TFoo);
-    class operator AddRef(var aFoo: TFoo);
-    class operator Copy(constref aSrc: TFoo; var aDst: TFoo);
+    class operator Copy(var aFoo: TFoo);
+    class operator Clone(constref aSrc: TFoo; var aDst: TFoo);
   public
     CopyState: TCopyState;
     Ref: Boolean;
@@ -52,19 +52,19 @@ begin
   aFoo.F := 4;
 end;
 
-class operator TFoo.AddRef(var aFoo: TFoo);
+class operator TFoo.Copy(var aFoo: TFoo);
 begin
-  WriteLn('TFoo.AddRef');
+  WriteLn('TFoo.Copy');
   aFoo.F := 3;
   aFoo.Test := aFoo.Test + 1;
   aFoo.Ref := True;
 end;
 
-class operator TFoo.Copy(constref aSrc: TFoo; var aDst: TFoo);
+class operator TFoo.Clone(constref aSrc: TFoo; var aDst: TFoo);
 var
   LSrc: PFoo;
 begin
-  WriteLn('TFoo.Copy');
+  WriteLn('TFoo.Clone');
   LSrc := @aSrc;
   LSrc.CopyState := csSource;
   aDst.CopyState := csDest;
-- 
2.9.3.windows.2

Maciej Izak

2016-10-03 21:53

reporter  

0010-Fix-for-small-compiling-issue-small-mistake-during-m.patch (646 bytes)
From 5326a8c0d6c82c0e3b3d2d68ed3ba994abb64205 Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Fri, 30 Sep 2016 01:43:52 +0200
Subject: [PATCH 10/15] Fix for small compiling issue (small mistake during
 merge)

---
 rtl/inc/rtti.inc | 1 -
 1 file changed, 1 deletion(-)

diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
index dbfb891..d066d5a 100644
--- a/rtl/inc/rtti.inc
+++ b/rtl/inc/rtti.inc
@@ -396,7 +396,6 @@ begin
     tkobject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord:
-      begin
 {$if FPC_FULLVERSION>30100}
       { find init table }
       with RTTIRecordOp(typeinfo, typeinfo)^ do
-- 
2.9.3.windows.2

Maciej Izak

2016-10-03 21:53

reporter  

0011-Adjustment-for-new-interface-for-DefineAsmSymbol-cha.patch (887 bytes)
From 9cbd66ed67e3e25e4111be93cfbd9d7bcc61f8f3 Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Fri, 30 Sep 2016 10:38:49 +0200
Subject: [PATCH 11/15] Adjustment for new interface for DefineAsmSymbol
 (changed in r34164)

---
 compiler/ncgrtti.pas | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas
index 796bcf7..a41e2f0 100644
--- a/compiler/ncgrtti.pas
+++ b/compiler/ncgrtti.pas
@@ -983,7 +983,7 @@ implementation
           begin
             rttilab := current_asmdata.DefineAsmSymbol(
                 internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),
-                AB_GLOBAL,AT_DATA);
+                AB_GLOBAL,AT_DATA,def);
             tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable]);
 
             tcb.begin_anonymous_record(
-- 
2.9.3.windows.2

Maciej Izak

2016-10-03 21:53

reporter  

0012-New-define-FPC_HAS_MANAGEMENT_OPERATORS.patch (783 bytes)
From e797d83bf20898bbf4aeef1d279986afb3787fa1 Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Fri, 30 Sep 2016 11:04:04 +0200
Subject: [PATCH 12/15] New define FPC_HAS_MANAGEMENT_OPERATORS

---
 compiler/options.pas | 1 +
 1 file changed, 1 insertion(+)

diff --git a/compiler/options.pas b/compiler/options.pas
index 4c16178..78c06d2 100644
--- a/compiler/options.pas
+++ b/compiler/options.pas
@@ -3324,6 +3324,7 @@ begin
 {$if defined(x86_64) or defined(i386) or defined(arm) or defined(aarch64)}
   def_system_macro('FPC_HAS_EXTENDEDINTERFACERTTI');
 {$endif x86_64 or i386 or arm or aarch64}
+  def_system_macro('FPC_HAS_MANAGEMENT_OPERATORS');
 
   def_system_macro('FPC_HAS_UNICODESTRING');
   def_system_macro('FPC_RTTI_PACKSET1');
-- 
2.9.3.windows.2

Maciej Izak

2016-10-03 21:53

reporter  

0013-Create-indirect-symbol-fo-record-RTTI-to-initrtti-st.patch (2,975 bytes)
From 273b8da24a40505939977601e50d8099dfd9a7d7 Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Mon, 3 Oct 2016 00:22:17 +0200
Subject: [PATCH 13/15] * Create indirect symbol  fo record RTTI to initrtti
 structure which contains record operators VMT and "real" managed fields list.
 * Use Create_nil_dataptr instead of Create_nil_codeptr in right places.

---
 compiler/ncgrtti.pas | 11 ++++++-----
 rtl/inc/rtti.inc     |  4 ++--
 2 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas
index a41e2f0..d5561d2 100644
--- a/compiler/ncgrtti.pas
+++ b/compiler/ncgrtti.pas
@@ -1030,12 +1030,13 @@ implementation
            { store rtti management operators only for init table }
            if (rt=initrtti) then
            begin
-             tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
+             tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
              if (trecordsymtable(def.symtable).managementoperators=[]) then
-               tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype)
+               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,0),voidpointertype);
+                 internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),
+                 AT_DATA_FORCEINDIRECT,0),voidpointertype);
            end else
            begin
              Include(def.defstates, ds_init_table_used);
@@ -1187,9 +1188,9 @@ implementation
           begin
             tcb.emit_ord_const(def.size, u32inttype);
             { inittable terminator for vmt vInitTable }
-            tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
+            tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
             { pointer to management operators }
-            tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
+            tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
             { enclosing record takes care of alignment }
             fields_write_rtti_data(tcb,def,rt);
           end;
diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
index d066d5a..6a1f081 100644
--- a/rtl/inc/rtti.inc
+++ b/rtl/inc/rtti.inc
@@ -50,7 +50,7 @@ type
   record
     Size: Longint;
 {$if FPC_FULLVERSION>30100}
-    InitTable: Pointer;
+    InitTable: PPointer;
 {$endif FPC_FULLVERSION>30100}
     Count: Longint;
     { Elements: array[count] of TRecordElement }
@@ -130,7 +130,7 @@ begin
   if Assigned(result^.Terminator) then
   begin
     { point to more optimal initrtti }
-    initrtti:=PRecordInfoFull(result)^.InitTable;
+    initrtti:=PRecordInfoFull(result)^.InitTable^;
     { and point to management operators in our init table }
     result:=aligntoptr(initrtti+2+PByte(initrtti)[1]);
   end
-- 
2.9.3.windows.2

Maciej Izak

2016-10-03 21:54

reporter  

0014-Invoke-management-operators-even-for-records-with-si.patch (7,016 bytes)
From 46fe321885c30b0384f405c37e4a55b452d83e88 Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Mon, 3 Oct 2016 15:56:28 +0200
Subject: [PATCH 14/15] Invoke management operators even for records with size
 = 0.

rtti.inc:
  + New function RTTISizeAndOp to get size and operator if exist (for FPC > 3.1.0)
  + Related type TRTTIRecOpType to RTTISizeAndOp (to get right management operator context)
  - Remove RTTISize for (for FPC > 3.1.0)
  * fpc_initialize_array, fpc_finalize_array, fpc_addref_array and CopyArray modifications for new RTTISizeAndOp

+ added tests
---
 rtl/inc/rtti.inc           | 73 +++++++++++++++++++++++++++++++++++++++-------
 tests/test/tmoperator10.pp | 55 ++++++++++++++++++++++++++++++++++
 tests/test/tmoperator11.pp | 24 +++++++++++++++
 3 files changed, 142 insertions(+), 10 deletions(-)
 create mode 100644 tests/test/tmoperator10.pp
 create mode 100644 tests/test/tmoperator11.pp

diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
index 6a1f081..d9ca49a 100644
--- a/rtl/inc/rtti.inc
+++ b/rtl/inc/rtti.inc
@@ -59,7 +59,7 @@ type
 {$if FPC_FULLVERSION>30100}
   TRTTIRecVarOp=procedure(ARec: Pointer);
   TRTTIRecCloneOp=procedure(ASrc, ADest: Pointer);
-
+  TRTTIRecOpType=(rotAny, rotInitialize, rotFinalize, rotCopy, rotClone);
   PRTTIRecordOpVMT=^TRTTIRecordOpVMT;
   TRTTIRecordOpVMT=
 {$ifdef USE_PACKED}
@@ -137,8 +137,15 @@ begin
 end;
 {$endif FPC_FULLVERSION>30100}
 
+{$if FPC_FULLVERSION>30100}
+function RTTISizeAndOp(typeInfo: Pointer;
+  const expectedManagementOp: TRTTIRecOpType; out hasManagementOp: boolean): SizeInt;
+begin
+  hasManagementOp:=false;
+{$else}
 function RTTISize(typeInfo: Pointer): SizeInt;
 begin
+{$endif}
   case PByte(typeinfo)^ of
     tkAString,tkWString,tkUString,
     tkInterface,tkDynarray:
@@ -149,8 +156,26 @@ begin
 {$endif FPC_HAS_FEATURE_VARIANTS}
     tkArray:
       result:=RTTIArraySize(typeinfo);
+{$if FPC_FULLVERSION>30100}
+    tkObject:
+      result:=RTTIRecordSize(typeinfo);
+    tkRecord:
+      with RTTIRecordOp(typeInfo,typeInfo)^ do
+        begin
+          result:=Size;
+          hasManagementOp := Assigned(RecordOp);
+          if hasManagementOp then
+            case expectedManagementOp of
+              rotInitialize: hasManagementOp:=Assigned(RecordOp^.Initialize);
+              rotFinalize: hasManagementOp:=Assigned(RecordOp^.Finalize);
+              rotCopy: hasManagementOp:=Assigned(RecordOp^.Copy);
+              rotClone: hasManagementOp:=Assigned(RecordOp^.Clone);
+            end;
+        end;
+{$else FPC_FULLVERSION>30100}
     tkObject,tkRecord:
       result:=RTTIRecordSize(typeinfo);
+{$endif FPC_FULLVERSION>30100}
   else
     result:=-1;
   end;
@@ -462,30 +487,51 @@ end;
 procedure fpc_initialize_array(data,typeinfo : pointer;count : SizeInt); [public,alias:'FPC_INITIALIZE_ARRAY']; compilerproc;
   var
      i, size : SizeInt;
+{$if FPC_FULLVERSION>30100}
+    hasManagementOp: boolean;
   begin
-     size:=RTTISize(typeinfo);
-     if size>0 then
-       for i:=0 to count-1 do
-         int_initialize(data+size*i,typeinfo);
+    size:=RTTISizeAndOp(typeinfo, rotInitialize, hasManagementOp);
+    if (size>0) or hasManagementOp then
+{$else FPC_FULLVERSION>30100}
+  begin    
+    size:=RTTISize(typeInfo);
+    if size>0 then
+{$endif FPC_FULLVERSION>30100}
+      for i:=0 to count-1 do
+        int_initialize(data+size*i,typeinfo);
   end;
 
 
 procedure fpc_finalize_array(data,typeinfo : pointer;count : SizeInt); [Public,Alias:'FPC_FINALIZE_ARRAY'];  compilerproc;
   var
      i, size: SizeInt;
+{$if FPC_FULLVERSION>30100}
+    hasManagementOp: boolean;
   begin
-     size:=RTTISize(typeinfo);
-     if size>0 then
-       for i:=0 to count-1 do
-         int_finalize(data+size*i,typeinfo);
+    size:=RTTISizeAndOp(typeinfo, rotFinalize, hasManagementOp);
+    if (size>0) or hasManagementOp then
+{$else FPC_FULLVERSION>30100}
+  begin    
+    size:=RTTISize(typeInfo);
+    if size>0 then
+{$endif FPC_FULLVERSION>30100}
+      for i:=0 to count-1 do
+        int_finalize(data+size*i,typeinfo);
   end;
 
 procedure fpc_addref_array(data,typeinfo: pointer; count: SizeInt); [public,alias:'FPC_ADDREF_ARRAY']; compilerproc;
   var
     i, size: SizeInt;
+{$if FPC_FULLVERSION>30100}
+    hasManagementOp: boolean;
   begin
-    size:=RTTISize(typeinfo);
+    size:=RTTISizeAndOp(typeinfo, rotCopy, hasManagementOp);
+    if (size>0) or hasManagementOp then
+{$else FPC_FULLVERSION>30100}
+  begin    
+    size:=RTTISize(typeInfo);
     if size>0 then
+{$endif FPC_FULLVERSION>30100}
       for i:=0 to count-1 do
         int_addref(data+size*i,typeinfo);
   end;
@@ -510,9 +556,16 @@ procedure FinalizeArray(p, typeInfo: Pointer; count: SizeInt);
 procedure CopyArray(dest, source, typeInfo: Pointer; count: SizeInt);
   var
     i, size: SizeInt;
+{$if FPC_FULLVERSION>30100}
+    hasManagementOp: boolean;
   begin
+    size:=RTTISizeAndOp(typeinfo, rotClone, hasManagementOp);
+    if (size>0) or hasManagementOp then
+{$else FPC_FULLVERSION>30100}
+  begin    
     size:=RTTISize(typeInfo);
     if size>0 then
+{$endif FPC_FULLVERSION>30100}
       for i:=0 to count-1 do
         fpc_Copy_internal(source+size*i, dest+size*i, typeInfo);
   end;
diff --git a/tests/test/tmoperator10.pp b/tests/test/tmoperator10.pp
new file mode 100644
index 0000000..4f8f7de
--- /dev/null
+++ b/tests/test/tmoperator10.pp
@@ -0,0 +1,55 @@
+program tmoperator10;
+
+{$MODE DELPHI}
+
+type
+
+  { TFoo }
+
+  PFoo = ^TFoo;
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+    class operator Finalize(var aFoo: TFoo);
+  end;
+
+{ TFoo }
+
+var
+  ok_initialize: boolean = false;
+  ok_finalize: boolean = false;
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+  ok_initialize := true;
+end;
+
+class operator TFoo.Finalize(var aFoo: TFoo);
+begin
+  ok_finalize := true;
+end;
+
+var
+  PF: PFoo;
+begin
+  { init rtti test }
+  New(PF);
+  if not ok_initialize then
+    Halt(1);
+  Dispose(PF);
+  if not ok_finalize then
+    Halt(2);
+
+  ok_initialize := false;
+  ok_finalize := false;
+
+  { regular rtti test }
+  GetMem(PF, SizeOf(TFoo));
+  InitializeArray(PF, TypeInfo(TFoo), 1);
+  if not ok_initialize then
+    Halt(3);
+  FinalizeArray(PF, TypeInfo(TFoo), 1);
+  if not ok_finalize then
+    Halt(4);
+  FreeMem(PF);
+end. 
\ No newline at end of file
diff --git a/tests/test/tmoperator11.pp b/tests/test/tmoperator11.pp
new file mode 100644
index 0000000..c487346
--- /dev/null
+++ b/tests/test/tmoperator11.pp
@@ -0,0 +1,24 @@
+program tmoperator11;
+
+{$MODE DELPHI}
+
+uses
+  TypInfo;
+
+type
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+  end;
+  TFooArray = array of TFoo;
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+end;
+
+begin
+  if GetTypeData(TypeInfo(TFooArray))^.ElType = nil then
+    Halt(1);
+  if GetTypeData(TypeInfo(TFooArray))^.ElType2 = nil then
+    Halt(2);
+end. 
\ No newline at end of file
-- 
2.9.3.windows.2

Maciej Izak

2016-10-03 21:54

reporter  

0015-Speed-up-SetLength-if-record-is-not-managed-has-no-m.patch (1,855 bytes)
From 42cd4099ea9fc7d46de9288181712b6c6d03b7a2 Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Mon, 3 Oct 2016 19:56:08 +0200
Subject: [PATCH 15/15] Speed up SetLength if record is not managed (has no
 management operators nor managed fields)

---
 rtl/inc/dynarr.inc | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/rtl/inc/dynarr.inc b/rtl/inc/dynarr.inc
index 6e43e17..2d828c7 100644
--- a/rtl/inc/dynarr.inc
+++ b/rtl/inc/dynarr.inc
@@ -34,7 +34,7 @@ type
       thus use packed also in this case }
     {$ifdef VER3_0_0}
       packed
-    {$endif VER"_0_0}
+    {$endif VER3_0_0}
   {$endif powerpc64}
 
 {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
@@ -187,7 +187,7 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
           fillchar(newp^,size,0);
 {$if FPC_FULLVERSION>30100}
           { call int_InitializeArray for management operators }
-          if PByte(eletype)^ in [tkRecord, tkObject] then
+          if assigned(eletypemngd) and (PByte(eletype)^ in [tkRecord, tkObject]) then
             int_InitializeArray(pointer(newp)+sizeof(tdynarray), eletype, dims[0]);
 {$endif FPC_FULLVERSION>30100}
           updatep := true;
@@ -264,7 +264,7 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
                            (dims[0]-realp^.high-1)*elesize,0);
 {$if FPC_FULLVERSION>30100}
                          { call int_InitializeArray for management operators }
-                         if PByte(eletype)^ in [tkRecord, tkObject] then
+                         if assigned(eletypemngd) and (PByte(eletype)^ in [tkRecord, tkObject]) then
                            int_InitializeArray(pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1),
                              eletype, dims[0]-realp^.high-1);
 {$endif FPC_FULLVERSION>30100}
-- 
2.9.3.windows.2

Maciej Izak

2016-10-09 14:57

reporter  

0001-typinfo.pp-Small-correction-more-proper-declaration-.patch (880 bytes)
From 718fd0b9c20ea7b3aad0e87c55e2f78a8a845d26 Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Sun, 9 Oct 2016 14:55:44 +0200
Subject: [PATCH] typinfo.pp: Small correction (more proper declaration) for
 indirect RTTI symbol for TTypeData for RecInitTable field.

---
 rtl/objpas/typinfo.pp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp
index 5652900..173ab1f 100644
--- a/rtl/objpas/typinfo.pp
+++ b/rtl/objpas/typinfo.pp
@@ -313,7 +313,7 @@ unit typinfo;
               (
                 RecSize: Integer;
 {$if FPC_FULLVERSION>30100}
-                RecInitTable: Pointer;
+                RecInitTable: PPointer;
 {$endif FPC_FULLVERSION>30100}
                 ManagedFldCount: Integer;
                 {ManagedFields: array[1..ManagedFldCount] of TManagedField}
-- 
2.9.3.windows.2

Florian

2016-10-21 20:48

administrator   ~0095248

Did you create any tests? I think we discussed this already that tests are very important.

Maciej Izak

2016-10-21 21:19

reporter   ~0095249

Sure, all is included in patches. Additionally you can review tests here:

https://github.com/newpascal/freepascal/blob/master/tests/test/tmoperator1.pp
https://github.com/newpascal/freepascal/blob/master/tests/test/tmoperator2.pp
https://github.com/newpascal/freepascal/blob/master/tests/test/tmoperator3.pp
https://github.com/newpascal/freepascal/blob/master/tests/test/tmoperator4.pp
https://github.com/newpascal/freepascal/blob/master/tests/test/tmoperator5.pp
https://github.com/newpascal/freepascal/blob/master/tests/test/tmoperator6.pp
https://github.com/newpascal/freepascal/blob/master/tests/test/tmoperator7.pp
https://github.com/newpascal/freepascal/blob/master/tests/test/tmoperator8.pp
https://github.com/newpascal/freepascal/blob/master/tests/test/tmoperator9.pp
https://github.com/newpascal/freepascal/blob/master/tests/test/tmoperator10.pp
https://github.com/newpascal/freepascal/blob/master/tests/test/tmoperator11.pp

Florian

2016-10-22 11:30

administrator   ~0095253

Ops, sorry, I overlooked those.

Maciej Izak

2016-10-22 17:37

reporter   ~0095264

If you like to test management operators with latest Lazarus/FPC we have new release of self contained (cross-) NewPascal (management operators included):

https://github.com/newpascal/newpascal/releases/tag/np_sc-v1.0.34

Florian

2016-10-22 22:54

administrator   ~0095267

I had a look at the patch and it looks good to me. Only one comment: why does the rtl part use {$if FPC_FULLVERSION>30100}? Wouldn't it be more clean to check FPC_HAS_MANAGEMENT_OPERATORS?

Maciej Izak

2016-10-23 11:58

reporter  

0001-Use-more-readable-FPC_HAS_MANAGEMENT_OPERATORS-inste.patch (13,374 bytes)
From a8f4f122cccf7f35f88e89798f23d3dbc6030644 Mon Sep 17 00:00:00 2001
From: maciej-izak <hnb.code@gmail.com>
Date: Sun, 23 Oct 2016 11:54:04 +0200
Subject: [PATCH] Use more readable FPC_HAS_MANAGEMENT_OPERATORS instead of
 FPC_FULLVERSION>30100 for RTL part

---
 rtl/inc/dynarr.inc    |  8 ++---
 rtl/inc/objpas.inc    |  8 ++---
 rtl/inc/rtti.inc      | 88 +++++++++++++++++++++++++--------------------------
 rtl/objpas/typinfo.pp |  4 +--
 4 files changed, 54 insertions(+), 54 deletions(-)

diff --git a/rtl/inc/dynarr.inc b/rtl/inc/dynarr.inc
index 2d828c7..1724dd3 100644
--- a/rtl/inc/dynarr.inc
+++ b/rtl/inc/dynarr.inc
@@ -185,11 +185,11 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
             exit;
           getmem(newp,size);
           fillchar(newp^,size,0);
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
           { call int_InitializeArray for management operators }
           if assigned(eletypemngd) and (PByte(eletype)^ in [tkRecord, tkObject]) then
             int_InitializeArray(pointer(newp)+sizeof(tdynarray), eletype, dims[0]);
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
           updatep := true;
        end
      else
@@ -262,12 +262,12 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
                          reallocmem(realp,size);
                          fillchar((pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1))^,
                            (dims[0]-realp^.high-1)*elesize,0);
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
                          { call int_InitializeArray for management operators }
                          if assigned(eletypemngd) and (PByte(eletype)^ in [tkRecord, tkObject]) then
                            int_InitializeArray(pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1),
                              eletype, dims[0]-realp^.high-1);
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
                       end;
                     newp := realp;
                     updatep := true;
diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc
index 3072923..8fdfe79 100644
--- a/rtl/inc/objpas.inc
+++ b/rtl/inc/objpas.inc
@@ -379,11 +379,11 @@
 
       class function TObject.InitInstance(instance : pointer) : tobject; {$ifdef SYSTEMINLINE} inline; {$ENDIF}
 
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
         var
            vmt  : PVmt;
            temp : pointer;
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
         begin
            { the size is saved at offset 0 }
            fillchar(instance^, InstanceSize, 0);
@@ -393,7 +393,7 @@
            if {$ifdef VER3_0}PVmt(self)^.vIntfTable <> @emptyintf{$else}assigned(PVmt(self)^.vIntfTable){$endif} then
              InitInterfacePointers(self,instance);
 
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
            { for record operators like initialize/finalize call int_initialize }
            vmt := PVmt(self);
            while vmt<>nil do
@@ -405,7 +405,7 @@
                  RecordRTTI(Instance,Temp,@int_initialize);
                vmt:= vmt^.vParent;
              end;
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
 
            InitInstance:=TObject(Instance);
         end;
diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
index d9ca49a..9e28bd5 100644
--- a/rtl/inc/rtti.inc
+++ b/rtl/inc/rtti.inc
@@ -49,14 +49,14 @@ type
 {$endif USE_PACKED}
   record
     Size: Longint;
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
     InitTable: PPointer;
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
     Count: Longint;
     { Elements: array[count] of TRecordElement }
   end;
 
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
   TRTTIRecVarOp=procedure(ARec: Pointer);
   TRTTIRecCloneOp=procedure(ASrc, ADest: Pointer);
   TRTTIRecOpType=(rotAny, rotInitialize, rotFinalize, rotCopy, rotClone);
@@ -84,7 +84,7 @@ type
     Count: Longint;
     { Elements: array[count] of TRecordElement }
   end;
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
 
   PArrayInfo=^TArrayInfo;
   TArrayInfo=
@@ -119,7 +119,7 @@ begin
   result:=PRecordInfoFull(typeInfo)^.Size;
 end;
 
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
 function RTTIRecordOp(typeInfo: Pointer; var initrtti: Pointer): PRecordInfoInit; inline;
 begin
   { find init table and management operators }
@@ -135,17 +135,17 @@ begin
     result:=aligntoptr(initrtti+2+PByte(initrtti)[1]);
   end
 end;
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
 
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
 function RTTISizeAndOp(typeInfo: Pointer;
   const expectedManagementOp: TRTTIRecOpType; out hasManagementOp: boolean): SizeInt;
 begin
   hasManagementOp:=false;
-{$else}
+{$else FPC_HAS_MANAGEMENT_OPERATORS}
 function RTTISize(typeInfo: Pointer): SizeInt;
 begin
-{$endif}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
   case PByte(typeinfo)^ of
     tkAString,tkWString,tkUString,
     tkInterface,tkDynarray:
@@ -156,7 +156,7 @@ begin
 {$endif FPC_HAS_FEATURE_VARIANTS}
     tkArray:
       result:=RTTIArraySize(typeinfo);
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
     tkObject:
       result:=RTTIRecordSize(typeinfo);
     tkRecord:
@@ -172,10 +172,10 @@ begin
               rotClone: hasManagementOp:=Assigned(RecordOp^.Clone);
             end;
         end;
-{$else FPC_FULLVERSION>30100}
+{$else FPC_HAS_MANAGEMENT_OPERATORS}
     tkObject,tkRecord:
       result:=RTTIRecordSize(typeinfo);
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
   else
     result:=-1;
   end;
@@ -188,13 +188,13 @@ var
   i : longint;
 begin
   typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
   Count:=PRecordInfoInit(typeInfo)^.Count;
   Inc(PRecordInfoInit(typeInfo));
-{$else FPC_FULLVERSION>30100}
+{$else FPC_HAS_MANAGEMENT_OPERATORS}
   Count:=PRecordInfoFull(typeInfo)^.Count;
   Inc(PRecordInfoFull(typeInfo));
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
   { Process elements }
   for i:=1 to count Do
     begin
@@ -254,7 +254,7 @@ begin
     tkObject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkRecord:
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
       { if possible try to use more optimal initrtti }
       with RTTIRecordOp(typeinfo, typeinfo)^ do
       begin
@@ -262,9 +262,9 @@ begin
         if Assigned(recordop) and Assigned(recordop^.Initialize) then
           recordop^.Initialize(data);
       end;
-{$else FPC_FULLVERSION>30100}
+{$else FPC_HAS_MANAGEMENT_OPERATORS}
       recordrtti(data,typeinfo,@int_initialize);
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
 {$ifdef FPC_HAS_FEATURE_VARIANTS}
     tkVariant:
       variant_init(PVarData(Data)^);
@@ -294,7 +294,7 @@ begin
     tkObject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkRecord:
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
       { if possible try to use more optimal initrtti }
       with RTTIRecordOp(typeinfo, typeinfo)^ do
       begin
@@ -302,9 +302,9 @@ begin
           recordop^.Finalize(data);
         recordrtti(data,typeinfo,@int_finalize);
       end;
-{$else FPC_FULLVERSION>30100}
+{$else FPC_HAS_MANAGEMENT_OPERATORS}
       recordrtti(data,typeinfo,@int_finalize);
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
     tkInterface:
       Intf_Decr_Ref(PPointer(Data)^);
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
@@ -340,16 +340,16 @@ begin
     tkobject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord :
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
       { find init table }
       with RTTIRecordOp(typeinfo, typeinfo)^ do
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
       begin
         recordrtti(data,typeinfo,@int_addref);
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
         if Assigned(recordop) and Assigned(recordop^.Copy) then
           recordop^.Copy(Data);
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
       end;
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray:
@@ -421,24 +421,24 @@ begin
     tkobject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord:
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
       { find init table }
       with RTTIRecordOp(typeinfo, typeinfo)^ do
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
       begin
         Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
         if Assigned(recordop) and Assigned(recordop^.Clone) then
           recordop^.Clone(Src,Dest)
         else
           begin
             Result:=Size;
             Inc(PRecordInfoInit(Temp));
-{$else FPC_FULLVERSION>30100}
+{$else FPC_HAS_MANAGEMENT_OPERATORS}
             Result:=PRecordInfoFull(Temp)^.Size;
             Count:=PRecordInfoFull(Temp)^.Count;
             Inc(PRecordInfoFull(Temp));
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
             expectedoffset:=0;
             { Process elements with rtti }
             for i:=1 to Count Do
@@ -454,9 +454,9 @@ begin
             { elements remaining? }
             if result>expectedoffset then
               move((Src+expectedoffset)^,(Dest+expectedoffset)^,Result-expectedoffset);
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
           end;
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
       end;
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray:
@@ -487,16 +487,16 @@ end;
 procedure fpc_initialize_array(data,typeinfo : pointer;count : SizeInt); [public,alias:'FPC_INITIALIZE_ARRAY']; compilerproc;
   var
      i, size : SizeInt;
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
     hasManagementOp: boolean;
   begin
     size:=RTTISizeAndOp(typeinfo, rotInitialize, hasManagementOp);
     if (size>0) or hasManagementOp then
-{$else FPC_FULLVERSION>30100}
+{$else FPC_HAS_MANAGEMENT_OPERATORS}
   begin    
     size:=RTTISize(typeInfo);
     if size>0 then
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
       for i:=0 to count-1 do
         int_initialize(data+size*i,typeinfo);
   end;
@@ -505,16 +505,16 @@ procedure fpc_initialize_array(data,typeinfo : pointer;count : SizeInt); [public
 procedure fpc_finalize_array(data,typeinfo : pointer;count : SizeInt); [Public,Alias:'FPC_FINALIZE_ARRAY'];  compilerproc;
   var
      i, size: SizeInt;
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
     hasManagementOp: boolean;
   begin
     size:=RTTISizeAndOp(typeinfo, rotFinalize, hasManagementOp);
     if (size>0) or hasManagementOp then
-{$else FPC_FULLVERSION>30100}
+{$else FPC_HAS_MANAGEMENT_OPERATORS}
   begin    
     size:=RTTISize(typeInfo);
     if size>0 then
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
       for i:=0 to count-1 do
         int_finalize(data+size*i,typeinfo);
   end;
@@ -522,16 +522,16 @@ procedure fpc_finalize_array(data,typeinfo : pointer;count : SizeInt); [Public,A
 procedure fpc_addref_array(data,typeinfo: pointer; count: SizeInt); [public,alias:'FPC_ADDREF_ARRAY']; compilerproc;
   var
     i, size: SizeInt;
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
     hasManagementOp: boolean;
   begin
     size:=RTTISizeAndOp(typeinfo, rotCopy, hasManagementOp);
     if (size>0) or hasManagementOp then
-{$else FPC_FULLVERSION>30100}
+{$else FPC_HAS_MANAGEMENT_OPERATORS}
   begin    
     size:=RTTISize(typeInfo);
     if size>0 then
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
       for i:=0 to count-1 do
         int_addref(data+size*i,typeinfo);
   end;
@@ -556,16 +556,16 @@ procedure FinalizeArray(p, typeInfo: Pointer; count: SizeInt);
 procedure CopyArray(dest, source, typeInfo: Pointer; count: SizeInt);
   var
     i, size: SizeInt;
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
     hasManagementOp: boolean;
   begin
     size:=RTTISizeAndOp(typeinfo, rotClone, hasManagementOp);
     if (size>0) or hasManagementOp then
-{$else FPC_FULLVERSION>30100}
+{$else FPC_HAS_MANAGEMENT_OPERATORS}
   begin    
     size:=RTTISize(typeInfo);
     if size>0 then
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
       for i:=0 to count-1 do
         fpc_Copy_internal(source+size*i, dest+size*i, typeInfo);
   end;
diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp
index 173ab1f..d801f7b 100644
--- a/rtl/objpas/typinfo.pp
+++ b/rtl/objpas/typinfo.pp
@@ -312,9 +312,9 @@ unit typinfo;
             tkRecord:
               (
                 RecSize: Integer;
-{$if FPC_FULLVERSION>30100}
+{$ifdef FPC_HAS_MANAGEMENT_OPERATORS}
                 RecInitTable: PPointer;
-{$endif FPC_FULLVERSION>30100}
+{$endif FPC_HAS_MANAGEMENT_OPERATORS}
                 ManagedFldCount: Integer;
                 {ManagedFields: array[1..ManagedFldCount] of TManagedField}
               );
-- 
2.9.3.windows.2

Maciej Izak

2016-10-23 11:58

reporter   ~0095271

Right, thanks for suggestion. FPC_HAS_MANAGEMENT_OPERATORS was introduced almost as last part of my work. New patch attached.

Jonas Maebe

2016-11-01 13:17

manager   ~0095445

In principle, the changes themselves look okay, apart from one small thing: don't use const_align() for data generated in ncgrtti.pas. const_align() applies user alignment settings, which should be ignored for internally generated data. This was also done in other places in the past, but that's been cleaned up in the the mean time.

That said, the form/patches should be reworked:
1) later patches should not contain fixups for earlier ones (e.g. 0010-Fix-for-small-compiling-issue-small-mistake-during-m.patch); sometimes this happens even without mentioning those fixups in the commit message, (like with the 'VER"_0_0' correction in 0015-Speed-up-SetLength-if-record-is-not-managed-has-no-m.patch)
2) after every patch, "make all" should work. The new feature doesn't have to work yet, but a patch shouldn't break bisecting. So no patch in the middle of the series that is e.g. needed to fix the compilation of a previous one due to changes to trunk while you were working on the feature (like 0011-Adjustment-for-new-interface-for-DefineAsmSymbol-cha.patch)
3) the patch should be against trunk instead of against NewPascal or the extendedrtti branch (0012-New-define-FPC_HAS_MANAGEMENT_OPERATORS.patch contains a "FPC_HAS_EXTENDEDINTERFACERTTI" define in the diff context)
4) some comments should be rewritten to describe everything as it has eventually been implemented, so you don't need to look at later patches to know what happened in the end. E.g., from 0008-Copy-operator-if-declared-is-executed-instead-of-def.patch: "RTL support for new management operators AddRef and Copy (NOTE: names can be changed)" -- immediately write the final names. Also, (from the same patch) commit comments like "(any other behavior has no sense)" are not helpful either: you should explain what the problem is with other behaviour, or simply explain why you chose that behaviour (maybe simply explaining what it does is already sufficient)

I know this is far from a trivial amount of work, but I also have to do it all the time when working on bigger things (like the LLVM support). I understand that you would be reluctant to do it if you were not even sure that the work would get in, but that should be cleared up now.

Thanks for your work on this.

Maciej Izak

2016-11-21 01:57

reporter  

mo-patch-final.zip (28,207 bytes)

Maciej Izak

2016-11-21 02:18

reporter   ~0096093

Thanks Jonas. Patch for management operators is totally reworked. My base is trunk r34916. Each commit works well with "make clean all". I have new dedicated branch located here:

https://github.com/maciej-izak/freepascal/tree/fpc-management-operators

Patch has 3 parts (17 patches attached in single zip file "mo-patch-final.zip" in bug report : http://bugs.freepascal.org/view.php?id=30687 )

*PART 1*

Patch 1-3 minor small improvement and typo fixes for compiler:

1. https://github.com/maciej-izak/freepascal/commit/bfabb129877c1663b8e2a9556685aef2729ac175
2. https://github.com/maciej-izak/freepascal/commit/61fc1a967005d73e4bcd787a771e6f8fb0218983
3. https://github.com/maciej-izak/freepascal/commit/452406872d9308dd51a609a509ee4353c905aeba

*PART 2*

Patch 4 . Independent optimization (Jonas request long time ago) for InitializeArray/FinalizeArray . Is not directly related to management operators.

4. https://github.com/maciej-izak/freepascal/commit/ea23ca80630fae488990dcd4bc62ddc94b18d304

*PART 3*

Patch 5-17. Main patch totally reworked. All is presented in step by step with small logic parts (I hope so).

5. https://github.com/maciej-izak/freepascal/commit/25ed2a4d682392ca4a14854d5573fcc503b59ee1
6. https://github.com/maciej-izak/freepascal/commit/9e1fd0886ab2f0bce0c629a1e67c08b8190af6a5
7. https://github.com/maciej-izak/freepascal/commit/7e1c32be9f8376048541fc5891d765553752a2b8
8. https://github.com/maciej-izak/freepascal/commit/c5db54a0e027714631a884503c52360a43513f01
9. https://github.com/maciej-izak/freepascal/commit/59a099c0e172f8262c93cd4fb0b12806190d8166
10. https://github.com/maciej-izak/freepascal/commit/afc64498ad23362a7bce3da6bc80fa549244cc01
11. https://github.com/maciej-izak/freepascal/commit/4393cea745319acf3144584fc1b068aea1cf39b5
12. https://github.com/maciej-izak/freepascal/commit/0b0197c9f1bfba05dfe1486f9512877b63f9c928
13. https://github.com/maciej-izak/freepascal/commit/9baa32a49a204686427981d33c9054f64b2057c4
14. https://github.com/maciej-izak/freepascal/commit/5043b4bffabb9091b3dc828ea0f3b7af6eaab6e6
15. https://github.com/maciej-izak/freepascal/commit/a6d73af5ade3312669a78f93068f518aeb96b1ac
16. https://github.com/maciej-izak/freepascal/commit/62d19301e87721cfab8040718a236e00e32a6b4d
17. https://github.com/maciej-izak/freepascal/commit/91fbd86464e47e7f81c1255904bdf0914083764c

delfion

2016-11-21 15:14

reporter   ~0096101

I tried Part 2 alone but

Error: Compilation raised exception internally
An unhandled exception occurred at $08049421:
EAccessViolation: Access violation
  $08049421 fpc_ansistr_decr_ref, line 1396 of /home/user/fpc31/rtl/i386/i386.inc
  $080B4434 TDIRECTORYCACHE__FINDNEXT, line 469 of cfileutl.pas
  $080B4377 TDIRECTORYCACHE__FINDFIRST, line 449 of cfileutl.pas
  $080B5906 TSEARCHPATHLIST__ADDPATH, line 1096 of cfileutl.pas
  $080B551D TSEARCHPATHLIST__ADDPATH, line 994 of cfileutl.pas
  $081D5C04 TOPTION__INTERPRET_OPTION, line 1576 of options.pas
  $081D8A74 TOPTION__INTERPRET_FILE, line 2783 of options.pas
  $081DA4DF READ_ARGUMENTS, line 3561 of options.pas
  $08071E22 INITCOMPILER, line 207 of compiler.pas
  $08071F0E COMPILE, line 254 of compiler.pas
  $080482C6 main, line 232 of pp.pas

Maciej Izak

2016-11-21 15:43

reporter   ~0096102

Last edited: 2016-11-21 15:51

View 2 revisions

Did you use "make clean all" ? Seems like you have some old ppu files. You need to build again compiler + rtl + all packages.

Maciej Izak

2016-11-21 15:50

reporter   ~0096103

note: as starter compiler you need to use latest stable FPC otherwise you can receive errors like this. Eventually when you have new compiler compiled by latest stable FPC then you can use that new compiler to compile new compiler (for example to build cross compiler for AArch64 platform).

delfion

2016-11-21 19:22

reporter   ~0096106

There is 4 files in part 2, not only 1. Now it compiles ok.

Florian

2016-11-27 21:04

administrator   ~0096313

I started with committing the simple ones.

Maciej Izak

2016-12-08 11:17

reporter   ~0096592

Last edited: 2016-12-08 12:39

View 2 revisions

0031081 is not related to "Management Operators" but is probably related to patch in 0025607

Sven Barth

2016-12-14 00:04

manager   ~0096759

Committed part 2 as r35125 with a few small adjustments (see commit log)

Maciej Izak

2016-12-15 09:47

reporter   ~0096799

Patch 0031118 for *PART 2* is not required for *PART 3* of management operators (is fixed in other way, see my comment above: point 13 in *PART 3*):

https://github.com/maciej-izak/freepascal/commit/9baa32a49a204686427981d33c9054f64b2057c4

Marco van de Voort

2017-02-28 13:17

manager   ~0098507

Maciej doesn't have the power. I do.

Maciej Izak

2017-02-28 14:43

reporter   ~0098510

Amazing. We have it! :)

Issue History

Date Modified Username Field Change
2016-10-03 21:51 Maciej Izak New Issue
2016-10-03 21:51 Maciej Izak File Added: 0001-Fix-small-typo-don-t-use-COPY-token-as-keyword.patch
2016-10-03 21:52 Maciej Izak File Added: 0002-Add-support-for-new-record-operators-management-oper.patch
2016-10-03 21:52 Maciej Izak File Added: 0003-rtti.inc.patch
2016-10-03 21:52 Maciej Izak File Added: 0004-RTL-compileable-with-the-FPC-3.0.patch
2016-10-03 21:52 Maciej Izak File Added: 0005-Allow-Initialize-management-operator-for-SetLength-f.patch
2016-10-03 21:52 Maciej Izak File Added: 0006-New-tokens-proper-parsing-and-new-VMT-slots-for-new-.patch
2016-10-03 21:53 Maciej Izak File Added: 0007-Missing-conversion-token-operator-for-new-management.patch
2016-10-03 21:53 Maciej Izak File Added: 0008-Copy-operator-if-declared-is-executed-instead-of-def.patch
2016-10-03 21:53 Maciej Izak File Added: 0009-Rename-for-management-operators-proposed-by-Florian-.patch
2016-10-03 21:53 Maciej Izak File Added: 0010-Fix-for-small-compiling-issue-small-mistake-during-m.patch
2016-10-03 21:53 Maciej Izak File Added: 0011-Adjustment-for-new-interface-for-DefineAsmSymbol-cha.patch
2016-10-03 21:53 Maciej Izak File Added: 0012-New-define-FPC_HAS_MANAGEMENT_OPERATORS.patch
2016-10-03 21:53 Maciej Izak File Added: 0013-Create-indirect-symbol-fo-record-RTTI-to-initrtti-st.patch
2016-10-03 21:54 Maciej Izak File Added: 0014-Invoke-management-operators-even-for-records-with-si.patch
2016-10-03 21:54 Maciej Izak File Added: 0015-Speed-up-SetLength-if-record-is-not-managed-has-no-m.patch
2016-10-09 14:57 Maciej Izak File Added: 0001-typinfo.pp-Small-correction-more-proper-declaration-.patch
2016-10-21 20:48 Florian Note Added: 0095248
2016-10-21 21:19 Maciej Izak Note Added: 0095249
2016-10-22 11:30 Florian Note Added: 0095253
2016-10-22 17:37 Maciej Izak Note Added: 0095264
2016-10-22 22:54 Florian Note Added: 0095267
2016-10-23 11:58 Maciej Izak File Added: 0001-Use-more-readable-FPC_HAS_MANAGEMENT_OPERATORS-inste.patch
2016-10-23 11:58 Maciej Izak Note Added: 0095271
2016-11-01 13:17 Jonas Maebe Note Added: 0095445
2016-11-21 01:57 Maciej Izak File Added: mo-patch-final.zip
2016-11-21 02:18 Maciej Izak Note Added: 0096093
2016-11-21 15:14 delfion Note Added: 0096101
2016-11-21 15:43 Maciej Izak Note Added: 0096102
2016-11-21 15:50 Maciej Izak Note Added: 0096103
2016-11-21 15:51 Maciej Izak Note Edited: 0096102 View Revisions
2016-11-21 19:22 delfion Note Added: 0096106
2016-11-27 21:04 Florian Note Added: 0096313
2016-12-08 11:07 Jonas Maebe Relationship added related to 0031081
2016-12-08 11:17 Maciej Izak Note Added: 0096592
2016-12-08 11:45 Jonas Maebe Relationship deleted related to 0031081
2016-12-08 12:39 Maciej Izak Note Edited: 0096592 View Revisions
2016-12-14 00:04 Sven Barth Note Added: 0096759
2016-12-15 09:47 Maciej Izak Note Added: 0096799
2017-02-28 13:17 Michael Van Canneyt Status new => resolved
2017-02-28 13:17 Michael Van Canneyt Fixed in Version => 3.1.1
2017-02-28 13:17 Michael Van Canneyt Resolution open => fixed
2017-02-28 13:17 Michael Van Canneyt Assigned To => Maciej Izak
2017-02-28 13:17 Michael Van Canneyt Target Version => 3.2.0
2017-02-28 13:17 Marco van de Voort Note Added: 0098507
2017-02-28 13:17 Marco van de Voort Assigned To Maciej Izak => Marco van de Voort
2017-02-28 13:17 Marco van de Voort Fixed in Version 3.1.1 =>
2017-02-28 13:17 Marco van de Voort Target Version 3.2.0 =>
2017-02-28 14:43 Maciej Izak Note Added: 0098510
2017-02-28 14:43 Maciej Izak Status resolved => closed
2017-02-28 14:43 Maciej Izak Target Version => 3.2.0