diff options
Diffstat (limited to 'gcc/fortran/decl.c')
| -rw-r--r-- | gcc/fortran/decl.c | 89 |
1 files changed, 85 insertions, 4 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 90f30b3..9f65fe4 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2819,7 +2819,7 @@ match_attr_spec (void) DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL, DECL_PARAMETER, DECL_POINTER, DECL_PROTECTED, DECL_PRIVATE, DECL_PUBLIC, DECL_SAVE, DECL_TARGET, DECL_VALUE, DECL_VOLATILE, - DECL_IS_BIND_C, DECL_NONE, + DECL_IS_BIND_C, DECL_ASYNCHRONOUS, DECL_NONE, GFC_DECL_END /* Sentinel */ } decl_types; @@ -2864,9 +2864,25 @@ match_attr_spec (void) switch (gfc_peek_ascii_char ()) { case 'a': - if (match_string_p ("allocatable")) - d = DECL_ALLOCATABLE; - break; + gfc_next_ascii_char (); + switch (gfc_next_ascii_char ()) + { + case 'l': + if (match_string_p ("locatable")) + { + /* Matched "allocatable". */ + d = DECL_ALLOCATABLE; + } + break; + + case 's': + if (match_string_p ("ynchronous")) + { + /* Matched "asynchronous". */ + d = DECL_ASYNCHRONOUS; + } + break; + } case 'b': /* Try and match the bind(c). */ @@ -3047,6 +3063,9 @@ match_attr_spec (void) case DECL_ALLOCATABLE: attr = "ALLOCATABLE"; break; + case DECL_ASYNCHRONOUS: + attr = "ASYNCHRONOUS"; + break; case DECL_DIMENSION: attr = "DIMENSION"; break; @@ -3173,6 +3192,15 @@ match_attr_spec (void) t = gfc_add_allocatable (¤t_attr, &seen_at[d]); break; + case DECL_ASYNCHRONOUS: + if (gfc_notify_std (GFC_STD_F2003, + "Fortran 2003: ASYNCHRONOUS attribute at %C") + == FAILURE) + t = FAILURE; + else + t = gfc_add_asynchronous (¤t_attr, NULL, &seen_at[d]); + break; + case DECL_DIMENSION: t = gfc_add_dimension (¤t_attr, NULL, &seen_at[d]); break; @@ -6485,6 +6513,59 @@ syntax: } +match +gfc_match_asynchronous (void) +{ + gfc_symbol *sym; + match m; + + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ASYNCHRONOUS statement at %C") + == FAILURE) + return MATCH_ERROR; + + if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO) + { + return MATCH_ERROR; + } + + if (gfc_match_eos () == MATCH_YES) + goto syntax; + + for(;;) + { + /* ASYNCHRONOUS is special because it can be added to host-associated + symbols locally. */ + m = gfc_match_symbol (&sym, 1); + switch (m) + { + case MATCH_YES: + if (gfc_add_asynchronous (&sym->attr, sym->name, &gfc_current_locus) + == FAILURE) + return MATCH_ERROR; + goto next_item; + + case MATCH_NO: + break; + + case MATCH_ERROR: + return MATCH_ERROR; + } + + next_item: + if (gfc_match_eos () == MATCH_YES) + break; + if (gfc_match_char (',') != MATCH_YES) + goto syntax; + } + + return MATCH_YES; + +syntax: + gfc_error ("Syntax error in ASYNCHRONOUS statement at %C"); + return MATCH_ERROR; +} + + /* Match a module procedure statement. Note that we have to modify symbols in the parent's namespace because the current one was there to receive symbols that are in an interface's formal argument list. */ |