PR fortran/34133
* decl.c (gfc_match_suffix,gfc_match_subroutine): Disallow
bind(c) attribute for internal procedures.
2007-11-17 Tobias Burnus <burnus@net-b.de>
PR fortran/34133
* gfortran.dg/bind_c_usage_9.f03: New.
* gfortran.dg/interface_abstract_1.f90: Fix testcase.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@130260
138bc75d-0d04-0410-961f-
82ee72b054a4
+2007-11-17 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/34133
+ * decl.c (gfc_match_suffix,gfc_match_subroutine): Disallow
+ bind(c) attribute for internal procedures.
+
2007-11-17 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/25252
}
if (is_bind_c == MATCH_YES)
- if (gfc_add_is_bind_c (&(sym->attr), sym->name, &gfc_current_locus, 1)
- == FAILURE)
- return MATCH_ERROR;
+ {
+ if (gfc_current_state () == COMP_CONTAINS
+ && sym->ns->proc_name->attr.flavor != FL_MODULE)
+ {
+ gfc_error ("BIND(C) attribute at %L may not be specified for an "
+ "internal procedure", &gfc_current_locus);
+ return MATCH_ERROR;
+ }
+ if (gfc_add_is_bind_c (&(sym->attr), sym->name, &gfc_current_locus, 1)
+ == FAILURE)
+ return MATCH_ERROR;
+ }
return found_match;
}
if (is_bind_c == MATCH_YES)
{
+ if (gfc_current_state () == COMP_CONTAINS
+ && sym->ns->proc_name->attr.flavor != FL_MODULE)
+ {
+ gfc_error ("BIND(C) attribute at %L may not be specified for an "
+ "internal procedure", &gfc_current_locus);
+ return MATCH_ERROR;
+ }
if (peek_char != '(')
{
gfc_error ("Missing required parentheses before BIND(C) at %C");
+2007-11-17 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/34133
+ * gfortran.dg/bind_c_usage_9.f03: New.
+ * gfortran.dg/interface_abstract_1.f90: Fix testcase.
+
2007-11-17 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/25252
--- /dev/null
+! { dg-do compile }
+! PR fortran/34133
+!
+! The compiler should reject internal procedures with BIND(c) attribute.
+!
+subroutine foo() bind(c)
+contains
+ subroutine bar() bind (c) ! { dg-error "may not be specified for an internal" }
+ end subroutine bar ! { dg-error "Expected label" }
+end subroutine foo ! { dg-warning "Extension: CONTAINS statement" }
+
+subroutine foo2() bind(c)
+ use iso_c_binding
+contains
+ integer(c_int) function barbar() bind (c) ! { dg-error "may not be specified for an internal" }
+ end function barbar ! { dg-error "Expecting END SUBROUTINE" }
+end subroutine foo2 ! { dg-warning "Extension: CONTAINS statement" }
+
+function one() bind(c)
+ use iso_c_binding
+ integer(c_int) :: one
+ one = 1
+contains
+ integer(c_int) function two() bind (c) ! { dg-error "may not be specified for an internal" }
+ end function two ! { dg-error "Expected label" }
+end function one ! { dg-warning "Extension: CONTAINS statement" }
+
+function one2() bind(c)
+ use iso_c_binding
+ integer(c_int) :: one2
+ one2 = 1
+contains
+ subroutine three() bind (c) ! { dg-error "may not be specified for an internal" }
+ end function three ! { dg-error "Expected label" }
+end function one2 ! { dg-warning "Extension: CONTAINS statement" }
+
+program main
+ use iso_c_binding
+ implicit none
+contains
+ subroutine test() bind(c) ! { dg-error "may not be specified for an internal" }
+ end subroutine test ! { dg-error "Expecting END PROGRAM" }
+ function test2() bind (c) ! { dg-error "may not be specified for an internal" }
+ end function test2 ! { dg-error "Expecting END PROGRAM" }
+end program main ! { dg-warning "Extension: CONTAINS statement" }
! { dg-do compile }
!
+module mod_interf_abstract
implicit none
abstract interface :: one ! { dg-error "Syntax error in ABSTRACT INTERFACE statement" }
-end interface ! { dg-error "Expecting END PROGRAM statement" }
+end interface ! { dg-error "Expecting END MODULE statement" }
abstract interface
subroutine two() bind(C)
subroutine sub() bind(C,name="subC")
end subroutine
-end
+end module mod_interf_abstract