paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 13:08:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@34012 -
This commit is contained in:
pierre 2016-06-21 08:14:43 +00:00
parent f079701302
commit 40292a476f
3 changed files with 58 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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
tests/webtbs/tw22744.pp
View File

@ -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
tests/webtbs/tw22744b.pp Normal file
View File

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