mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 10:09:20 +02:00
* 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 -
This commit is contained in:
parent
cd70b38e8b
commit
92c389aaeb
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -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
|
||||||
|
@ -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
|
{ only for implicit and internal typecasts in tp/delphi }
|
||||||
(is_currency(def_from) and
|
if (([cdo_explicit,cdo_internal] * cdoptions <> [cdo_explicit]) or
|
||||||
(s64currencytype.def.deftype = floatdef)) then
|
([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
tests/webtbf/tw4778a.pp
Normal file
21
tests/webtbf/tw4778a.pp
Normal file
@ -0,0 +1,21 @@
|
|||||||
|
{ %fail }
|
||||||
|
|
||||||
|
{ Source provided for Free Pascal Bug Report 4778 }
|
||||||
|
{ Submitted by "Phil H." on 2006-02-06 }
|
||||||
|
{ e-mail: pjhess@purdue.edu }
|
||||||
|
program Test1;
|
||||||
|
|
||||||
|
{$mode delphi}
|
||||||
|
|
||||||
|
var
|
||||||
|
AnInt : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
|
||||||
|
AnInt := 1;
|
||||||
|
|
||||||
|
// WriteLn(Single(AnInt));
|
||||||
|
|
||||||
|
WriteLn(Double(AnInt));
|
||||||
|
|
||||||
|
end.
|
20
tests/webtbs/tw4778.pp
Normal file
20
tests/webtbs/tw4778.pp
Normal file
@ -0,0 +1,20 @@
|
|||||||
|
{ Source provided for Free Pascal Bug Report 4778 }
|
||||||
|
{ Submitted by "Phil H." on 2006-02-06 }
|
||||||
|
{ e-mail: pjhess@purdue.edu }
|
||||||
|
program Test1;
|
||||||
|
|
||||||
|
{$mode delphi}
|
||||||
|
|
||||||
|
var
|
||||||
|
AnInt : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
|
||||||
|
AnInt := 1;
|
||||||
|
|
||||||
|
if single(anint) > 0.9 then
|
||||||
|
halt(1);
|
||||||
|
|
||||||
|
// WriteLn(Double(AnInt));
|
||||||
|
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user