diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2009-06-27 00:11:15 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2009-06-27 00:11:15 +0200 |
| commit | fc9c6e5d64f4dbdc1f7a53a4fa14ddc3f124f165 (patch) | |
| tree | a011c58836777edcbf0334f314676e4eccd1a4bf /gcc/fortran | |
| parent | 9833720d3bf1e5adf2319bb480b882dad8060182 (diff) | |
| download | gcc-fc9c6e5d64f4dbdc1f7a53a4fa14ddc3f124f165.zip gcc-fc9c6e5d64f4dbdc1f7a53a4fa14ddc3f124f165.tar.gz gcc-fc9c6e5d64f4dbdc1f7a53a4fa14ddc3f124f165.tar.bz2 | |
re PR fortran/39997 (Procedure(), pointer & implicit typing: rejects-valid / accepts-invalid?)
2009-06-26 Janus Weil <janus@gcc.gnu.org>
PR fortran/39997
PR fortran/40541
* decl.c (add_hidden_procptr_result): Copy the typespec to the hidden
result.
* expr.c (gfc_check_pointer_assign): Enable interface check for
procedure pointer assignments where the rhs is a function returning a
procedure pointer.
* resolve.c (resolve_symbol): If an external procedure with unspecified
return type can not be implicitly typed, it must be a subroutine.
2009-06-26 Janus Weil <janus@gcc.gnu.org>
PR fortran/39997
PR fortran/40541
* gfortran.dg/proc_ptr_15.f90: Fixed and extended.
* gfortran.dg/proc_ptr_common_1.f90: Fixed invalid test case.
* gfortran.dg/proc_ptr_result_1.f90: Ditto.
* gfortran.dg/proc_ptr_result_5.f90: New.
From-SVN: r148996
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/fortran/decl.c | 1 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 12 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 5 |
4 files changed, 26 insertions, 4 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d8ea53d..2cfbe24 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2009-06-26 Janus Weil <janus@gcc.gnu.org> + + PR fortran/39997 + PR fortran/40541 + * decl.c (add_hidden_procptr_result): Copy the typespec to the hidden + result. + * expr.c (gfc_check_pointer_assign): Enable interface check for + procedure pointer assignments where the rhs is a function returning a + procedure pointer. + * resolve.c (resolve_symbol): If an external procedure with unspecified + return type can not be implicitly typed, it must be a subroutine. + 2009-06-24 Janus Weil <janus@gcc.gnu.org> PR fortran/40427 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 021392d..179d1e2 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -4117,6 +4117,7 @@ add_hidden_procptr_result (gfc_symbol *sym) sym->result->attr.pointer = sym->attr.pointer; sym->result->attr.external = sym->attr.external; sym->result->attr.referenced = sym->attr.referenced; + sym->result->ts = sym->ts; sym->attr.proc_pointer = 0; sym->attr.pointer = 0; sym->attr.external = 0; diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index d2f73d6..2049fa4 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3189,10 +3189,14 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) /* TODO: Enable interface check for PPCs. */ if (is_proc_ptr_comp (rvalue, NULL)) return SUCCESS; - if (rvalue->expr_type == EXPR_VARIABLE - && !gfc_compare_interfaces (lvalue->symtree->n.sym, - rvalue->symtree->n.sym, 0, 1, err, - sizeof(err))) + if ((rvalue->expr_type == EXPR_VARIABLE + && !gfc_compare_interfaces (lvalue->symtree->n.sym, + rvalue->symtree->n.sym, 0, 1, err, + sizeof(err))) + || (rvalue->expr_type == EXPR_FUNCTION + && !gfc_compare_interfaces (lvalue->symtree->n.sym, + rvalue->symtree->n.sym->result, 0, 1, + err, sizeof(err)))) { gfc_error ("Interface mismatch in procedure pointer assignment " "at %L: %s", &rvalue->where, err); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 9bb6e22..9ea2a2d 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9551,6 +9551,11 @@ resolve_symbol (gfc_symbol *sym) if (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER) gfc_set_default_type (sym, 1, NULL); + if (sym->attr.flavor == FL_PROCEDURE && sym->attr.external + && !sym->attr.function && !sym->attr.subroutine + && gfc_get_default_type (sym->name, sym->ns)->type == BT_UNKNOWN) + gfc_add_subroutine (&sym->attr, sym->name, &sym->declared_at); + if (sym->attr.flavor == FL_PROCEDURE && sym->attr.function) { /* The specific case of an external procedure should emit an error |