Ver código fonte

* 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 -

Jonas Maebe 18 anos atrás
pai
commit
82a0749970
6 arquivos alterados com 82 adições e 39 exclusões
  1. 1 0
      .gitattributes
  2. 4 4
      compiler/defcmp.pas
  3. 40 31
      compiler/htypechk.pas
  4. 2 1
      compiler/ncnv.pas
  5. 4 3
      compiler/symconst.pas
  6. 31 0
      tests/webtbs/tw10002.pp

+ 1 - 0
.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

+ 4 - 4
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.

+ 40 - 31
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;

+ 2 - 1
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

+ 4 - 3
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'
      );
 

+ 31 - 0
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.