[PATCH] fortran/25106 -- Statement labels are nonzero.

Steve Kargl sgk@troutmask.apl.washington.edu
Sun Nov 27 20:39:00 GMT 2005


On Sun, Nov 27, 2005 at 08:54:43AM -0800, Steve Kargl wrote:
> The attach patch has been bootstrapped and regression 
> tested on i386-*-freebsd for mainline.  I'm currently
> bootstrap and regtesting on amd64-*-freebsd on both
> 4.1 and mainline.  OK for 4.1 and mainline once amd64
> completes.
> 
> Here's the problem.
> 
> kargl[206] cat jvm1.f90 
> 0 CONTINUE
> END
> kargl[205] gfc41 -o z jvm1.f90
>  In file jvm1.f90:1
> 
> 0 CONTINUE
> 1
> Warning: Ignoring statement label of zero at (1)
>  In file jvm1.f90:2
> 
> END
>   1
>  Internal Error at (1):
>  free_expr0(): Bad expr type
> 

New patch.  I checked F66, F77, F95, and F2003 standard.  A statement
label must be nonzero.  Bootstrap and regtested on i386-*-freebsd.

2005-11-27  Steven G. Kargl  <kargls@comcast.net>

	PR fortran/25106
 	* match.c (gfc_match_st_label):  Eliminate second argument,
	improve warning/error handling;
	(gfc_match_small_int,gfc_match,gfc_match_do,gfc_match_goto):
	Update function calls.
	* match.h (gfc_match_st_label): Update prototype.
	* io.c (match_dt_format): Update function call.
	* parse.c (next_free): Update function calls; Eliminate warning.
	* primary.c (gfc_match_actual_arglist): Update function call.

2005-11-27  Steven G. Kargl  <kargls@comcast.net>

	PR fortran/25106
	gfortran.dg/statement_label_1.f90: New tests.

-- 
Steve
-------------- next part --------------
Index: io.c
===================================================================
--- io.c	(revision 107569)
+++ io.c	(working copy)
@@ -1590,7 +1590,7 @@ match_dt_format (gfc_dt * dt)
       return MATCH_YES;
     }
 
-  if (gfc_match_st_label (&label, 0) == MATCH_YES)
+  if (gfc_match_st_label (&label) == MATCH_YES)
     {
       if (dt->format_expr != NULL || dt->format_label != NULL)
 	{
Index: match.c
===================================================================
--- match.c	(revision 107569)
+++ match.c	(working copy)
@@ -217,7 +217,7 @@ gfc_match_small_int (int *value)
    do most of the work.  */
 
 match
-gfc_match_st_label (gfc_st_label ** label, int allow_zero)
+gfc_match_st_label (gfc_st_label ** label)
 {
   locus old_loc;
   match m;
@@ -229,13 +229,17 @@ gfc_match_st_label (gfc_st_label ** labe
   if (m != MATCH_YES)
     return m;
 
-  if (((i == 0) && allow_zero) || i <= 99999)
+  if (i == 0)
+    gfc_error_now ("Statement label at %C must be nonzero");
+
+  if (i <= 99999)
     {
       *label = gfc_get_st_label (i);
       return MATCH_YES;
     }
 
   gfc_error ("Statement label at %C is out of range");
+
   gfc_current_locus = old_loc;
   return MATCH_ERROR;
 }
@@ -690,7 +694,7 @@ loop:
 
 	case 'l':
 	  label = va_arg (argp, gfc_st_label **);
-	  n = gfc_match_st_label (label, 0);
+	  n = gfc_match_st_label (label);
 	  if (n != MATCH_YES)
 	    {
 	      m = n;
@@ -1242,7 +1246,7 @@ gfc_match_do (void)
   if (gfc_match (" do") != MATCH_YES)
     return MATCH_NO;
 
-  m = gfc_match_st_label (&label, 0);
+  m = gfc_match_st_label (&label);
   if (m == MATCH_ERROR)
     goto cleanup;
 
@@ -1275,7 +1279,7 @@ gfc_match_do (void)
   gfc_match_label ();		/* This won't error */
   gfc_match (" do ");		/* This will work */
 
-  gfc_match_st_label (&label, 0);	/* Can't error out */
+  gfc_match_st_label (&label);	/* Can't error out */
   gfc_match_char (',');		/* Optional comma */
 
   m = gfc_match_iterator (&iter, 0);
@@ -1585,7 +1589,7 @@ gfc_match_goto (void)
 
       do
 	{
-	  m = gfc_match_st_label (&label, 0);
+	  m = gfc_match_st_label (&label);
 	  if (m != MATCH_YES)
 	    goto syntax;
 
@@ -1631,7 +1635,7 @@ gfc_match_goto (void)
 
   do
     {
-      m = gfc_match_st_label (&label, 0);
+      m = gfc_match_st_label (&label);
       if (m != MATCH_YES)
 	goto syntax;
 
Index: match.h
===================================================================
--- match.h	(revision 107569)
+++ match.h	(working copy)
@@ -41,7 +41,7 @@ extern gfc_st_label *gfc_statement_label
 match gfc_match_space (void);
 match gfc_match_eos (void);
 match gfc_match_small_literal_int (int *);
-match gfc_match_st_label (gfc_st_label **, int);
+match gfc_match_st_label (gfc_st_label **);
 match gfc_match_label (void);
 match gfc_match_small_int (int *);
 int gfc_match_strings (mstring *);
Index: parse.c
===================================================================
--- parse.c	(revision 107569)
+++ parse.c	(working copy)
@@ -318,7 +318,7 @@ next_free (void)
   if (ISDIGIT (c))
     {
       /* Found a statement label?  */
-      m = gfc_match_st_label (&gfc_statement_label, 0);
+      m = gfc_match_st_label (&gfc_statement_label);
 
       d = gfc_peek_char ();
       if (m != MATCH_YES || !gfc_is_whitespace (d))
@@ -334,13 +334,6 @@ next_free (void)
       else
 	{
 	  label_locus = gfc_current_locus;
-
-	  if (gfc_statement_label->value == 0)
-	    {
-	      gfc_warning_now ("Ignoring statement label of zero at %C");
-	      gfc_free_st_label (gfc_statement_label);
-	      gfc_statement_label = NULL;
-	    }
 
 	  gfc_gobble_whitespace ();
 
Index: primary.c
===================================================================
--- primary.c	(revision 107569)
+++ primary.c	(working copy)
@@ -1474,7 +1474,7 @@ gfc_match_actual_arglist (int sub_flag, 
 
       if (sub_flag && gfc_match_char ('*') == MATCH_YES)
 	{
-	  m = gfc_match_st_label (&label, 0);
+	  m = gfc_match_st_label (&label);
 	  if (m == MATCH_NO)
 	    gfc_error ("Expected alternate return label at %C");
 	  if (m != MATCH_YES)
-------------- next part --------------
! { dg-do compile }
! PR 25106
program z
0 continue    ! { dg-error "Statement label at" }
end program z


More information about the Fortran mailing list