mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-21 05:09:31 +02:00
* exception parser checks now if the used id for the handler is really ON, fixes webbug 4256
git-svn-id: trunk@798 -
This commit is contained in:
parent
804207239d
commit
46a3f895e0
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -5496,6 +5496,7 @@ tests/webtbf/tw4111.pp svneol=native#text/plain
|
|||||||
tests/webtbf/tw4139.pp svneol=native#text/plain
|
tests/webtbf/tw4139.pp svneol=native#text/plain
|
||||||
tests/webtbf/tw4144.pp svneol=native#text/plain
|
tests/webtbf/tw4144.pp svneol=native#text/plain
|
||||||
tests/webtbf/tw4153.pp svneol=native#text/plain
|
tests/webtbf/tw4153.pp svneol=native#text/plain
|
||||||
|
tests/webtbf/tw4256.pp svneol=native#text/plain
|
||||||
tests/webtbf/uw0744.pp svneol=native#text/plain
|
tests/webtbf/uw0744.pp svneol=native#text/plain
|
||||||
tests/webtbf/uw0840a.pp svneol=native#text/plain
|
tests/webtbf/uw0840a.pp svneol=native#text/plain
|
||||||
tests/webtbf/uw0840b.pp svneol=native#text/plain
|
tests/webtbf/uw0840b.pp svneol=native#text/plain
|
||||||
|
@ -704,7 +704,7 @@ implementation
|
|||||||
{ catch specific exceptions }
|
{ catch specific exceptions }
|
||||||
begin
|
begin
|
||||||
repeat
|
repeat
|
||||||
consume(_ID);
|
consume(_ON);
|
||||||
if token=_ID then
|
if token=_ID then
|
||||||
begin
|
begin
|
||||||
objname:=pattern;
|
objname:=pattern;
|
||||||
|
52
tests/webtbf/tw4256.pp
Normal file
52
tests/webtbf/tw4256.pp
Normal file
@ -0,0 +1,52 @@
|
|||||||
|
{ %FAIL }
|
||||||
|
{ Source provided for Free Pascal Bug Report 4256 }
|
||||||
|
{ Submitted by "Gerhard" on 2005-08-04 }
|
||||||
|
{ e-mail: gs@g--s.de }
|
||||||
|
{$r+,q+,s+}
|
||||||
|
{ $r-,q-,s-}
|
||||||
|
|
||||||
|
{$mode objfpc}
|
||||||
|
|
||||||
|
PROGRAM btryon ;
|
||||||
|
|
||||||
|
USES
|
||||||
|
SysUtils ;
|
||||||
|
|
||||||
|
FUNCTION testop1 ( param1,
|
||||||
|
param2 : int64 ) : Boolean ;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
testop1 := param1 = param1 / param2 ; { just some nonsense }
|
||||||
|
END ;
|
||||||
|
|
||||||
|
PROCEDURE doit ;
|
||||||
|
|
||||||
|
VAR
|
||||||
|
s2 : STRING ;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
s2 := '' ;
|
||||||
|
TRY
|
||||||
|
TRY
|
||||||
|
WriteLn ( testop1 ( 3, 0 ) ) ;
|
||||||
|
EXCEPT
|
||||||
|
ON eintoverflow DO
|
||||||
|
s2 := 'overflow' ;
|
||||||
|
aPPLEtREE erangeerror DO
|
||||||
|
s2 := 'range error' ;
|
||||||
|
ONonONonONonONonONonONonONonONonONonONonONonOnONon edivbyzero DO
|
||||||
|
s2 := 'zdiv error' ;
|
||||||
|
________________________________________________ON einvalidop DO
|
||||||
|
s2 := 'invalid op error' ;
|
||||||
|
ELSE
|
||||||
|
s2 := 'unknown exception' ;
|
||||||
|
END ;
|
||||||
|
FINALLY ;
|
||||||
|
END ;
|
||||||
|
WriteLn ( s2 ) ;
|
||||||
|
END ;
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
doit ;
|
||||||
|
END.
|
Loading…
Reference in New Issue
Block a user