* converted range checking for open arrays/array of const from the code

    generator to the typecheck pass, so that it also works for platforms
    that use the parentfpstruct way to handle accesses to nested frames
    in case the array has been migrated to such a parentfpstruct
   o additionally, the number of comparisons for such range checks
     has been reduced from 3 (for signed indices) or 2 (for unsigned
     indices) to 1 in all cases
   o the range checking code is disabled for the JVM target, as the
     JVM automatically range checks all array accesses itself anyway

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@34034 3ad0048d-3df7-0310-abae-a5850022a9f2

5 files changed, 136 insertions, 0 deletions

diff --git a/tests/webtbs/tw8975b.pp b/tests/webtbs/tw8975b.pp
new file mode 100644
index 0000000000..4a33af1255
--- /dev/null
+++ b/tests/webtbs/tw8975b.pp
@@ -0,0 +1,38 @@
+{ %opt=-CRriot -O-2 -Ooregvar }
+
+{Internal FPC2.1.4 error, compile with fpc -B -dDebug -O3}
+procedure bug(var b: array of longint);
+var
+  l: longint;
+
+  procedure intern;
+  begin
+    if (b[l] <> 1) then {Fatal: Internal error 200409241}
+      halt(1);
+    inc(b[l]);
+    if (b[l] <> 2) then {Fatal: Internal error 200409241}
+      halt(2);
+
+    if (b[l+1] <> 2) then {Fatal: Internal error 200409241}
+      halt(3);
+    if (b[l+2] <> 3) then {Fatal: Internal error 200409241}
+      halt(4);
+    if (b[low(b)] <> 2) then {Fatal: Internal error 200409241}
+      halt(5);
+    if (b[low(b)+1] <> 2) then {Fatal: Internal error 200409241}
+      halt(6);
+    if (b[low(b)+2] <> 3) then {Fatal: Internal error 200409241}
+      halt(7);
+  end;
+begin
+  l:=0;
+  intern;
+end;
+
+const
+  a: array[1..3] of longint = (1,2,3);
+begin
+  bug(a);
+end.
+
+
diff --git a/tests/webtbs/tw8975c.pp b/tests/webtbs/tw8975c.pp
new file mode 100644
index 0000000000..22e24d8d17
--- /dev/null
+++ b/tests/webtbs/tw8975c.pp
@@ -0,0 +1,25 @@
+{ %opt=-CRriot -O-2 -Ooregvar }
+{ %result=201 }
+
+{Internal FPC2.1.4 error, compile with fpc -B -dDebug -O3}
+procedure bug(var b: array of longint);
+var
+  l: longint;
+
+  procedure intern;
+  begin
+    if (b[l] <> 1) then {Fatal: Internal error 200409241}
+      halt(1);
+  end;
+begin
+  l:=-1;
+  intern;
+end;
+
+const
+  a: array[1..3] of longint = (1,2,3);
+begin
+  bug(a);
+end.
+
+
diff --git a/tests/webtbs/tw8975d.pp b/tests/webtbs/tw8975d.pp
new file mode 100644
index 0000000000..9992da650d
--- /dev/null
+++ b/tests/webtbs/tw8975d.pp
@@ -0,0 +1,25 @@
+{ %opt=-CRriot -O-2 -Ooregvar }
+{ %result=201 }
+
+{Internal FPC2.1.4 error, compile with fpc -B -dDebug -O3}
+procedure bug(var b: array of longint);
+var
+  l: longint;
+
+  procedure intern;
+  begin
+    if (b[l] <> 1) then {Fatal: Internal error 200409241}
+      halt(1);
+  end;
+begin
+  l:=3;
+  intern;
+end;
+
+const
+  a: array[1..3] of longint = (1,2,3);
+begin
+  bug(a);
+end.
+
+
diff --git a/tests/webtbs/tw8975e.pp b/tests/webtbs/tw8975e.pp
new file mode 100644
index 0000000000..eabdfee848
--- /dev/null
+++ b/tests/webtbs/tw8975e.pp
@@ -0,0 +1,22 @@
+{ %opt=-CRriot -O-2 -Ooregvar }
+{ %fail }
+
+{Internal FPC2.1.4 error, compile with fpc -B -dDebug -O3}
+procedure bug(var b: array of longint);
+
+  procedure intern;
+  begin
+    if (b[low(b)-1] <> 1) then {Fatal: Internal error 200409241}
+      halt(1);
+  end;
+begin
+  intern;
+end;
+
+const
+  a: array[1..3] of longint = (1,2,3);
+begin
+  bug(a);
+end.
+
+
diff --git a/tests/webtbs/tw8975f.pp b/tests/webtbs/tw8975f.pp
new file mode 100644
index 0000000000..0cbc09b42b
--- /dev/null
+++ b/tests/webtbs/tw8975f.pp
@@ -0,0 +1,26 @@
+{ %opt=-CRriot -O-2 -Ooregvar }
+{ %result=201 }
+
+{Internal FPC2.1.4 error, compile with fpc -B -dDebug -O3}
+procedure bug(var b: array of longint);
+var
+  l: int64;
+
+  procedure intern;
+  begin
+    if (b[l] <> 1) then {Fatal: Internal error 200409241}
+      halt(1);
+  end;
+begin
+  { ensure the top bits are also checked and not truncated }
+  l:=int64(1) shl 32 + 1;
+  intern;
+end;
+
+const
+  a: array[1..3] of longint = (1,2,3);
+begin
+  bug(a);
+end.
+
+