From 01f4fff18bd3d72903ac6b0d9a3d9b0bd9d31492 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sat, 17 Nov 2007 19:19:16 +0100 Subject: 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 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/decl.c | 22 +++++++++++++++++++--- 2 files changed, 25 insertions(+), 3 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4ed0421..b12355c 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 325d012..8217c06 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"); -- cgit v1.1