diff options
Diffstat (limited to 'gcc/fortran/decl.c')
| -rw-r--r-- | gcc/fortran/decl.c | 64 |
1 files changed, 42 insertions, 22 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index a089be4..e4e41cb 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2951,6 +2951,14 @@ gfc_match_implicit_none (void) char name[GFC_MAX_SYMBOL_LEN + 1]; bool type = false; bool external = false; + locus cur_loc = gfc_current_locus; + + if (gfc_current_ns->seen_implicit_none + || gfc_current_ns->has_implicit_none_export) + { + gfc_error ("Duplicate IMPLICIT NONE statement at %C"); + return MATCH_ERROR; + } gfc_gobble_whitespace (); c = gfc_peek_ascii_char (); @@ -2959,27 +2967,35 @@ gfc_match_implicit_none (void) (void) gfc_next_ascii_char (); if (!gfc_notify_std (GFC_STD_F2015, "IMPORT NONE with spec list at %C")) return MATCH_ERROR; - for(;;) + + gfc_gobble_whitespace (); + if (gfc_peek_ascii_char () == ')') { - m = gfc_match (" %n", name); - if (m != MATCH_YES) - return MATCH_ERROR; + (void) gfc_next_ascii_char (); + type = true; + } + else + for(;;) + { + m = gfc_match (" %n", name); + if (m != MATCH_YES) + return MATCH_ERROR; - if (strcmp (name, "type") == 0) - type = true; - else if (strcmp (name, "external") == 0) - external = true; - else - return MATCH_ERROR; + if (strcmp (name, "type") == 0) + type = true; + else if (strcmp (name, "external") == 0) + external = true; + else + return MATCH_ERROR; - gfc_gobble_whitespace (); - c = gfc_next_ascii_char (); - if (c == ',') - continue; - if (c == ')') - break; - return MATCH_ERROR; - } + gfc_gobble_whitespace (); + c = gfc_next_ascii_char (); + if (c == ',') + continue; + if (c == ')') + break; + return MATCH_ERROR; + } } else type = true; @@ -2987,7 +3003,7 @@ gfc_match_implicit_none (void) if (gfc_match_eos () != MATCH_YES) return MATCH_ERROR; - gfc_set_implicit_none (type, external); + gfc_set_implicit_none (type, external, &cur_loc); return MATCH_YES; } @@ -3140,8 +3156,8 @@ gfc_match_implicit (void) { /* We may have <TYPE> (<RANGE>). */ gfc_gobble_whitespace (); - c = gfc_next_ascii_char (); - if ((c == '\n') || (c == ',')) + c = gfc_peek_ascii_char (); + if (c == ',' || c == '\n' || c == ';' || c == '!') { /* Check for CHARACTER with no length parameter. */ if (ts.type == BT_CHARACTER && !ts.u.cl) @@ -3155,6 +3171,10 @@ gfc_match_implicit (void) /* Record the Successful match. */ if (!gfc_merge_new_implicit (&ts)) return MATCH_ERROR; + if (c == ',') + c = gfc_next_ascii_char (); + else if (gfc_match_eos () == MATCH_ERROR) + goto error; continue; } @@ -3190,7 +3210,7 @@ gfc_match_implicit (void) gfc_gobble_whitespace (); c = gfc_next_ascii_char (); - if ((c != '\n') && (c != ',')) + if (c != ',' && gfc_match_eos () != MATCH_YES) goto syntax; if (!gfc_merge_new_implicit (&ts)) |