From a63ed25f74129130412c6dfceb4d32e1efa81022 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sat, 23 Dec 2006 20:53:47 +0000
Subject: [PATCH]   * fixed support for repeating constructor without
 parameters in Delphi     mode + test

git-svn-id: trunk@5692 -
---
 .gitattributes       |  1 +
 compiler/defutil.pas | 10 ++++++++++
 compiler/pdecsub.pas |  9 ++++-----
 tests/tbs/tb0518.pp  | 14 ++++++++++++++
 4 files changed, 29 insertions(+), 5 deletions(-)
 create mode 100644 tests/tbs/tb0518.pp

diff --git a/.gitattributes b/.gitattributes
index 27f2e1e65e..341375ffe6 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -6239,6 +6239,7 @@ tests/tbs/tb0514.pp svneol=native#text/plain
 tests/tbs/tb0515.pp svneol=native#text/plain
 tests/tbs/tb0516.pp svneol=native#text/plain
 tests/tbs/tb0517.pp svneol=native#text/plain
+tests/tbs/tb0518.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain
diff --git a/compiler/defutil.pas b/compiler/defutil.pas
index c5afc254b1..7b083c7f97 100644
--- a/compiler/defutil.pas
+++ b/compiler/defutil.pas
@@ -230,6 +230,9 @@ interface
     {# returns true, if the type passed is a varset }
     function is_varset(p : tdef) : boolean;
 
+    { # returns true if the procdef has no parameters and no specified return type }
+    function is_bareprocdef(pd : tprocdef): boolean;
+
 implementation
 
     uses
@@ -1018,4 +1021,11 @@ implementation
       end;
 
 
+    function is_bareprocdef(pd : tprocdef): boolean;
+      begin
+        result:=(pd.maxparacount=0) and
+                (is_void(pd.returndef) or
+                 (pd.proctypeoption = potype_constructor));
+      end;
+
 end.
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index cc30d4aba3..259c5e2ead 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -2431,7 +2431,7 @@ const
               (
                not(m_repeat_forward in current_settings.modeswitches) and
                not(currpd.forwarddef) and
-               (currpd.maxparacount=0) and
+               is_bareprocdef(currpd) and
                not(po_overload in fwpd.procoptions)
               ) or
               { check arguments, we need to check only the user visible parameters. The hidden parameters
@@ -2455,12 +2455,12 @@ const
                  begin
                    forwardfound:=true;
 
-                   if (m_repeat_forward in current_settings.modeswitches) or
+                   if not(m_repeat_forward in current_settings.modeswitches) and
                       (fwpd.proccalloption<>currpd.proccalloption) then
                      paracompopt:=[cpo_ignorehidden,cpo_comparedefaultvalue]
                    else
                      paracompopt:=[cpo_comparedefaultvalue];
-
+ 
                    { Check calling convention }
                    if (fwpd.proccalloption<>currpd.proccalloption) then
                     begin
@@ -2495,8 +2495,7 @@ const
                    { Check if the procedure type and return type are correct,
                      also the parameters must match also with the type }
                    if ((m_repeat_forward in current_settings.modeswitches) or
-                       (currpd.maxparacount<>0) or
-                       (not(is_void(currpd.returndef)))) and
+                       not is_bareprocdef(currpd)) and
                       ((compare_paras(currpd.paras,fwpd.paras,cp_all,paracompopt)<te_equal) or
                        (not equal_defs(fwpd.returndef,currpd.returndef))) then
                      begin
diff --git a/tests/tbs/tb0518.pp b/tests/tbs/tb0518.pp
new file mode 100644
index 0000000000..40be4f4ad8
--- /dev/null
+++ b/tests/tbs/tb0518.pp
@@ -0,0 +1,14 @@
+{$mode delphi}
+type
+  tc = class
+    constructor create(const n: ansistring);
+  end;
+
+constructor tc.create;
+begin
+  if (n <> 'abc') then halt(1);
+end;
+
+begin
+  tc.create('abc');
+end.