This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[gfortran] Fix PR31471: Missing construct name in END and related bugs



Hi,


this patch fixes PR31471, where we would allow the
forall-construct-name to be omitted in a named FORALL block.  The fix
for this is the straightforward hunk to decl.c.  In it you will also
see the fix for the analogous problem with where.  Putting together
testcases I noticed, and fixed, two further problems: if an ELSEWHERE
statement in a WHERE construct without a construct name is followed by
something, we would segfault due to a NULL pointer dereference.  This
is fixed by returning an error.  The second problem is purely
cosmetic, SELECT CASE was printed in lowercase in an error message.

Built and tested on i386-darwin. New testcases included. Ok?

- Tobi

:ADDPATCH fortran:
        fortran/31471
fortran/
	* decl.c (gfc_match_end): Also check for construct name in END
	FORALL and END WERE statements.
	* match.c (match_case_eos): Use uppercase for statement name in
	error message.
	(match_elsewhere): Construct name may appear iff construct has a
	name.
testsuite/
	* gfortran.dg/block_name_1.f90: New.
	* gfortran.dg/block_name_2.f90: New.

	
Index: fortran/decl.c
===================================================================
--- fortran/decl.c	(revision 123625)
+++ fortran/decl.c	(working copy)
@@ -3324,7 +3324,8 @@ gfc_match_end (gfc_statement *st)
   if (gfc_match_eos () == MATCH_YES)
     {
 
-      if (*st != ST_ENDDO && *st != ST_ENDIF && *st != ST_END_SELECT)
+      if (*st != ST_ENDDO && *st != ST_ENDIF && *st != ST_END_SELECT
+	  && *st != ST_END_FORALL && *st != ST_END_WHERE)
 	return MATCH_YES;
 
       if (gfc_current_block () == NULL)
Index: fortran/match.c
===================================================================
--- fortran/match.c	(revision 123625)
+++ fortran/match.c	(working copy)
@@ -3053,7 +3053,7 @@ match_case_eos (void)
      should have matched the EOS.  */
   if (!gfc_current_block ())
     {
-      gfc_error ("Expected the name of the select case construct at %C");
+      gfc_error ("Expected the name of the SELECT CASE construct at %C");
       return MATCH_ERROR;
     }
 
@@ -3299,7 +3299,14 @@ gfc_match_elsewhere (void)
     }
 
   if (gfc_match_eos () != MATCH_YES)
-    {				/* Better be a name at this point */
+    {
+      /* Only makes sense if we have a where-construct-name.  */
+      if (!gfc_current_block ())
+	{
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+      /* Better be a name at this point */
       m = gfc_match_name (name);
       if (m == MATCH_NO)
 	goto syntax;
Index: testsuite/gfortran.dg/block_name_1.f90
===================================================================
--- testsuite/gfortran.dg/block_name_1.f90	(revision 0)
+++ testsuite/gfortran.dg/block_name_1.f90	(revision 0)
@@ -0,0 +1,78 @@
+! { dg-do compile }
+! Verify that the compiler accepts the various legal combinations of
+! using construct names.
+!
+! The correct behavior of EXIT and CYCLE is already established in
+! the various DO related testcases, they're included here for
+! completeness.
+       dimension a(5)
+       i = 0
+       ! construct name is optional on else clauses
+       ia: if (i > 0) then
+          i = 1
+       else
+          i = 2
+       end if ia
+       ib: if (i < 0) then
+          i = 3
+       else ib
+          i = 4
+       end if ib
+       ic: if (i < 0) then
+          i = 5
+       else if (i == 0) then ic
+          i = 6
+       else if (i == 1) then
+          i =7
+       else if (i == 2) then ic
+          i = 8
+       end if ic
+
+       fa: forall (i=1:5, a(i) > 0)
+          a(i) = 9
+       end forall fa
+
+       wa: where (a > 0)
+          a = -a
+       elsewhere
+          wb: where (a == 0)
+             a = a + 1.
+          elsewhere wb
+             a = 2*a
+          end where wb
+       end where wa
+
+       j = 1
+       sa: select case (i)
+          case (1)
+             i = 2
+          case (2) sa
+             i = 3
+          case default sa
+             sb: select case (j)
+                case (1) sb
+                   i = j
+                case default
+                   j = i
+             end select sb
+       end select sa
+
+       da: do i=1,10
+          cycle da
+          cycle
+          exit da
+          exit
+          db: do
+             cycle da
+             cycle db
+             cycle
+             exit da
+             exit db
+             exit
+             j = i+1
+          end do db
+          dc: do while (j>0)
+             j = j-1
+          end do dc
+       end do da
+end
Index: testsuite/gfortran.dg/block_name_2.f90
===================================================================
--- testsuite/gfortran.dg/block_name_2.f90	(revision 0)
+++ testsuite/gfortran.dg/block_name_2.f90	(revision 0)
@@ -0,0 +1,60 @@
+! { dg-do compile }
+! Test that various illegal combinations of block statements with
+! block names yield the correct error messages.  Motivated by PR31471.
+program blocks
+  dimension a(5,2)
+
+  a = 0
+
+  ! The END statement of a labelled block needs to carry the construct
+  ! name.
+  d1: do i=1,10
+  end do      ! { dg-error "Expected block name of .... in END DO statement" }
+  end do d1
+
+  i1: if (i > 0) then
+  end if      ! { dg-error "Expected block name of .... in END IF statement" }
+  end if i1
+
+  s1: select case (i)
+  end select ! { dg-error "Expected block name of .... in END SELECT statement" }
+  end select s1
+
+  w1: where (a > 0)
+  end where ! { dg-error "Expected block name of .... in END WHERE statement" }
+  end where w1
+
+  f1: forall (i = 1:10)
+  end forall ! { dg-error "Expected block name of .... in END FORALL statement" }
+  end forall f1
+
+  ! A construct name may not appear in the END statement, if it
+  ! doesn't appear in the statement beginning the block.
+  ! Likewise it may not appear in ELSE IF, ELSE, ELSEWHERE or CASE
+  ! statements.
+  do i=1,10
+  end do d2 ! { dg-error "Syntax error in END DO statement" }
+  end do
+
+  if (i > 0) then
+  else if (i ==0) then i2 ! { dg-error "Unexpected junk after ELSE IF statement" }
+  else i2 ! { dg-error "Unexpected junk after ELSE statement" }
+  end if i2 ! { dg-error "Syntax error in END IF statement" }
+  end if
+
+  select case (i)
+  case (1) s2  ! { dg-error "Expected the name of the SELECT CASE construct" }
+  case default s2 ! { dg-error "Expected the name of the SELECT CASE construct" }
+  end select s2 ! { dg-error "Syntax error in END SELECT statement" }
+  end select
+
+  where (a > 0)
+  elsewhere w2  ! { dg-error "Unexpected junk after ELSE statement" }
+  end where w2 ! { dg-error "Syntax error in END WHERE statement" }
+  end where
+
+  forall (i=1:10)
+  end forall f2 ! { dg-error "Syntax error in END FORALL statement" }
+  end forall
+  
+end program blocks

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]