mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 02:27:56 +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/tw4144.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/uw0840a.pp svneol=native#text/plain
|
||||
tests/webtbf/uw0840b.pp svneol=native#text/plain
|
||||
|
@ -704,7 +704,7 @@ implementation
|
||||
{ catch specific exceptions }
|
||||
begin
|
||||
repeat
|
||||
consume(_ID);
|
||||
consume(_ON);
|
||||
if token=_ID then
|
||||
begin
|
||||
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