From 11d4eddf6732dda84d3fa9aebb7e0107e1967bc2 Mon Sep 17 00:00:00 2001
From: paul <paul@idefix.freepascal.org>
Date: Mon, 13 Dec 2010 06:39:29 +0000
Subject: [PATCH] compiler: a trial to implement record constructor   - map
 self to constructor result   - don't push vmt for records

At the moment generated assembler has errors although node tree is correct

git-svn-id: branches/paul/extended_records@16560 -
---
 compiler/ncal.pas    |  4 ++++
 compiler/pdecsub.pas |  8 ++++++--
 compiler/psub.pas    | 16 +++++++++-------
 compiler/ptype.pas   |  6 +-----
 4 files changed, 20 insertions(+), 14 deletions(-)

diff --git a/compiler/ncal.pas b/compiler/ncal.pas
index 9d3161e9d0..4c71cff549 100644
--- a/compiler/ncal.pas
+++ b/compiler/ncal.pas
@@ -1652,6 +1652,10 @@ implementation
           { constructors }
           if (procdefinition.proctypeoption=potype_constructor) then
             begin
+              { for records self in constructor maps to result }
+              if (tprocdef(procdefinition).struct.typ=recorddef) then
+                selftree:=funcretnode.getcopy
+              else
               { push 0 as self when allocation is needed }
               if (methodpointer.resultdef.typ=classrefdef) or
                  (cnf_new_call in callnodeflags) then
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index 790b1c1a6e..e9a7355004 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -292,7 +292,8 @@ implementation
                 current_tokenpos:=tprocdef(pd).fileinfo;
 
                 { Generate VMT variable for constructor/destructor }
-                if (pd.proctypeoption in [potype_constructor,potype_destructor]) and not(is_cppclass(tprocdef(pd).struct)) then
+                if (pd.proctypeoption in [potype_constructor,potype_destructor]) and
+                   not(is_cppclass(tprocdef(pd).struct) or is_record(tprocdef(pd).struct)) then
                  begin
                    { can't use classrefdef as type because inheriting
                      will then always file because of a type mismatch }
@@ -313,7 +314,10 @@ implementation
                       vsp:=vs_var;
                     hdef:=tprocdef(pd).struct;
                   end;
-                vs:=tparavarsym.create('$self',paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]);
+                if is_record(tprocdef(pd).struct) and (pd.proctypeoption=potype_constructor) then
+                  vs:=tparavarsym.create('$self',paranr_self,vs_value,hdef,[vo_is_self,vo_is_hidden_para,vo_is_funcret])
+                else
+                  vs:=tparavarsym.create('$self',paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]);
                 pd.parast.insert(vs);
 
                 current_tokenpos:=storepos;
diff --git a/compiler/psub.pas b/compiler/psub.pas
index 02e979b66d..1c94a44ce8 100644
--- a/compiler/psub.pas
+++ b/compiler/psub.pas
@@ -345,16 +345,18 @@ implementation
                           ccallnode.createintern('fpc_help_constructor',para)));
                     end
                 else
-                  internalerror(200305103);
+                  if not is_record(current_structdef) then
+                    internalerror(200305103);
                 { if self=nil then exit
                   calling fail instead of exit is useless because
                   there is nothing to dispose (PFV) }
-                addstatement(newstatement,cifnode.create(
-                    caddnode.create(equaln,
-                        load_self_pointer_node,
-                        cnilnode.create),
-                    cexitnode.create(nil),
-                    nil));
+                if is_class_or_object(current_structdef) then
+                  addstatement(newstatement,cifnode.create(
+                      caddnode.create(equaln,
+                          load_self_pointer_node,
+                          cnilnode.create),
+                      cexitnode.create(nil),
+                      nil));
               end;
 
             { maybe call BeforeDestruction for classes }
diff --git a/compiler/ptype.pas b/compiler/ptype.pas
index b6691530a4..ff8a6a543a 100644
--- a/compiler/ptype.pas
+++ b/compiler/ptype.pas
@@ -764,11 +764,7 @@ implementation
                 if is_classdef then
                   pd:=class_constructor_head
                 else
-                  begin
-                    pd:=constructor_head;
-                    { raise internal error for now - constructor is not implemented yet }
-                    internalerror(201012110);
-                  end;
+                  pd:=constructor_head;
                 parse_record_proc_directives(pd);
                 handle_calling_convention(pd);