diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2017-04-10 22:28:23 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2017-04-10 22:28:23 +0200 |
| commit | 99827b5ca0ce4582940da66a23f737b70d0d8c41 (patch) | |
| tree | 270682d2c8dbde4b0726232fdb17efeb4db4899c /gcc/fortran/expr.c | |
| parent | 7db31bc20ca5d2ff60f1dd65387f600a8a3130cf (diff) | |
| download | gcc-99827b5ca0ce4582940da66a23f737b70d0d8c41.zip gcc-99827b5ca0ce4582940da66a23f737b70d0d8c41.tar.gz gcc-99827b5ca0ce4582940da66a23f737b70d0d8c41.tar.bz2 | |
re PR fortran/80046 ([F03] Explicit interface required: pointer argument)
2017-04-10 Janus Weil <janus@gcc.gnu.org>
PR fortran/80046
* expr.c (gfc_check_pointer_assign): Check if procedure pointer
components in a pointer assignment need an explicit interface.
2017-04-10 Janus Weil <janus@gcc.gnu.org>
PR fortran/80046
* gfortran.dg/proc_ptr_comp_48.f90: New test case.
From-SVN: r246823
Diffstat (limited to 'gcc/fortran/expr.c')
| -rw-r--r-- | gcc/fortran/expr.c | 42 |
1 files changed, 29 insertions, 13 deletions
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 0e5f04d..c8be951 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3595,25 +3595,41 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) return false; } - if (s1 == s2 || !s1 || !s2) - return true; - /* F08:7.2.2.4 (4) */ - if (s1->attr.if_source == IFSRC_UNKNOWN - && gfc_explicit_interface_required (s2, err, sizeof(err))) + if (s2 && gfc_explicit_interface_required (s2, err, sizeof(err))) { - gfc_error ("Explicit interface required for %qs at %L: %s", - s1->name, &lvalue->where, err); - return false; + if (comp1 && !s1) + { + gfc_error ("Explicit interface required for component %qs at %L: %s", + comp1->name, &lvalue->where, err); + return false; + } + else if (s1->attr.if_source == IFSRC_UNKNOWN) + { + gfc_error ("Explicit interface required for %qs at %L: %s", + s1->name, &lvalue->where, err); + return false; + } } - if (s2->attr.if_source == IFSRC_UNKNOWN - && gfc_explicit_interface_required (s1, err, sizeof(err))) + if (s1 && gfc_explicit_interface_required (s1, err, sizeof(err))) { - gfc_error ("Explicit interface required for %qs at %L: %s", - s2->name, &rvalue->where, err); - return false; + if (comp2 && !s2) + { + gfc_error ("Explicit interface required for component %qs at %L: %s", + comp2->name, &rvalue->where, err); + return false; + } + else if (s2->attr.if_source == IFSRC_UNKNOWN) + { + gfc_error ("Explicit interface required for %qs at %L: %s", + s2->name, &rvalue->where, err); + return false; + } } + if (s1 == s2 || !s1 || !s2) + return true; + if (!gfc_compare_interfaces (s1, s2, name, 0, 1, err, sizeof(err), NULL, NULL)) { |