[gfortran] PR 16404: Number 5 and 7

[Tobias Schlüter]

Both these programs were accepted by gfortran. Both are illegal: the
former requires a program-name, the latter is not allowed, because a
RETURN statement may not appear inside a main-program.

! test 5
PROGRAM
END

! test 7
RETURN
END

While I was touching the matchers I also added a '%' to the matcher for
BLOCK DATA, so that "BLOCk DATAgjakslg" is no longer accepted, this
completes the 'obvious' patch I posted yesterday :-/

- Tobi

2004-07-11  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>

	PR fortran/16404
	* match.c (gfc_match_program): A program name is obligatory.
	(gfc_match_return): RETURN is not allowd in main program.
	(gfc_match_block_data): A space is required before a block data
	name.

Index: match.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/match.c,v
retrieving revision 1.17
diff -u -p -r1.17 match.c
--- match.c     10 Jul 2004 22:37:15 -0000      1.17
+++ match.c     11 Jul 2004 13:27:26 -0000
@@ -791,7 +791,7 @@ not_yes:
 /*********************** Statement level matching **********************/

 /* Matches the start of a program unit, which is the program keyword
-   followed by an optional symbol.  */
+   followed by an obligatory symbol.  */

 match
 gfc_match_program (void)
@@ -799,10 +799,6 @@ gfc_match_program (void)
   gfc_symbol *sym;
   match m;

-  m = gfc_match_eos ();
-  if (m == MATCH_YES)
-    return m;
-
   m = gfc_match ("% %s%t", &sym);

   if (m == MATCH_NO)
@@ -1897,6 +1893,14 @@ gfc_match_return (void)
 {
   gfc_expr *e;
   match m;
+  gfc_compile_state s;
+
+  gfc_enclosing_unit (&s);
+  if (s == COMP_PROGRAM)
+    {
+      gfc_error ("RETURN statement at %C is not allowed in a main
program.");
+      return MATCH_ERROR;
+    }

   e = NULL;
   if (gfc_match_eos () == MATCH_YES)
@@ -2295,7 +2299,7 @@ gfc_match_block_data (void)
       return MATCH_YES;
     }

-  m = gfc_match (" %n%t", name);
+  m = gfc_match ("% %n%t", name);
   if (m != MATCH_YES)
     return MATCH_ERROR;