Browse Source

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

Jonas Maebe 15 years ago
parent
commit
6b0a0c149b
4 changed files with 63 additions and 1 deletions
  1. 2 0
      .gitattributes
  2. 10 1
      compiler/ncnv.pas
  3. 25 0
      tests/webtbf/tw15727b.pp
  4. 26 0
      tests/webtbs/tw15727a.pp

+ 2 - 0
.gitattributes

@@ -9624,6 +9624,7 @@ tests/webtbf/tw15288.pp svneol=native#text/plain
 tests/webtbf/tw15303.pp svneol=native#text/plain
 tests/webtbf/tw15303.pp svneol=native#text/plain
 tests/webtbf/tw15391a.pp svneol=native#text/plain
 tests/webtbf/tw15391a.pp svneol=native#text/plain
 tests/webtbf/tw15447.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/tw1599.pp svneol=native#text/plain
 tests/webtbf/tw1599b.pp svneol=native#text/plain
 tests/webtbf/tw1599b.pp svneol=native#text/plain
 tests/webtbf/tw1633.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/tw15690.pp svneol=native#text/plain
 tests/webtbs/tw15693.pp svneol=native#text/plain
 tests/webtbs/tw15693.pp svneol=native#text/plain
 tests/webtbs/tw15694.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/tw15728.pp svneol=native#text/plain
 tests/webtbs/tw1573.pp svneol=native#text/plain
 tests/webtbs/tw1573.pp svneol=native#text/plain
 tests/webtbs/tw1592.pp svneol=native#text/plain
 tests/webtbs/tw1592.pp svneol=native#text/plain

+ 10 - 1
compiler/ncnv.pas

@@ -587,7 +587,16 @@ implementation
               begin
               begin
                 if is_integer(p.resultdef) and
                 if is_integer(p.resultdef) and
                    not(is_64bitint(p.resultdef)) then
                    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
                 else if is_void(p.resultdef) then
                   CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resultdef.typename)
                   CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resultdef.typename)
                 else if iscvarargs and is_currency(p.resultdef)
                 else if iscvarargs and is_currency(p.resultdef)

+ 25 - 0
tests/webtbf/tw15727b.pp

@@ -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 - 0
tests/webtbs/tw15727a.pp

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