From: Tobias Burnus Date: Sat, 17 Nov 2007 18:19:16 +0000 (+0100) Subject: re PR fortran/34133 (Bind(c,name="") should be rejected for dummies; F2008: allow... X-Git-Tag: releases/gcc-4.3.0~1463 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=01f4fff18bd3d72903ac6b0d9a3d9b0bd9d31492;p=thirdparty%2Fgcc.git re PR fortran/34133 (Bind(c,name="") should be rejected for dummies; F2008: allow bind(c) for internal procs) 2007-11-17 Tobias Burnus PR fortran/34133 * decl.c (gfc_match_suffix,gfc_match_subroutine): Disallow bind(c) attribute for internal procedures. 2007-11-17 Tobias Burnus PR fortran/34133 * gfortran.dg/bind_c_usage_9.f03: New. * gfortran.dg/interface_abstract_1.f90: Fix testcase. From-SVN: r130260 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4ed0421e4dcf..b12355c729e5 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2007-11-17 Tobias Burnus + + PR fortran/34133 + * decl.c (gfc_match_suffix,gfc_match_subroutine): Disallow + bind(c) attribute for internal procedures. + 2007-11-17 Francois-Xavier Coudert PR fortran/25252 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 325d012e476f..8217c06399f2 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -3895,9 +3895,18 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result) } 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; } @@ -4553,6 +4562,13 @@ gfc_match_subroutine (void) 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"); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8fce1223608f..fcf6395b4b98 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2007-11-17 Tobias Burnus + + 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 PR fortran/25252 diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_9.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_9.f03 new file mode 100644 index 000000000000..f8682e8841cf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bind_c_usage_9.f03 @@ -0,0 +1,45 @@ +! { 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" } diff --git a/gcc/testsuite/gfortran.dg/interface_abstract_1.f90 b/gcc/testsuite/gfortran.dg/interface_abstract_1.f90 index ab816bff7a14..3b2934fd1cfe 100644 --- a/gcc/testsuite/gfortran.dg/interface_abstract_1.f90 +++ b/gcc/testsuite/gfortran.dg/interface_abstract_1.f90 @@ -1,8 +1,9 @@ ! { 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) @@ -18,4 +19,4 @@ contains subroutine sub() bind(C,name="subC") end subroutine -end +end module mod_interf_abstract