The attached patch implements the checks required by
constraint C1206 from Fortran 2008 standard. Built
and regression tested on x86_64-*-freebsd. OK to
commmit?
2015-11-13 Steven G. Kargl <[email protected]>
PR fortran/68319
* decl.c (gfc_match_data, gfc_match_entry): Enforce F2008:C1206.
* io.c (gfc_match_format): Ditto.
* match.c (gfc_match_st_function): Ditto.
2015-11-13 Steven G. Kargl <[email protected]>
PR fortran/68319
* gfortran.dg/pr68319.f90: New test.
--
Steve
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 230336)
+++ gcc/fortran/decl.c (working copy)
@@ -552,6 +552,15 @@ gfc_match_data (void)
gfc_data *new_data;
match m;
+ /* Before parsing the rest of a DATA statement, check F2008:c1206. */
+ if ((gfc_current_state () == COMP_FUNCTION
+ || gfc_current_state () == COMP_SUBROUTINE)
+ && gfc_state_stack->previous->state == COMP_INTERFACE)
+ {
+ gfc_error ("DATA statement at %C cannot appear within an INTERFACE");
+ return MATCH_ERROR;
+ }
+
set_in_match_data (true);
for (;;)
@@ -5767,6 +5776,13 @@ gfc_match_entry (void)
return MATCH_ERROR;
}
+ if ((state == COMP_SUBROUTINE || state == COMP_FUNCTION)
+ && gfc_state_stack->previous->state == COMP_INTERFACE)
+ {
+ gfc_error ("ENTRY statement at %C cannot appear within an INTERFACE");
+ return MATCH_ERROR;
+ }
+
module_procedure = gfc_current_ns->parent != NULL
&& gfc_current_ns->parent->proc_name
&& gfc_current_ns->parent->proc_name->attr.flavor
Index: gcc/fortran/io.c
===================================================================
--- gcc/fortran/io.c (revision 230336)
+++ gcc/fortran/io.c (working copy)
@@ -1199,6 +1199,15 @@ gfc_match_format (void)
return MATCH_ERROR;
}
+ /* Before parsing the rest of a FORMAT statement, check F2008:c1206. */
+ if ((gfc_current_state () == COMP_FUNCTION
+ || gfc_current_state () == COMP_SUBROUTINE)
+ && gfc_state_stack->previous->state == COMP_INTERFACE)
+ {
+ gfc_error ("FORMAT statement at %C cannot appear within an INTERFACE");
+ return MATCH_ERROR;
+ }
+
if (gfc_statement_label == NULL)
{
gfc_error ("Missing format label at %C");
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c (revision 230336)
+++ gcc/fortran/match.c (working copy)
@@ -4913,6 +4913,15 @@ gfc_match_st_function (void)
sym->value = expr;
+ if ((gfc_current_state () == COMP_FUNCTION
+ || gfc_current_state () == COMP_SUBROUTINE)
+ && gfc_state_stack->previous->state == COMP_INTERFACE)
+ {
+ gfc_error ("Statement function at %L cannot appear within an INTERFACE",
+ &expr->where);
+ return MATCH_ERROR;
+ }
+
if (!gfc_notify_std (GFC_STD_F95_OBS, "Statement function at %C"))
return MATCH_ERROR;
Index: gcc/testsuite/gfortran.dg/pr68319.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr68319.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr68319.f90 (working copy)
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! PR fortran/68319
+!
+subroutine foo
+
+ interface
+
+ real function bar(i)
+ f(i) = 2 * i ! { dg-error "cannot appear within" }
+ end function bar
+
+ real function bah(j)
+ entry boo(j) ! { dg-error "cannot appear within" }
+ end function bah
+
+ real function fu(j)
+ data i /1/ ! { dg-error "cannot appear within" }
+ end function fu
+
+ real function fee(j)
+10 format('(A)') ! { dg-error "cannot appear within" }
+ end function fee
+
+ end interface
+
+end subroutine foo
