Bladeren bron

* correctly handle selection between Single and Double overloads for Currency
+ added test

git-svn-id: trunk@45707 -

svenbarth 5 jaren geleden
bovenliggende
commit
52678562e3
3 gewijzigde bestanden met toevoegingen van 60 en 2 verwijderingen
  1. 1 0
      .gitattributes
  2. 14 2
      compiler/defcmp.pas
  3. 45 0
      tests/tbs/tb0675.pp

+ 1 - 0
.gitattributes

@@ -13308,6 +13308,7 @@ tests/tbs/tb0671.pp svneol=native#text/pascal
 tests/tbs/tb0672.pp svneol=native#text/pascal
 tests/tbs/tb0672.pp svneol=native#text/pascal
 tests/tbs/tb0673.pp svneol=native#text/pascal
 tests/tbs/tb0673.pp svneol=native#text/pascal
 tests/tbs/tb0674.pp svneol=native#text/pascal
 tests/tbs/tb0674.pp svneol=native#text/pascal
+tests/tbs/tb0675.pp svneol=native#text/pascal
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain

+ 14 - 2
compiler/defcmp.pas

@@ -835,7 +835,14 @@ implementation
                          { the orddef < currency (then it will get convert l3, }
                          { the orddef < currency (then it will get convert l3, }
                          { and conversion to float is favoured)                }
                          { and conversion to float is favoured)                }
                          doconv:=tc_int_2_real;
                          doconv:=tc_int_2_real;
-                         eq:=te_convert_l2;
+                         if is_extended(def_to) then
+                           eq:=te_convert_l2
+                         else if is_double(def_to) then
+                           eq:=te_convert_l3
+                         else if is_single(def_to) then
+                           eq:=te_convert_l4
+                         else
+                           eq:=te_convert_l2;
                        end;
                        end;
                    end;
                    end;
                  floatdef :
                  floatdef :
@@ -856,7 +863,12 @@ implementation
                              { do we lose precision? }
                              { do we lose precision? }
                              if (def_to.size<def_from.size) or
                              if (def_to.size<def_from.size) or
                                (is_currency(def_from) and (tfloatdef(def_to).floattype in [s32real,s64real])) then
                                (is_currency(def_from) and (tfloatdef(def_to).floattype in [s32real,s64real])) then
-                               eq:=te_convert_l2
+                               begin
+                                 if is_currency(def_from) and (tfloatdef(def_to).floattype=s32real) then
+                                   eq:=te_convert_l3
+                                 else
+                                   eq:=te_convert_l2
+                               end
                              else
                              else
                                eq:=te_convert_l1;
                                eq:=te_convert_l1;
                            end;
                            end;

+ 45 - 0
tests/tbs/tb0675.pp

@@ -0,0 +1,45 @@
+program tb0675;
+
+{$mode objfpc}
+
+function Test(a: Single): LongInt;
+begin
+  Result := 1;
+end;
+
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+function Test(a: Double): LongInt;
+begin
+  Result := 2;
+end;
+{$endif}
+
+function Test2(a: Single): LongInt;
+begin
+  Result := 1;
+end;
+
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+function Test2(a: Double): LongInt;
+begin
+  Result := 2;
+end;
+{$endif}
+
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+function Test2(a: Extended): LongInt;
+begin
+  Result := 3;
+end;
+{$endif}
+
+var
+  a: Currency;
+begin
+  if Test(a) <> 2 then
+    Halt(1);
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+  if Test2(a) <> 3 then
+    Halt(2);
+{$endif}
+end.