compiler: implement record constructors + tests

git-svn-id: trunk@23395 -

.gitattributes

@@ -10786,6 +10786,8 @@ tests/test/terecs11.pp svneol=native#text/pascal
 tests/test/terecs12.pp svneol=native#text/pascal
 tests/test/terecs13.pp svneol=native#text/pascal
 tests/test/terecs14.pp svneol=native#text/pascal
+tests/test/terecs15.pp svneol=native#text/pascal
+tests/test/terecs16.pp svneol=native#text/pascal
 tests/test/terecs2.pp svneol=native#text/pascal
 tests/test/terecs3.pp svneol=native#text/pascal
 tests/test/terecs4.pp svneol=native#text/pascal

compiler/aarch64/cpupara.pas

@@ -201,6 +201,15 @@ unit cpupara;
         sym: tsym;
         fpufield: boolean;
       begin
+        { this must be system independent safecall and record constructor result
+          is always return in param }
+        if (tf_safecall_exceptions in target_info.flags) and
+           (pd.proccalloption=pocall_safecall) or
+           ((pd.proctypeoption=potype_constructor)and is_record(def)) then
+          begin
+            result:=true;
+            exit;
+          end;
         case def.typ of
           recorddef:
             begin

compiler/arm/cpupara.pas

@@ -207,6 +207,15 @@ unit cpupara;
         sym: tsym;
         fpufield: boolean;
       begin
+        { this must be system independent safecall and record constructor result
+          is always return in param }
+        if (tf_safecall_exceptions in target_info.flags) and
+           (pd.proccalloption=pocall_safecall) or
+           ((pd.proctypeoption=potype_constructor)and is_record(def)) then
+          begin
+            result:=true;
+            exit;
+          end;
         case def.typ of
           recorddef:
             begin

compiler/avr/cpupara.pas

@@ -182,6 +182,15 @@ unit cpupara;
 
     function tavrparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
       begin
