* exception parser checks now if the used id for the handler is really ON, fixes webbug 4256

git-svn-id: trunk@798 -

.gitattributes

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

compiler/pstatmnt.pas

@@ -704,7 +704,7 @@ implementation
                 { catch specific exceptions }
                 begin
                    repeat
-                     consume(_ID);
+                     consume(_ON);
                      if token=_ID then
                        begin
                           objname:=pattern;

tests/webtbf/tw4256.pp

@@ -0,0 +1,52 @@
+{ %FAIL }
+{ Source provided for Free Pascal Bug Report 4256 }
+{ Submitted by "Gerhard" on  2005-08-04 }
+{ e-mail: [email protected] }
+{$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.