diff options
Diffstat (limited to 'gcc/fortran/match.c')
| -rw-r--r-- | gcc/fortran/match.c | 202 |
1 files changed, 196 insertions, 6 deletions
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index f275239..43aeb19 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -1561,6 +1561,7 @@ gfc_match_if (gfc_statement *if_type) match ("go to", gfc_match_goto, ST_GOTO) match ("if", match_arithmetic_if, ST_ARITHMETIC_IF) match ("inquire", gfc_match_inquire, ST_INQUIRE) + match ("lock", gfc_match_lock, ST_LOCK) match ("nullify", gfc_match_nullify, ST_NULLIFY) match ("open", gfc_match_open, ST_OPEN) match ("pause", gfc_match_pause, ST_NONE) @@ -1573,6 +1574,7 @@ gfc_match_if (gfc_statement *if_type) match ("sync all", gfc_match_sync_all, ST_SYNC_CALL); match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES); match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY); + match ("unlock", gfc_match_unlock, ST_UNLOCK) match ("where", match_simple_where, ST_WHERE) match ("write", gfc_match_write, ST_WRITE) @@ -2305,6 +2307,190 @@ gfc_match_error_stop (void) } +/* Match LOCK/UNLOCK statement. Syntax: + LOCK ( lock-variable [ , lock-stat-list ] ) + UNLOCK ( lock-variable [ , sync-stat-list ] ) + where lock-stat is ACQUIRED_LOCK or sync-stat + and sync-stat is STAT= or ERRMSG=. */ + +static match +lock_unlock_statement (gfc_statement st) +{ + match m; + gfc_expr *tmp, *lockvar, *acq_lock, *stat, *errmsg; + bool saw_acq_lock, saw_stat, saw_errmsg; + + tmp = lockvar = acq_lock = stat = errmsg = NULL; + saw_acq_lock = saw_stat = saw_errmsg = false; + + if (gfc_pure (NULL)) + { + gfc_error ("Image control statement SYNC at %C in PURE procedure"); + return MATCH_ERROR; + } + + if (gfc_implicit_pure (NULL)) + gfc_current_ns->proc_name->attr.implicit_pure = 0; + + if (gfc_option.coarray == GFC_FCOARRAY_NONE) + { + gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable"); + return MATCH_ERROR; + } + + if (gfc_find_state (COMP_CRITICAL) == SUCCESS) + { + gfc_error ("Image control statement SYNC at %C in CRITICAL block"); + return MATCH_ERROR; + } + + if (gfc_match_char ('(') != MATCH_YES) + goto syntax; + + if (gfc_match ("%e", &lockvar) != MATCH_YES) + goto syntax; + m = gfc_match_char (','); + if (m == MATCH_ERROR) + goto syntax; + if (m == MATCH_NO) + { + m = gfc_match_char (')'); + if (m == MATCH_YES) + goto done; + goto syntax; + } + + for (;;) + { + m = gfc_match (" stat = %v", &tmp); + if (m == MATCH_ERROR) + goto syntax; + if (m == MATCH_YES) + { + if (saw_stat) + { + gfc_error ("Redundant STAT tag found at %L ", &tmp->where); + goto cleanup; + } + stat = tmp; + saw_stat = true; + + m = gfc_match_char (','); + if (m == MATCH_YES) + continue; + + tmp = NULL; + break; + } + + m = gfc_match (" errmsg = %v", &tmp); + if (m == MATCH_ERROR) + goto syntax; + if (m == MATCH_YES) + { + if (saw_errmsg) + { + gfc_error ("Redundant ERRMSG tag found at %L ", &tmp->where); + goto cleanup; + } + errmsg = tmp; + saw_errmsg = true; + + m = gfc_match_char (','); + if (m == MATCH_YES) + continue; + + tmp = NULL; + break; + } + + m = gfc_match (" acquired_lock = %v", &tmp); + if (m == MATCH_ERROR || st == ST_UNLOCK) + goto syntax; + if (m == MATCH_YES) + { + if (saw_acq_lock) + { + gfc_error ("Redundant ACQUIRED_LOCK tag found at %L ", + &tmp->where); + goto cleanup; + } + acq_lock = tmp; + saw_acq_lock = true; + + m = gfc_match_char (','); + if (m == MATCH_YES) + continue; + + tmp = NULL; + break; + } + + break; + } + + if (m == MATCH_ERROR) + goto syntax; + + if (gfc_match (" )%t") != MATCH_YES) + goto syntax; + +done: + switch (st) + { + case ST_LOCK: + new_st.op = EXEC_LOCK; + break; + case ST_UNLOCK: + new_st.op = EXEC_UNLOCK; + break; + default: + gcc_unreachable (); + } + + new_st.expr1 = lockvar; + new_st.expr2 = stat; + new_st.expr3 = errmsg; + new_st.expr4 = acq_lock; + + return MATCH_YES; + +syntax: + gfc_syntax_error (st); + +cleanup: + gfc_free_expr (tmp); + gfc_free_expr (lockvar); + gfc_free_expr (acq_lock); + gfc_free_expr (stat); + gfc_free_expr (errmsg); + + return MATCH_ERROR; +} + + +match +gfc_match_lock (void) +{ + if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: LOCK statement at %C") + == FAILURE) + return MATCH_ERROR; + + return lock_unlock_statement (ST_LOCK); +} + + +match +gfc_match_unlock (void) +{ + if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: UNLOCK statement at %C") + == FAILURE) + return MATCH_ERROR; + + return lock_unlock_statement (ST_UNLOCK); +} + + /* Match SYNC ALL/IMAGES/MEMORY statement. Syntax: SYNC ALL [(sync-stat-list)] SYNC MEMORY [(sync-stat-list)] @@ -2345,7 +2531,7 @@ sync_statement (gfc_statement st) gfc_error ("Image control statement SYNC at %C in CRITICAL block"); return MATCH_ERROR; } - + if (gfc_match_eos () == MATCH_YES) { if (st == ST_SYNC_IMAGES) @@ -2396,6 +2582,9 @@ sync_statement (gfc_statement st) if (gfc_match_char (',') == MATCH_YES) continue; + + tmp = NULL; + break; } m = gfc_match (" errmsg = %v", &tmp); @@ -2413,16 +2602,17 @@ sync_statement (gfc_statement st) if (gfc_match_char (',') == MATCH_YES) continue; - } - gfc_gobble_whitespace (); + tmp = NULL; + break; + } - if (gfc_peek_char () == ')') break; - - goto syntax; } + if (m == MATCH_ERROR) + goto syntax; + if (gfc_match (" )%t") != MATCH_YES) goto syntax; |