diff options
| -rw-r--r-- | compiler/defcmp.pas | 14 | ||||
| -rw-r--r-- | compiler/pdecsub.pas | 19 | ||||
| -rw-r--r-- | tests/webtbf/tw10425a.pp | 27 | ||||
| -rw-r--r-- | tests/webtbs/tw10425.pp | 66 |
4 files changed, 111 insertions, 15 deletions
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. + |