Browse Source

Expicitly disable range check on old test and add new test with and changes

git-svn-id: trunk@34012 -
pierre 9 years ago
parent
commit
40292a476f
3 changed files with 58 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 6 0
      tests/webtbs/tw22744.pp
  3. 51 0
      tests/webtbs/tw22744b.pp

+ 1 - 0
.gitattributes

@@ -14694,6 +14694,7 @@ tests/webtbs/tw22705.pp svneol=native#text/plain
 tests/webtbs/tw2274.pp svneol=native#text/plain
 tests/webtbs/tw22741.pp svneol=native#text/plain
 tests/webtbs/tw22744.pp svneol=native#text/pascal
+tests/webtbs/tw22744b.pp svneol=native#text/plain
 tests/webtbs/tw2277.pp svneol=native#text/plain
 tests/webtbs/tw22790a.pp svneol=native#text/pascal
 tests/webtbs/tw22790b.pp svneol=native#text/pascal

+ 6 - 0
tests/webtbs/tw22744.pp

@@ -1,3 +1,9 @@
+{ Original test is about $Q option only,
+  so we explicitly disabled $R,
+  adding a new tw22744b.pp }
+
+{$R-}
+
 {$mode objfpc}
 
 uses

+ 51 - 0
tests/webtbs/tw22744b.pp

@@ -0,0 +1,51 @@
+{ The original test is about $Q option only,
+  ifor which we explicitly disabled $R.
+  Here use both $Q and $R,
+  as 64-bit CPU rather generate range check errors
+  on that code. }
+
+{$mode objfpc}
+
+uses
+  sysutils;
+var
+  i,j,l : longint;
+const
+  exception_seen : boolean = false;
+
+begin
+  {$Q+,R+}
+  i:=$78000000;
+  j:=$20000000;
+  l:=i-j;
+  {$push} {$q-,r-}
+  l:=i+j; {$pop}
+  try
+  {$push} {$q-,r-}
+  l:=i+j{$pop};
+  except on E : Exception do
+    begin
+      writeln('Simple {$Pop} exception ',E.Message);
+      exception_seen:=true;
+    end;
+  end;
+  try
+  {$q-,r-} {$push}
+  l:=i+j{$q+,r+}{$push};
+  l:=0;
+  {$pop}
+  {$pop}
+  except on E : Exception do
+    begin
+      writeln('Convoluted {$Q+,R+}{$Push} Exception ',E.Message);
+      exception_seen:=true;
+    end;
+  end;
+  if exception_seen then
+    begin
+      writeln('This test failed');
+      halt(1);
+    end;
+end.
+
+