+        { this must be system independent safecall and record constructor result
+          is always return in param }
+        if (tf_safecall_exceptions in target_info.flags) and
+           (pd.proccalloption=pocall_safecall) or
+           ((pd.proctypeoption=potype_constructor)and is_record(def)) then
+          begin
+            result:=true;
+            exit;
+          end;
         case def.typ of
           recorddef:
             { this is how gcc 4.0.4 on linux seems to do it, it doesn't look like being

compiler/i386/cpupara.pas

@@ -96,8 +96,11 @@ unit cpupara;
       var
         size: longint;
       begin
+        { this must be system independent safecall and record constructor result
+          is always return in param }
         if (tf_safecall_exceptions in target_info.flags) and
-           (pd.proccalloption=pocall_safecall) then
+           (pd.proccalloption=pocall_safecall) or
+           ((pd.proctypeoption=potype_constructor)and is_record(def)) then
           begin
             result:=true;
             exit;

compiler/ncal.pas

@@ -1735,6 +1735,7 @@ implementation
       var
         selftree : tnode;
         selfdef  : tdef;
+        temp     : ttempcreatenode;
       begin
         selftree:=nil;
 
@@ -1775,7 +1776,17 @@ implementation
               else
                 begin
                   if methodpointer.nodetype=typen then
-                    selftree:=load_self_node
+                    if (methodpointer.resultdef.typ=recorddef) then
+                      begin
+                        { TSomeRecord.Constructor call. We need to allocate }
+                        { self node as a temp node of the result type       }
+                        temp:=ctempcreatenode.create(methodpointer.resultdef,methodpointer.resultdef.size,tt_persistent,false);
+                        add_init_statement(temp);
+                        add_done_statement(ctempdeletenode.create_normal_temp(temp));
+                        selftree:=ctemprefnode.create(temp);
+                      end
+                    else
+                      selftree:=load_self_node
                   else
                     selftree:=methodpointer.getcopy;
                 end;
@@ -3496,7 +3507,8 @@ implementation
            maybe_load_in_temp(methodpointer);
 
          { Create destination (temp or assignment-variable reuse) for function result if it not yet set }
-         maybe_create_funcret_node;
+         if (procdefinition.proctypeoption<>potype_constructor) then
+           maybe_create_funcret_node;
 
          { Insert the self,vmt,function result in the parameters }
          gen_hidden_parameters;

compiler/ncgcal.pas

@@ -288,7 +288,15 @@ implementation
              { update return location in callnode when this is the function
                result }
              if assigned(parasym) and
-                (vo_is_funcret in parasym.varoptions) then
+                (
+                  { for record constructor check that it is self parameter }
+                  (
+                    (vo_is_self in parasym.varoptions)and
+                    (aktcallnode.procdefinition.proctypeoption=potype_constructor)and
+                    is_record(parasym.vardef)
+                  ) or
+                  (vo_is_funcret in parasym.varoptions)
+                ) then
                location_copy(aktcallnode.location,left.location);
            end;
 
@@ -371,7 +379,7 @@ implementation
       begin
         { Check that the return location is set when the result is passed in
           a parameter }
-        if (procdefinition.proctypeoption<>potype_constructor) and
+        if ((procdefinition.proctypeoption<>potype_constructor)or is_record(resultdef)) and
            paramanager.ret_in_param(resultdef,procdefinition) then
           begin
             { self.location is set near the end of secondcallparan so it

compiler/paramgr.pas

@@ -168,8 +168,11 @@ implementation
     { true if uses a parameter as return value }
     function tparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
       begin
+        { this must be system independent safecall and record constructor result
+          is always return in param }
         if (tf_safecall_exceptions in target_info.flags) and
-           (pd.proccalloption=pocall_safecall) then
+           (pd.proccalloption=pocall_safecall) or
+           ((pd.proctypeoption=potype_constructor)and is_record(def)) then
           begin
             result:=true;
             exit;
@@ -543,18 +546,13 @@ implementation
         { Constructors return self instead of a boolean }
         if p.proctypeoption=potype_constructor then
           begin
-            if is_implicit_pointer_object_type(tdef(p.owner.defowner)) then
-              retloc.def:=tdef(p.owner.defowner)
-            else
-              retloc.def:=getpointerdef(tdef(p.owner.defowner));
-            retcgsize:=OS_ADDR;
-            retloc.intsize:=sizeof(pint);
-          end
-        else
-          begin
-            retcgsize:=def_cgsize(retloc.def);
-            retloc.intsize:=retloc.def.size;
+            retloc.def:=tdef(p.owner.defowner);
+            if not (is_implicit_pointer_object_type(retloc.def) or
+               is_record(retloc.def)) then
+              retloc.def:=getpointerdef(retloc.def);
           end;
+        retcgsize:=def_cgsize(retloc.def);
+        retloc.intsize:=retloc.def.size;
         retloc.size:=retcgsize;
         { Return is passed as var parameter }
         if ret_in_param(retloc.def,p) then

compiler/ptype.pas

@@ -687,8 +687,6 @@ implementation
               end;
             _CONSTRUCTOR :
               begin
-                if not is_classdef then
-                  Message(parser_e_no_constructor_in_records);
                 if not is_classdef and (current_structdef.symtable.currentvisibility <> vis_public) then
                   Message(parser_w_constructor_should_be_public);
 

compiler/x86_64/cpupara.pas

@@ -623,8 +623,11 @@ unit cpupara;
         classes: tx64paraclasses;
         numclasses: longint;
       begin
+        { this must be system independent safecall and record constructor result
+          is always return in param }
         if (tf_safecall_exceptions in target_info.flags) and
-           (pd.proccalloption=pocall_safecall) then
+           (pd.proccalloption=pocall_safecall) or
+           ((pd.proctypeoption=potype_constructor)and is_record(def)) then
           begin
             result:=true;
             exit;

tests/test/terecs15.pp

@@ -0,0 +1,73 @@
+program terecs15;
+
+{$mode delphi}
+
+type
+
+  { TRec }
+
+  TRec = record
+  private
+    X: Integer;
+    Y: Integer;
+  public
+    // delphi does not allow constructors without arguments
+    constructor CreateAndTest;
+    constructor Create; overload;
+    constructor Create(AX, AY: Integer); overload;
+    constructor Create(AY: Integer); overload;
+  end;
+
+{ TRec }
+
+constructor TRec.CreateAndTest;
+begin
+  X := 1;
+  if X <> 1 then
+    halt(1);
+  Y := 2;
+  if Y <> 2 then
+    halt(2);
+end;
+
+constructor TRec.Create;
+begin
+  X := 10;
+  Y := 20;
+end;
+
+constructor TRec.Create(AX, AY: Integer);
+begin
+  X := AX;
+  Y := AY;
+end;
+
+constructor TRec.Create(AY: Integer);
+begin
+  Create;
+  Y := AY;
+end;
+
+procedure TestRec(R: TRec; ExpectedX, ExpectedY: Integer; ErrorX, ErrorY: Integer);
+begin
+  if R.X <> ExpectedX then
+    halt(ErrorX);
+  if R.Y <> ExpectedY then
+    halt(ErrorY);
+end;
+
+var
+  R: TRec;
+begin
+  R.CreateAndTest;
+  R := TRec.Create;
+  if R.X <> 10 then
+    halt(3);
+  if R.Y <> 20 then
+    halt(4);
+  TestRec(TRec.Create(1, 2), 1, 2, 5, 6);
+  TestRec(TRec.Create(2), 10, 2, 7, 8);
+  // delphi has an internal error here
+  TestRec(R.Create, 10, 20, 9, 10);
+end.
+

tests/test/terecs16.pp

@@ -0,0 +1,29 @@
+program terecs16;
+
+{$mode delphi}
+type
+  TRec = record
+    l: longint;
+    constructor Create;
+  end;
+
+
+var
+  r: TRec;
+
+  constructor TRec.Create;
+  begin
+    r.l := 4;
+    if l <> 0 then
+      halt(1);
+    l := 5;
+    if r.l <> 4 then
+      halt(2);
+    r.l := 6;
+  end;
+
+begin
+  r := TRec.Create;
+  if r.l <> 5 then
+    halt(3);
+end.