* only override "clone" for records that contain fields that require a

    deep copy, and for those records no longer call the inherited clone.
    Instead, declare a local variable of the record type, assign its
    address to the function and then copy all field contents to this local
    variable. Since it's dynamically allocated at the JVM level, it will
    survive the function exit.

    The problem with calling the inherited clone function is that it will
    copy the pointers of the implicit pointer fields (records, sets, …)
    from the old to the new instance, and that we (currently) have no way
    at the Pascal level to change those and make them point to new
    instances.

git-svn-id: branches/jvmbackend@18721 -

compiler/pjvm.pas

@@ -182,15 +182,27 @@ implementation
       var
         sstate: tscannerstate;
         pd: tprocdef;
+        sym: tsym;
+        i: longint;
       begin
         maybe_add_public_default_java_constructor(def);
         replace_scanner('record_jvm_helpers',sstate);
-        { no override, because not supported in records; the parser will still
-          accept "inherited" though }
-        if str_parse_method_dec('function clone: JLObject;',potype_function,false,def,pd) then
-          pd.synthetickind:=tsk_jvm_clone
-        else
-          internalerror(2011032806);
+        { no override, because not supported in records. Only required in case
+          some of the fields require deep copies (otherwise the default
+          shallow clone is fine) }
+        for i:=0 to def.symtable.symlist.count-1 do
+          begin
+            sym:=tsym(def.symtable.symlist[i]);
+            if (sym.typ=fieldvarsym) and
+               jvmimplicitpointertype(tfieldvarsym(sym).vardef) then
+              begin
+                if str_parse_method_dec('function clone: JLObject;',potype_function,false,def,pd) then
+                  pd.synthetickind:=tsk_jvm_clone
+                else
+                  internalerror(2011032806);
+                break;
+              end;
+          end;
         { can't use def.typesym, not yet set at this point }
         if not assigned(def.symtable.realname) then
           internalerror(2011032803);

compiler/symcreat.pas

@@ -343,21 +343,27 @@ implementation
       if (struct.typ=recorddef) and
          not assigned(struct.typesym) then
         internalerror(2011032812);
-      { the inherited clone will already copy all fields in a shallow way ->
-        copy records/regular arrays in a regular way }
-      str:='type _fpc_ptrt = ^'+struct.typesym.realname+'; begin clone:=inherited;';
+      { We can easily use the inherited clone in case we have to create a deep
+        copy of certain fields. The reason is that e.g. sets are pointers at
+        the JVM level, but not in Pascal. So the JVM clone routine will copy the
+        pointer to the set from the old record (= class instance) to the new
+        one, but we have no way to change this pointer itself from inside Pascal
+        code.
+
+        We solve this by relying on the fact that the JVM is garbage collected:
+        we simply declare a temporary instance on the stack, which will be
+        allocated/initialized by the temp generator. We return its address as
+        the result of the clone routine, so it remains live. }
+      str:='type _fpc_ptrt = ^'+struct.typesym.realname+
+        '; var __fpc_newcopy:'+ struct.typesym.realname+'; begin clone:=JLObject(@__fpc_newcopy);';
+      { copy all field contents }
       for i:=0 to struct.symtable.symlist.count-1 do
         begin
           sym:=tsym(struct.symtable.symlist[i]);
           if (sym.typ=fieldvarsym) then
             begin
               fsym:=tfieldvarsym(sym);
-              if (fsym.vardef.typ=recorddef) or
-                 ((fsym.vardef.typ=arraydef) and
-                  not is_dynamic_array(fsym.vardef)) or
-                 ((fsym.vardef.typ=setdef) and
-                  not is_smallset(fsym.vardef)) then
-                str:=str+'_fpc_ptrt(clone)^.&'+fsym.realname+':='+fsym.realname+';';
+              str:=str+'__fpc_newcopy.&'+fsym.realname+':=&'+fsym.realname+';';
             end;
         end;
       str:=str+'end;';