From 82a0749970fbece154b1d8b9159ab1c9e758fce4 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Wed, 31 Oct 2007 17:20:37 +0000
Subject: [PATCH]   * prefer non-matching orddef conversions to
 orddef-to-pointer conversions     (mantis #10002) and also to orddef-to-real
 conversions     (delphi-compatible). More tests and fixes will follow later.

git-svn-id: trunk@9015 -
---
 .gitattributes          |  1 +
 compiler/defcmp.pas     |  8 ++---
 compiler/htypechk.pas   | 71 +++++++++++++++++++++++------------------
 compiler/ncnv.pas       |  3 +-
 compiler/symconst.pas   |  7 ++--
 tests/webtbs/tw10002.pp | 31 ++++++++++++++++++
 6 files changed, 82 insertions(+), 39 deletions(-)
 create mode 100644 tests/webtbs/tw10002.pp

diff --git a/.gitattributes b/.gitattributes
index 98ea17e397..74cb00f604 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -7599,6 +7599,7 @@ tests/webtbs/tw0961.pp svneol=native#text/plain
 tests/webtbs/tw0965.pp svneol=native#text/plain
 tests/webtbs/tw0966.pp svneol=native#text/plain
 tests/webtbs/tw0976.pp svneol=native#text/plain
+tests/webtbs/tw10002.pp svneol=native#text/plain
 tests/webtbs/tw10009.pp svneol=native#text/plain
 tests/webtbs/tw10013.pp svneol=native#text/plain
 tests/webtbs/tw10072.pp svneol=native#text/plain
diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas
index 80179b9162..d1d893dce3 100644
--- a/compiler/defcmp.pas
+++ b/compiler/defcmp.pas
@@ -252,7 +252,7 @@ implementation
                           eq:=te_incompatible
                         else if (not is_in_limit(def_from,def_to)) then
                           { "punish" bad type conversions :) (JM) }
-                          eq:=te_convert_l3
+                          eq:=te_convert_l2
                          else
                           eq:=te_convert_l1;
                       end;
@@ -505,7 +505,7 @@ implementation
                           (s64currencytype.typ = floatdef))) then
                        begin
                          doconv:=tc_int_2_real;
-                         eq:=te_convert_l1;
+                         eq:=te_convert_l3;
                        end
                      else if is_currency(def_from)
                              { and (s64currencytype.typ = orddef)) } then
@@ -528,7 +528,7 @@ implementation
                                 (m_delphi in current_settings.modeswitches)) then
                            begin
                              doconv:=tc_real_2_real;
-                             { do we loose precision? }
+                             { do we lose precision? }
                              if def_to.size<def_from.size then
                                eq:=te_convert_l2
                              else
@@ -906,7 +906,7 @@ implementation
                          if (m_delphi in current_settings.modeswitches) and is_integer(def_from) then
                           begin
                             doconv:=tc_cord_2_pointer;
-                            eq:=te_convert_l2;
+                            eq:=te_convert_l4;
                           end;
                       end;
                      { allow explicit typecasts from ordinals to pointer.
diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index 6770e0999e..e4271d2662 100644
--- a/compiler/htypechk.pas
+++ b/compiler/htypechk.pas
@@ -48,6 +48,7 @@ interface
          cl1_count,
          cl2_count,
          cl3_count,
+         cl4_count,
          coper_count : integer; { should be signed }
          ordinal_distance : double;
          invalid     : boolean;
@@ -1895,6 +1896,7 @@ implementation
                           ' l1: '+tostr(hp^.cl1_count)+
                           ' l2: '+tostr(hp^.cl2_count)+
                           ' l3: '+tostr(hp^.cl3_count)+
+                          ' l4: '+tostr(hp^.cl4_count)+
                           ' oper: '+tostr(hp^.coper_count)+
                           ' ord: '+realtostr(hp^.ordinal_distance));
               { Print parameters in left-right order }
@@ -2127,6 +2129,8 @@ implementation
                   inc(hp^.cl2_count);
                 te_convert_l3 :
                   inc(hp^.cl3_count);
+                te_convert_l4 :
+                  inc(hp^.cl4_count);
                 te_convert_operator :
                   inc(hp^.coper_count);
                 te_incompatible :
@@ -2252,39 +2256,44 @@ implementation
            res:=(bestpd^.coper_count-currpd^.coper_count);
            if (res=0) then
             begin
-              { less cl3 parameters? }
-              res:=(bestpd^.cl3_count-currpd^.cl3_count);
+              { less cl4 parameters? }
+              res:=(bestpd^.cl4_count-currpd^.cl4_count);
               if (res=0) then
                begin
