* 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:
Jonas Maebe 2010-02-10 16:35:37 +00:00
parent d60e1f674c
commit 6b0a0c149b
4 changed files with 63 additions and 1 deletions

2
.gitattributes vendored
View File

@ -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

View File

@ -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
View 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
View 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.