diff options
| author | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-07-31 18:32:41 +0000 |
|---|---|---|
| committer | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-07-31 18:32:41 +0000 |
| commit | 87863b31e4634110d76ac7c1f587dc6dfc81ef4d (patch) | |
| tree | 9616650ee31fffec962f6770ab78c4b7b3506558 /gcc/fortran/decl.c | |
| parent | f776299b2e1553d0f92e2c748abe36ace52d3642 (diff) | |
| download | gcc-87863b31e4634110d76ac7c1f587dc6dfc81ef4d.tar.gz | |
2012-07-31 Janus Weil <janus@gcc.gnu.org>
PR fortran/42418
* decl.c (match_procedure_interface): Move some checks to
'resolve_procedure_interface'. Set flavor if appropriate.
* expr.c (gfc_check_pointer_assign): Cleanup of 'gfc_is_intrinsic'.
* intrinsic.c (gfc_is_intrinsic): Additional checks for attributes which
identify a procedure as being non-intrinsic.
* resolve.c (resolve_procedure_interface): Checks moved here from
'match_procedure_interface'. Minor cleanup.
(resolve_formal_arglist,resolve_symbol): Cleanup of
'resolve_procedure_interface'
(resolve_actual_arglist,is_external_proc): Cleanup of
'gfc_is_intrinsic'.
2012-07-31 Janus Weil <janus@gcc.gnu.org>
PR fortran/42418
* gfortran.dg/proc_decl_29.f90: New.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@190017 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/decl.c')
| -rw-r--r-- | gcc/fortran/decl.c | 33 |
1 files changed, 6 insertions, 27 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 39c0493eef5..083326ed37d 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -4792,41 +4792,20 @@ match_procedure_interface (gfc_symbol **proc_if) gfc_current_ns = old_ns; *proc_if = st->n.sym; - /* Various interface checks. */ if (*proc_if) { (*proc_if)->refs++; /* Resolve interface if possible. That way, attr.procedure is only set if it is declared by a later procedure-declaration-stmt, which is - invalid per C1212. */ + invalid per F08:C1216 (cf. resolve_procedure_interface). */ while ((*proc_if)->ts.interface) *proc_if = (*proc_if)->ts.interface; - if ((*proc_if)->generic) - { - gfc_error ("Interface '%s' at %C may not be generic", - (*proc_if)->name); - return MATCH_ERROR; - } - if ((*proc_if)->attr.proc == PROC_ST_FUNCTION) - { - gfc_error ("Interface '%s' at %C may not be a statement function", - (*proc_if)->name); - return MATCH_ERROR; - } - /* Handle intrinsic procedures. */ - if (!((*proc_if)->attr.external || (*proc_if)->attr.use_assoc - || (*proc_if)->attr.if_source == IFSRC_IFBODY) - && (gfc_is_intrinsic ((*proc_if), 0, gfc_current_locus) - || gfc_is_intrinsic ((*proc_if), 1, gfc_current_locus))) - (*proc_if)->attr.intrinsic = 1; - if ((*proc_if)->attr.intrinsic - && !gfc_intrinsic_actual_ok ((*proc_if)->name, 0)) - { - gfc_error ("Intrinsic procedure '%s' not allowed " - "in PROCEDURE statement at %C", (*proc_if)->name); - return MATCH_ERROR; - } + if ((*proc_if)->attr.flavor == FL_UNKNOWN + && (*proc_if)->ts.type == BT_UNKNOWN + && gfc_add_flavor (&(*proc_if)->attr, FL_PROCEDURE, + (*proc_if)->name, NULL) == FAILURE) + return MATCH_ERROR; } got_ts: |