Browse Source

* check precision of floats for determining overload to call,
patch by Gerhard Scholz

git-svn-id: trunk@536 -

peter 20 years ago
parent
commit
f3cefd7a07
4 changed files with 61 additions and 2 deletions
  1. 1 0
      .gitattributes
  2. 11 0
      compiler/defutil.pas
  3. 31 2
      compiler/htypechk.pas
  4. 18 0
      tests/test/tover2.pp

+ 1 - 0
.gitattributes

@@ -5196,6 +5196,7 @@ tests/test/toperator3.pp svneol=native#text/plain
 tests/test/toperator4.pp svneol=native#text/plain
 tests/test/toperator5.pp svneol=native#text/plain
 tests/test/tover1.pp svneol=native#text/plain
+tests/test/tover2.pp svneol=native#text/plain
 tests/test/tpackrec.pp svneol=native#text/plain
 tests/test/tpara1.pp svneol=native#text/plain
 tests/test/tpara2.pp svneol=native#text/plain

+ 11 - 0
compiler/defutil.pas

@@ -175,6 +175,9 @@ interface
     {# Returns true, if def is an extended type }
     function is_extended(def : tdef) : boolean;
 
+    {# Returns true, if definition is a "real" real (i.e. single/double/extended) }
+    function is_real(def : tdef) : boolean;
+
     {# Returns true, if def is a 32 bit integer type }
     function is_32bitint(def : tdef) : boolean;
 
@@ -256,6 +259,14 @@ implementation
       end;
 
 
+    { returns true, if definition is a "real" real (i.e. single/double/extended) }
+    function is_real(def : tdef) : boolean;
+      begin
+        result:=(def.deftype=floatdef) and
+          (tfloatdef(def).typ in [s32real,s64real,s80real]);
+      end;
+
+
     function range_to_basetype(l,h:TConstExprInt):tbasetype;
       begin
         { prefer signed over unsigned }

+ 31 - 2
compiler/htypechk.pas

@@ -1680,8 +1680,8 @@ implementation
           while assigned(p) do
            begin
              if result<>'' then
-              result:=result+',';
-             result:=result+p.resulttype.def.typename;
+              result:=','+result;
+             result:=p.resulttype.def.typename+result;
              p:=tcallparanode(p.right);
            end;
         end;
@@ -1826,6 +1826,35 @@ implementation
                      hp^.ordinal_distance:=hp^.ordinal_distance+1.0;
                  end
               else
+              { for value and const parameters check precision of real, give
+                penalty for loosing of precision }
+               if not(currpara.varspez in [vs_var,vs_out]) and
+                  is_real(def_from) and
+                  is_real(def_to) then
+                 begin
+                   eq:=te_equal;
+                   if is_extended(def_to) then
+                     rth:=bestreal(4)
+                   else
+                     if is_double (def_to) then
+                       rth:=bestreal(2)
+                   else
+                     rth:=bestreal(1);
+                   if is_extended(def_from) then
+                     rfh:=bestreal(4)
+                   else
+                     if is_double (def_from) then
+                       rfh:=bestreal(2)
+                   else
+                     rfh:=bestreal(1);
+                   { penalty for shrinking of precision }
+                   if rth<rfh then
+                     rfh:=(rfh-rth)*16
+                   else
+                     rfh:=rth-rfh;
+                   hp^.ordinal_distance:=hp^.ordinal_distance+rfh;
+                 end
+              else
               { generic type comparision }
                begin
                  eq:=compare_defs_ext(def_from,def_to,currpt.left.nodetype,convtype,pdoper,cdoptions);

+ 18 - 0
tests/test/tover2.pp

@@ -0,0 +1,18 @@
+procedure pr(d:single);overload;
+begin
+  writeln('single');
+end;
+
+procedure pr(d:double);overload;
+begin
+  writeln('double');
+end;
+
+procedure pr(d:currency);overload;
+begin
+  writeln('currency');
+end;
+
+begin
+  pr(1.0);
+end.