2
0
Эх сурвалжийг харах

* fixed web bug #4778 (explicit type casting of float to int in tp/delphi
keeps the bit pattern instead of converting)

git-svn-id: trunk@2509 -

Jonas Maebe 19 жил өмнө
parent
commit
92c389aaeb

+ 2 - 0
.gitattributes

@@ -5992,6 +5992,7 @@ tests/webtbf/tw4737.pp svneol=native#text/plain
 tests/webtbf/tw4757.pp svneol=native#text/plain
 tests/webtbf/tw4757.pp svneol=native#text/plain
 tests/webtbf/tw4764.pp svneol=native#text/plain
 tests/webtbf/tw4764.pp svneol=native#text/plain
 tests/webtbf/tw4777.pp svneol=native#text/plain
 tests/webtbf/tw4777.pp svneol=native#text/plain
+tests/webtbf/tw4778a.pp svneol=native#text/plain
 tests/webtbf/tw4781a.pp svneol=native#text/plain
 tests/webtbf/tw4781a.pp svneol=native#text/plain
 tests/webtbf/tw4781b.pp svneol=native#text/plain
 tests/webtbf/tw4781b.pp svneol=native#text/plain
 tests/webtbf/uw0744.pp svneol=native#text/plain
 tests/webtbf/uw0744.pp svneol=native#text/plain
@@ -6725,6 +6726,7 @@ tests/webtbs/tw4675.pp svneol=native#text/plain
 tests/webtbs/tw4700.pp svneol=native#text/plain
 tests/webtbs/tw4700.pp svneol=native#text/plain
 tests/webtbs/tw4763.pp svneol=native#text/plain
 tests/webtbs/tw4763.pp svneol=native#text/plain
 tests/webtbs/tw4768.pp -text
 tests/webtbs/tw4768.pp -text
+tests/webtbs/tw4778.pp svneol=native#text/plain
 tests/webtbs/tw4789.pp svneol=native#text/plain
 tests/webtbs/tw4789.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain

+ 6 - 3
compiler/defcmp.pas

@@ -478,9 +478,12 @@ implementation
                case def_from.deftype of
                case def_from.deftype of
                  orddef :
                  orddef :
                    begin { ordinal to real }
                    begin { ordinal to real }
-                     if is_integer(def_from) or
-                        (is_currency(def_from) and
-                         (s64currencytype.def.deftype = floatdef)) then
+                     { only for implicit and internal typecasts in tp/delphi }
+                     if (([cdo_explicit,cdo_internal] * cdoptions <> [cdo_explicit]) or
+                         ([m_tp7,m_delphi] * aktmodeswitches = [])) and
+                        (is_integer(def_from) or
+                         (is_currency(def_from) and
+                          (s64currencytype.def.deftype = floatdef))) then
                        begin
                        begin
                          doconv:=tc_int_2_real;
                          doconv:=tc_int_2_real;
                          eq:=te_convert_l1;
                          eq:=te_convert_l1;

+ 21 - 0
tests/webtbf/tw4778a.pp

@@ -0,0 +1,21 @@
+{ %fail }
+
+{ Source provided for Free Pascal Bug Report 4778 }
+{ Submitted by "Phil H." on  2006-02-06 }
+{ e-mail: [email protected] }
+program Test1;
+
+{$mode delphi}
+
+var
+  AnInt : Integer;
+  
+begin
+
+  AnInt := 1;
+  
+//  WriteLn(Single(AnInt));
+
+  WriteLn(Double(AnInt));
+  
+end.

+ 20 - 0
tests/webtbs/tw4778.pp

@@ -0,0 +1,20 @@
+{ Source provided for Free Pascal Bug Report 4778 }
+{ Submitted by "Phil H." on  2006-02-06 }
+{ e-mail: [email protected] }
+program Test1;
+
+{$mode delphi}
+
+var
+  AnInt : Integer;
+  
+begin
+
+  AnInt := 1;
+  
+  if single(anint) > 0.9 then
+    halt(1);
+
+//  WriteLn(Double(AnInt));
+  
+end.