mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 01:29:29 +02:00
* don't perform a range check in Delphi mode when passing a cardinal as
vtInteger to an array-of-const parameter (mantis #15727) git-svn-id: trunk@14882 -
This commit is contained in:
parent
d60e1f674c
commit
6b0a0c149b
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -9624,6 +9624,7 @@ tests/webtbf/tw15288.pp svneol=native#text/plain
|
||||
tests/webtbf/tw15303.pp svneol=native#text/plain
|
||||
tests/webtbf/tw15391a.pp svneol=native#text/plain
|
||||
tests/webtbf/tw15447.pp svneol=native#text/plain
|
||||
tests/webtbf/tw15727b.pp svneol=native#text/plain
|
||||
tests/webtbf/tw1599.pp svneol=native#text/plain
|
||||
tests/webtbf/tw1599b.pp svneol=native#text/plain
|
||||
tests/webtbf/tw1633.pp svneol=native#text/plain
|
||||
@ -10281,6 +10282,7 @@ tests/webtbs/tw1567.pp svneol=native#text/plain
|
||||
tests/webtbs/tw15690.pp svneol=native#text/plain
|
||||
tests/webtbs/tw15693.pp svneol=native#text/plain
|
||||
tests/webtbs/tw15694.pp svneol=native#text/plain
|
||||
tests/webtbs/tw15727a.pp svneol=native#text/plain
|
||||
tests/webtbs/tw15728.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1573.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1592.pp svneol=native#text/plain
|
||||
|
@ -587,7 +587,16 @@ implementation
|
||||
begin
|
||||
if is_integer(p.resultdef) and
|
||||
not(is_64bitint(p.resultdef)) then
|
||||
p:=ctypeconvnode.create(p,s32inttype)
|
||||
if not(m_delphi in current_settings.modeswitches) then
|
||||
p:=ctypeconvnode.create(p,s32inttype)
|
||||
else
|
||||
{ delphi doesn't generate a range error when passing a
|
||||
cardinal >= $80000000, but since these are seen as
|
||||
longint on the callee side, this causes data loss;
|
||||
as a result, we require an explicit longint()
|
||||
typecast in FPC mode on the caller side if range
|
||||
checking should be disabled, but not in Delphi mode }
|
||||
p:=ctypeconvnode.create_internal(p,s32inttype)
|
||||
else if is_void(p.resultdef) then
|
||||
CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resultdef.typename)
|
||||
else if iscvarargs and is_currency(p.resultdef)
|
||||
|
25
tests/webtbf/tw15727b.pp
Normal file
25
tests/webtbf/tw15727b.pp
Normal file
@ -0,0 +1,25 @@
|
||||
{ %fail }
|
||||
|
||||
{$mode objfpc}
|
||||
{$r+}
|
||||
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
procedure test(a: array of const);
|
||||
begin
|
||||
if (a[0].vtype<>vtinteger) or
|
||||
(a[0].vinteger<>longint($f0f0f0f0)) then
|
||||
halt(1);
|
||||
end;
|
||||
|
||||
var
|
||||
z: cardinal;
|
||||
begin
|
||||
// next line produces compilation error "Error: range check error while evaluating constants"
|
||||
|
||||
// accepted now in Delphi mode, not in FPC mode because this value is
|
||||
// implicitly converted to a longint, and $f0f0f0f0 is an invalid longint
|
||||
// value (use longint($f0f0f0f0) instead)
|
||||
test([$F0F0F0F0]);
|
||||
end.
|
26
tests/webtbs/tw15727a.pp
Normal file
26
tests/webtbs/tw15727a.pp
Normal file
@ -0,0 +1,26 @@
|
||||
{$mode delphi}
|
||||
{$r+}
|
||||
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
procedure test(a: array of const);
|
||||
begin
|
||||
if (a[0].vtype<>vtinteger) or
|
||||
(a[0].vinteger<>longint($f0f0f0f0)) then
|
||||
halt(1);
|
||||
end;
|
||||
|
||||
var
|
||||
z: cardinal;
|
||||
begin
|
||||
Z:=$F0F0F0F0;
|
||||
// next line works OK
|
||||
writeln('Z=',Z);
|
||||
|
||||
// next line produces compilation error "Error: range check error while evaluating constants"
|
||||
test([$F0F0F0F0]);
|
||||
|
||||
// next line gives run-time error: "ERangeError : Range check error"
|
||||
test([Z]);
|
||||
end.
|
Loading…
Reference in New Issue
Block a user