From 719c29cf869c473f3c2e03228338f3a41b3d9f04 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sun, 16 Dec 2007 22:22:11 +0000
Subject: [PATCH]   + new cpo_openequalisexact parameter comparison option
 which     treats equal open arrays, open strings and arrays of const    
 (implicitly also open) as exactly matching (since you      cannot declare
 such types on their own, so they will      never match exactly)   * require
 that forward declared procedures match the     implementation exactly for
 both the parameters (with     the above modification) and result type (mantis
     #10425 and the related webtbf/tw10425a.pp)

git-svn-id: trunk@9484 -
---
 .gitattributes           |  2 ++
 compiler/defcmp.pas      | 14 +++++++--
 compiler/pdecsub.pas     | 19 ++++--------
 tests/webtbf/tw10425a.pp | 27 ++++++++++++++++
 tests/webtbs/tw10425.pp  | 66 ++++++++++++++++++++++++++++++++++++++++
 5 files changed, 113 insertions(+), 15 deletions(-)
 create mode 100644 tests/webtbf/tw10425a.pp
 create mode 100644 tests/webtbs/tw10425.pp

diff --git a/.gitattributes b/.gitattributes
index 00fd05b485..234d550f91 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -7470,6 +7470,7 @@ tests/webtbf/tw0890a.pp svneol=native#text/plain
 tests/webtbf/tw0893.pp svneol=native#text/plain
 tests/webtbf/tw0896.pp svneol=native#text/plain
 tests/webtbf/tw0896a.pp svneol=native#text/plain
+tests/webtbf/tw10425a.pp svneol=native#text/plain
 tests/webtbf/tw1157a.pp svneol=native#text/plain
 tests/webtbf/tw1238.pp svneol=native#text/plain
 tests/webtbf/tw1251a.pp svneol=native#text/plain
@@ -7805,6 +7806,7 @@ tests/webtbs/tw10320.pp svneol=native#text/plain
 tests/webtbs/tw10350.pp svneol=native#text/plain
 tests/webtbs/tw10371.pp svneol=native#text/plain
 tests/webtbs/tw1041.pp svneol=native#text/plain
+tests/webtbs/tw10425.pp svneol=native#text/plain
 tests/webtbs/tw1044.pp svneol=native#text/plain
 tests/webtbs/tw1046.pp svneol=native#text/plain
 tests/webtbs/tw1050.pp svneol=native#text/plain
diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas
index 16482c478e..1de11238c6 100644
--- a/compiler/defcmp.pas
+++ b/compiler/defcmp.pas
@@ -34,7 +34,7 @@ interface
      type
        { if acp is cp_all the var const or nothing are considered equal }
        tcompare_paras_type = ( cp_none, cp_value_equal_const, cp_all,cp_procvar);
-       tcompare_paras_option = (cpo_allowdefaults,cpo_ignorehidden,cpo_allowconvert,cpo_comparedefaultvalue);
+       tcompare_paras_option = (cpo_allowdefaults,cpo_ignorehidden,cpo_allowconvert,cpo_comparedefaultvalue,cpo_openequalisexact);
        tcompare_paras_options = set of tcompare_paras_option;
 
        tcompare_defs_option = (cdo_internal,cdo_explicit,cdo_check_operator,cdo_allow_variant,cdo_parameter);
@@ -1517,7 +1517,7 @@ implementation
                 { both must be hidden }
                 if (vo_is_hidden_para in currpara1.varoptions)<>(vo_is_hidden_para in currpara2.varoptions) then
                   exit;
-                eq:=te_equal;
+                eq:=te_exact;
                 if not(vo_is_self in currpara1.varoptions) and
                    not(vo_is_self in currpara2.varoptions) then
                  begin
@@ -1566,6 +1566,16 @@ implementation
               { check type }
               if eq=te_incompatible then
                 exit;
+              { open arrays can never match exactly, since you cannot define }
+              { a separate "open array" type -> we have to be able to        }
+              { consider those as exact when resolving forward definitions.  }
+              { The same goes for openstrings and array of const             }
+              if (is_open_array(currpara1.vardef) or
+                  is_array_of_const(currpara1.vardef) or
+                  is_open_string(currpara1.vardef)) and
+                 (eq=te_equal) and
+                 (cpo_openequalisexact in cpoptions) then
+                eq:=te_exact;
               if eq<lowesteq then
                 lowesteq:=eq;
               { also check default value if both have it declared }
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index 1955f40fe3..046c8e0c1d 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -2529,15 +2529,8 @@ const
               { check arguments, we need to check only the user visible parameters. The hidden parameters
                 can be in a different location because of the calling convention, eg. L-R vs. R-L order (PFV) }
               (
-               (compare_paras(currpd.paras,fwpd.paras,cp_none,[cpo_comparedefaultvalue,cpo_ignorehidden])>=te_equal) and
-               { for operators equal_paras is not enough !! }
-               ((currpd.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
-                { be careful here, equal_defs doesn't take care of unique }
-                (fwpd.returndef=currpd.returndef) or
-                (equal_defs(fwpd.returndef,currpd.returndef) and
-                 not(df_unique in fwpd.returndef.defoptions) and not(df_unique in currpd.returndef.defoptions)
-                )
-               )
+               (compare_paras(currpd.paras,fwpd.paras,cp_none,[cpo_comparedefaultvalue,cpo_ignorehidden,cpo_openequalisexact])=te_exact) and
+               (fwpd.returndef=currpd.returndef)
               ) then
              begin
                { Check if we've found the forwarddef, if found then
@@ -2549,9 +2542,9 @@ const
 
                    if not(m_repeat_forward in current_settings.modeswitches) and
                       (fwpd.proccalloption<>currpd.proccalloption) then
-                     paracompopt:=[cpo_ignorehidden,cpo_comparedefaultvalue]
+                     paracompopt:=[cpo_ignorehidden,cpo_comparedefaultvalue,cpo_openequalisexact]
                    else
-                     paracompopt:=[cpo_comparedefaultvalue];
+                     paracompopt:=[cpo_comparedefaultvalue,cpo_openequalisexact];
 
                    { Check calling convention }
                    if (fwpd.proccalloption<>currpd.proccalloption) then
@@ -2588,8 +2581,8 @@ const
                      also the parameters must match also with the type }
                    if ((m_repeat_forward in current_settings.modeswitches) or
                        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
+                      ((compare_paras(currpd.paras,fwpd.paras,cp_all,paracompopt)<>te_exact) or
+                       (fwpd.returndef<>currpd.returndef)) then
                      begin
                        MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
                                    fwpd.fullprocname(false));
diff --git a/tests/webtbf/tw10425a.pp b/tests/webtbf/tw10425a.pp
new file mode 100644
index 0000000000..ec2b0ff114
--- /dev/null
+++ b/tests/webtbf/tw10425a.pp
@@ -0,0 +1,27 @@
+{ %norun }
+{ %fail }
+
+unit tw10425a;
+
+{$mode delphi}
+
+interface
+
+type
+  TFloat      = double;
+  TPoint2D    = record x,y:TFloat; end;
+  TRectangle  = array [1..2] of TPoint2D;
+
+  TPoint2DArray  = array of TPoint2D;
+  TPolygon2D     = array of TPoint2D;
+  
+  function AABB:TPoint2DArray; overload;
+
+implementation
+
+function AABB:TPolygon2D;
+begin
+end;
+
+end.
+
diff --git a/tests/webtbs/tw10425.pp b/tests/webtbs/tw10425.pp
new file mode 100644
index 0000000000..96909ee0e8
--- /dev/null
+++ b/tests/webtbs/tw10425.pp
@@ -0,0 +1,66 @@
+{ %norun }
+
+unit tw10425;
+
+{$mode delphi}
+
+interface
+
+type
+  TFloat      = double;
+  TPoint2D    = record x,y:TFloat; end;
+  TRectangle  = array [1..2] of TPoint2D;
+
+  TPoint2DArray  = array of TPoint2D;
+  TPolygon2D     = array of TPoint2D;
+  
+  function AABB(const Polygon   : TPolygon2D   ):TRectangle; overload;
+  function AABB(const Curve     : TPoint2DArray):TRectangle; overload;
+
+implementation
+
+function AABB(const Polygon : TPolygon2D):TRectangle;
+var
+  i  : Integer;
+begin
+  Result[1].x := Polygon[0].x;
+  Result[1].y := Polygon[0].y;
+  Result[2].x := Polygon[0].x;
+  Result[2].y := Polygon[0].y;
+  for i := 1 to Length(Polygon) - 1 do
+  begin
+    if Polygon[i].x < Result[1].x then
+      Result[1].x := Polygon[i].x
+    else if Polygon[i].x > Result[2].x then
+      Result[2].x := Polygon[i].x;
+    if Polygon[i].y < Result[1].y then
+      Result[1].y := Polygon[i].y
+    else if Polygon[i].y > Result[2].y then
+      Result[2].y := Polygon[i].y;
+  end;
+end;
+
+function AABB(const Curve : TPoint2DArray):TRectangle;
+var
+  i  : Integer;
+begin
+  Result[1].x := Curve[0].x;
+  Result[1].y := Curve[0].y;
+  Result[2].x := Curve[0].x;
+  Result[2].y := Curve[0].y;
+  for i := 1 to Length(Curve) - 1 do
+  begin
+    if Curve[i].x < Result[1].x then
+      Result[1].x := Curve[i].x
+    else if Curve[i].x > Result[2].x then
+      Result[2].x := Curve[i].x;
+    if Curve[i].y < Result[1].y then
+      Result[1].y := Curve[i].y
+    else if Curve[i].y > Result[2].y then
+      Result[2].y := Curve[i].y;
+  end;
+end;
+
+
+end.
+