diff options
Diffstat (limited to 'gcc/fortran/decl.c')
| -rw-r--r-- | gcc/fortran/decl.c | 91 |
1 files changed, 62 insertions, 29 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 0da9cd2..e9b7651 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2720,7 +2720,7 @@ match_attr_spec (void) case 'b': /* Try and match the bind(c). */ - m = gfc_match_bind_c (NULL); + m = gfc_match_bind_c (NULL, true); if (m == MATCH_YES) d = DECL_IS_BIND_C; else if (m == MATCH_ERROR) @@ -3508,7 +3508,7 @@ gfc_match_bind_c_stmt (void) curr_binding_label[0] = '\0'; /* Look for the bind(c). */ - found_match = gfc_match_bind_c (NULL); + found_match = gfc_match_bind_c (NULL, true); if (found_match == MATCH_YES) { @@ -3870,6 +3870,7 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result) match is_result; /* Found result clause. */ match found_match; /* Status of whether we've found a good match. */ int peek_char; /* Character we're going to peek at. */ + bool allow_binding_name; /* Initialize to having found nothing. */ found_match = MATCH_NO; @@ -3880,6 +3881,13 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result) gfc_gobble_whitespace (); peek_char = gfc_peek_char (); + /* C binding names are not allowed for internal procedures. */ + if (gfc_current_state () == COMP_CONTAINS + && sym->ns->proc_name->attr.flavor != FL_MODULE) + allow_binding_name = false; + else + allow_binding_name = true; + switch (peek_char) { case 'r': @@ -3888,7 +3896,7 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result) if (is_result == MATCH_YES) { /* Now see if there is a bind(c) after it. */ - is_bind_c = gfc_match_bind_c (sym); + is_bind_c = gfc_match_bind_c (sym, allow_binding_name); /* We've found the result clause and possibly bind(c). */ found_match = MATCH_YES; } @@ -3898,7 +3906,7 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result) break; case 'b': /* Look for bind(c) first. */ - is_bind_c = gfc_match_bind_c (sym); + is_bind_c = gfc_match_bind_c (sym, allow_binding_name); if (is_bind_c == MATCH_YES) { /* Now see if a result clause followed it. */ @@ -3919,13 +3927,15 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result) if (is_bind_c == MATCH_YES) { + /* Fortran 2008 draft allows BIND(C) for internal procedures. */ 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; - } + && sym->ns->proc_name->attr.flavor != FL_MODULE + && gfc_notify_std (GFC_STD_GNU, "Extension: BIND(C) attribute at %L " + "may not be specified for an internal procedure", + &gfc_current_locus) + == FAILURE) + return MATCH_ERROR; + if (gfc_add_is_bind_c (&(sym->attr), sym->name, &gfc_current_locus, 1) == FAILURE) return MATCH_ERROR; @@ -4453,7 +4463,9 @@ gfc_match_entry (void) if (m != MATCH_YES) return MATCH_ERROR; - is_bind_c = gfc_match_bind_c (entry); + /* Call gfc_match_bind_c with allow_binding_name = true as ENTRY can + never be an internal procedure. */ + is_bind_c = gfc_match_bind_c (entry, true); if (is_bind_c == MATCH_ERROR) return MATCH_ERROR; if (is_bind_c == MATCH_YES) @@ -4573,6 +4585,7 @@ gfc_match_subroutine (void) match m; match is_bind_c; char peek_char; + bool allow_binding_name; if (gfc_current_state () != COMP_NONE && gfc_current_state () != COMP_INTERFACE @@ -4616,11 +4629,18 @@ gfc_match_subroutine (void) gfc_error_now ("BIND(C) attribute at %L can only be used for " "variables or common blocks", &gfc_current_locus); } - + + /* C binding names are not allowed for internal procedures. */ + if (gfc_current_state () == COMP_CONTAINS + && sym->ns->proc_name->attr.flavor != FL_MODULE) + allow_binding_name = false; + else + allow_binding_name = true; + /* Here, we are just checking if it has the bind(c) attribute, and if so, then we need to make sure it's all correct. If it doesn't, we still need to continue matching the rest of the subroutine line. */ - is_bind_c = gfc_match_bind_c (sym); + is_bind_c = gfc_match_bind_c (sym, allow_binding_name); if (is_bind_c == MATCH_ERROR) { /* There was an attempt at the bind(c), but it was wrong. An @@ -4631,13 +4651,15 @@ gfc_match_subroutine (void) if (is_bind_c == MATCH_YES) { + /* The following is allowed in the Fortran 2008 draft. */ 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; - } + && sym->ns->proc_name->attr.flavor != FL_MODULE + && gfc_notify_std (GFC_STD_GNU, "Extension: BIND(C) attribute at " + "%L may not be specified for an internal procedure", + &gfc_current_locus) + == FAILURE) + return MATCH_ERROR; + if (peek_char != '(') { gfc_error ("Missing required parentheses before BIND(C) at %C"); @@ -4669,10 +4691,11 @@ gfc_match_subroutine (void) MATCH_ERROR if it is a BIND(C) clause but an error was encountered, or MATCH_YES if the specifier was correct and the binding label and bind(c) fields were set correctly for the given symbol or the - current_ts. */ + current_ts. If allow_binding_name is false, no binding name may be + given. */ match -gfc_match_bind_c (gfc_symbol *sym) +gfc_match_bind_c (gfc_symbol *sym, bool allow_binding_name) { /* binding label, if exists */ char binding_label[GFC_MAX_SYMBOL_LEN + 1]; @@ -4752,6 +4775,20 @@ gfc_match_bind_c (gfc_symbol *sym) return MATCH_ERROR; } + if (has_name_equals && !allow_binding_name) + { + gfc_error ("No binding name is allowed in BIND(C) at %C"); + return MATCH_ERROR; + } + + if (has_name_equals && sym != NULL && sym->attr.dummy) + { + gfc_error ("For dummy procedure %s, no binding name is " + "allowed in BIND(C) at %C", sym->name); + return MATCH_ERROR; + } + + /* Save the binding label to the symbol. If sym is null, we're probably matching the typespec attributes of a declaration and haven't gotten the name yet, and therefore, no symbol yet. */ @@ -4764,16 +4801,12 @@ gfc_match_bind_c (gfc_symbol *sym) else strcpy (curr_binding_label, binding_label); } - else + else if (allow_binding_name) { /* No binding label, but if symbol isn't null, we - can set the label for it here. */ - /* TODO: If the name= was given and no binding label (name=""), we simply - will let fortran mangle the symbol name as it usually would. - However, this could still let C call it if the user looked up the - symbol in the object file. Should the name set during mangling in - trans-decl.c be marked with characters that are invalid for C to - prevent this? */ + can set the label for it here. + If name="" or allow_binding_name is false, no C binding name is + created. */ if (sym != NULL && sym->name != NULL && has_name_equals == 0) strncpy (sym->binding_label, sym->name, strlen (sym->name) + 1); } |