Ver código fonte

Merged revisions 7823-7824,7826 via svnmerge from
svn+ssh://svn.freepascal.org/FPC/svn/fpc/trunk

........
r7823 | daniel | 2007-06-26 19:23:49 +0200 (di, 26 jun 2007) | 2 lines

+ Discovered a bug regarding string bounds checking, add tests for it.

........
r7824 | daniel | 2007-06-26 19:28:21 +0200 (di, 26 jun 2007) | 2 lines

* Improve test.

........
r7826 | daniel | 2007-06-26 19:43:41 +0200 (di, 26 jun 2007) | 3 lines

* tb0201 should now succeed, move & rename it to tbs/tb0540
* Add %FAIL & %NORUN to tb0200.

........

git-svn-id: branches/fixes_2_2@7837 -

daniel 18 anos atrás
pai
commit
c6c016461c
4 arquivos alterados com 82 adições e 0 exclusões
  1. 3 0
      .gitattributes
  2. 19 0
      tests/tbf/tb0200.pp
  3. 30 0
      tests/tbf/tb0201.pp
  4. 30 0
      tests/tbs/tb0540.pp

+ 3 - 0
.gitattributes

@@ -5678,6 +5678,8 @@ tests/tbf/tb0197.pp svneol=native#text/plain
 tests/tbf/tb0198.pp svneol=native#text/plain
 tests/tbf/tb0199.pp -text
 tests/tbf/tb0199a.pp -text
+tests/tbf/tb0200.pp svneol=native#text/x-pascal
+tests/tbf/tb0201.pp svneol=native#text/x-pascal
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain
@@ -6210,6 +6212,7 @@ tests/tbs/tb0532.pp svneol=native#text/x-pascal
 tests/tbs/tb0533.pp svneol=native#text/plain
 tests/tbs/tb0534.pp svneol=native#text/plain
 tests/tbs/tb0535.pp svneol=native#text/plain
+tests/tbs/tb0540.pp svneol=native#text/x-pascal
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain

+ 19 - 0
tests/tbf/tb0200.pp

@@ -0,0 +1,19 @@
+{%NORUN}
+{%FAIL}
+program tb0200;
+
+{$H-}
+
+{TP rejects this code both with range checking off and on. However,
+ we allow indexing arrays out of bounds with range checks off, so
+ we best reject this then only with range checking on.}
+
+{$Q+,R+}
+
+var a:string;
+    c:char;
+
+begin
+  a:='';
+  c:=a[257];
+end.

+ 30 - 0
tests/tbf/tb0201.pp

@@ -0,0 +1,30 @@
+program tb0201;
+
+{$mode objfpc}
+{$H-}
+{$Q+,R+}
+
+uses sysutils;
+
+var a:string;
+    b:string[63];
+    c:char;
+    w:word;
+
+begin
+  a:='';
+  b:='';
+  w:=257;
+  try
+    c:=a[w];
+    writeln('string[255] failure');
+    halt(1);
+  except
+  end;
+  try
+    c:=b[w];
+    writeln('string[63] failure');
+    halt(2);
+  except
+  end;
+end.

+ 30 - 0
tests/tbs/tb0540.pp

@@ -0,0 +1,30 @@
+program tb0540;
+
+{$mode objfpc}
+{$H-}
+{$Q+,R+}
+
+uses sysutils;
+
+var a:string;
+    b:string[63];
+    c:char;
+    w:word;
+
+begin
+  a:='';
+  b:='';
+  w:=257;
+  try
+    c:=a[w];
+    writeln('string[255] failure');
+    halt(1);
+  except
+  end;
+  try
+    c:=b[w];
+    writeln('string[63] failure');
+    halt(2);
+  except
+  end;
+end.