diff options
| author | Tobias Burnus <burnus@net-b.de> | 2011-06-20 23:12:39 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2011-06-20 23:12:39 +0200 |
| commit | fea549356d388607081f1a83ebac557259314d62 (patch) | |
| tree | 712d69e7e3f4057ac1970712cd75e6aca85eeb88 /gcc/fortran/interface.c | |
| parent | 998c75b661fa518b79a33f523eb716c246cba756 (diff) | |
| download | gcc-fea549356d388607081f1a83ebac557259314d62.zip gcc-fea549356d388607081f1a83ebac557259314d62.tar.gz gcc-fea549356d388607081f1a83ebac557259314d62.tar.bz2 | |
re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])
2011-06-20 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
* gfortran.h (gfc_check_vardef_context): Update prototype.
(iso_fortran_env_symbol): Handle derived types.
(symbol_attribute): Add lock_comp.
* expr.c (gfc_check_vardef_context): Add LOCK_TYPE check.
* interface.c (compare_parameter, gfc_procedure_use): Handle
LOCK_TYPE.
(compare_actual_formal): Update
gfc_check_vardef_context call.
* check.c (gfc_check_atomic_def, gfc_check_atomic_ref): Ditto.
* intrinsic.c (check_arglist): Ditto.
* io.c (resolve_tag, gfc_resolve_dt, gfc_resolve_inquire):
* Ditto.
* iso-fortran-env.def (ISOFORTRAN_LOCK_TYPE): Add.
* intrinsic.texi (ISO_FORTRAN_ENV): Document LOCK_TYPE.
* module.c (mio_symbol_attribute): Handle lock_comp.
(create_derived_type): New function.
(use_iso_fortran_env_module): Call it to handle LOCK_TYPE.
* parse.c (parse_derived): Add constraint check for LOCK_TYPE.
* resolve.c (resolve_symbol, resolve_lock_unlock): Add
* constraint
checks for LOCK_TYPE.
(gfc_resolve_iterator, resolve_deallocate_expr,
resolve_allocate_expr, resolve_code, resolve_transfer): Update
gfc_check_vardef_context call.
* trans-stmt.h (gfc_trans_lock_unlock): New prototype.
* trans-stmt.c (gfc_trans_lock_unlock): New function.
* trans.c (trans_code): Handle LOCK and UNLOCK.
2011-06-20 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
* gfortran.dg/coarray_lock_1.f90: Update dg-error.
* gfortran.dg/coarray_lock_3.f90: New.
* gfortran.dg/coarray/lock_1.f90: New.
From-SVN: r175228
Diffstat (limited to 'gcc/fortran/interface.c')
| -rw-r--r-- | gcc/fortran/interface.c | 34 |
1 files changed, 31 insertions, 3 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index e787187..dcf6c4e 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1618,7 +1618,22 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, "contiguous", formal->name, &actual->where); return 0; } - } + + /* F2008, C1303 and C1304. */ + if (formal->attr.intent != INTENT_INOUT + && (((formal->ts.type == BT_DERIVED || formal->ts.type == BT_CLASS) + && formal->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV + && formal->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE) + || formal->attr.lock_comp)) + + { + if (where) + gfc_error ("Actual argument to non-INTENT(INOUT) dummy '%s' at %L, " + "which is LOCK_TYPE or has a LOCK_TYPE component", + formal->name, &actual->where); + return 0; + } + } /* F2008, C1239/C1240. */ if (actual->expr_type == EXPR_VARIABLE @@ -2294,10 +2309,10 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, : NULL); if (f->sym->attr.pointer - && gfc_check_vardef_context (a->expr, true, context) + && gfc_check_vardef_context (a->expr, true, false, context) == FAILURE) return 0; - if (gfc_check_vardef_context (a->expr, false, context) + if (gfc_check_vardef_context (a->expr, false, false, context) == FAILURE) return 0; } @@ -2749,6 +2764,19 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) "for procedure '%s' at %L", sym->name, &a->expr->where); break; } + + /* F2008, C1303 and C1304. */ + if (a->expr + && (a->expr->ts.type == BT_DERIVED || a->expr->ts.type == BT_CLASS) + && ((a->expr->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV + && a->expr->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE) + || gfc_expr_attr (a->expr).lock_comp)) + { + gfc_error("Actual argument of LOCK_TYPE or with LOCK_TYPE " + "component at %L requires an explicit interface for " + "procedure '%s'", &a->expr->where, sym->name); + break; + } } return; |