-                 { less cl2 parameters? }
-                 res:=(bestpd^.cl2_count-currpd^.cl2_count);
-                 if (res=0) then
-                  begin
-                    { less cl1 parameters? }
-                    res:=(bestpd^.cl1_count-currpd^.cl1_count);
-                    if (res=0) then
-                     begin
-                       { more exact parameters? }
-                       res:=(currpd^.exact_count-bestpd^.exact_count);
-                       if (res=0) then
-                        begin
-                          { less equal parameters? }
-                          res:=(bestpd^.equal_count-currpd^.equal_count);
-                          if (res=0) then
-                           begin
-                             { smaller ordinal distance? }
-                             if (currpd^.ordinal_distance<bestpd^.ordinal_distance) then
-                              res:=1
-                             else
-                              if (currpd^.ordinal_distance>bestpd^.ordinal_distance) then
-                               res:=-1
-                             else
-                              res:=0;
-                           end;
-                        end;
-                     end;
-                  end;
-               end;
+                { less cl3 parameters? }
+                res:=(bestpd^.cl3_count-currpd^.cl3_count);
+                if (res=0) then
+                 begin
+                   { less cl2 parameters? }
+                   res:=(bestpd^.cl2_count-currpd^.cl2_count);
+                   if (res=0) then
+                    begin
+                      { less cl1 parameters? }
+                      res:=(bestpd^.cl1_count-currpd^.cl1_count);
+                      if (res=0) then
+                       begin
+                         { more exact parameters? }
+                         res:=(currpd^.exact_count-bestpd^.exact_count);
+                         if (res=0) then
+                          begin
+                            { less equal parameters? }
+                            res:=(bestpd^.equal_count-currpd^.equal_count);
+                            if (res=0) then
+                             begin
+                               { smaller ordinal distance? }
+                               if (currpd^.ordinal_distance<bestpd^.ordinal_distance) then
+                                res:=1
+                               else
+                                if (currpd^.ordinal_distance>bestpd^.ordinal_distance) then
+                                 res:=-1
+                               else
+                                res:=0;
+                             end;
+                          end;
+                       end;
+                    end;
+                 end;
+              end;
             end;
          end;
         is_better_candidate:=res;
diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas
index 1bfbf28960..819d2e3c9b 100644
--- a/compiler/ncnv.pas
+++ b/compiler/ncnv.pas
@@ -1714,7 +1714,8 @@ implementation
 
               te_convert_l1,
               te_convert_l2,
-              te_convert_l3 :
+              te_convert_l3,
+              te_convert_l4:
                 begin
                   result := simplify;
                   if assigned(result) then
diff --git a/compiler/symconst.pas b/compiler/symconst.pas
index adc003fb32..2d93743afa 100644
--- a/compiler/symconst.pas
+++ b/compiler/symconst.pas
@@ -433,8 +433,9 @@ type
   tequaltype = (
     te_incompatible,
     te_convert_operator,
-    te_convert_l3,     { compatible conversion with possible loss of data }
-    te_convert_l2,     { compatible less prefered conversion }
+    te_convert_l4,     { and yet even less preferred conversion }
+    te_convert_l3,     { even less preferred conversion (possibly with loss of data) }
+    te_convert_l2,     { compatible less preferred conversion }
     te_convert_l1,     { compatible conversion     }
     te_equal,          { the definitions are equal }
     te_exact
@@ -492,7 +493,7 @@ const
      );
 
      EqualTypeName : array[tequaltype] of string[16] = (
-       'incompatible','convert_operator','convert_l3','convert_l2',
+       'incompatible','convert_operator','convert_l4','convert_l3','convert_l2',
        'convert_l1','equal','exact'
      );
 
diff --git a/tests/webtbs/tw10002.pp b/tests/webtbs/tw10002.pp
new file mode 100644
index 0000000000..6b990b5a3c
--- /dev/null
+++ b/tests/webtbs/tw10002.pp
@@ -0,0 +1,31 @@
+program OverloadMistaken;
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+type _ulong = Cardinal;
+
+TCCC = class
+public
+    constructor Create(Size: _ulong=0); overload;
+    constructor Create(Buffer: Pointer); overload;
+end;
+
+constructor TCCC.Create(Size: _ulong);
+begin
+	inherited Create;
+	WriteLn('TCCC.Create(Size: _ulong) called.');
+end;
+
+constructor TCCC.Create(Buffer: Pointer);
+begin
+ halt(1);
+end;
+
+var c: TCCC;
+l: longint;
+begin
+	c := TCCC.Create(20);
+	c := TCCC.Create(l);
+end.