diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2009-04-07 09:24:37 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2009-04-07 09:24:37 +0200 |
| commit | 3afadac3ca557d83ad115178a631aeb60659b0c5 (patch) | |
| tree | b6a3794c0ef4b9169b679011d0325bd1a347a4f6 /gcc/fortran/interface.c | |
| parent | 445099463a83367ddabb201e9e29e5a741cce034 (diff) | |
| download | gcc-3afadac3ca557d83ad115178a631aeb60659b0c5.zip gcc-3afadac3ca557d83ad115178a631aeb60659b0c5.tar.gz gcc-3afadac3ca557d83ad115178a631aeb60659b0c5.tar.bz2 | |
re PR other/38920 (dw2 exceptions don't work.)
2009-04-07 Janus Weil <janus@gcc.gnu.org>
PR fortran/38920
* expr.c (gfc_check_pointer_assign): Enable interface check for
procedure pointers.
* gfortran.h: Add copy_formal_args_intr.
* interface.c (gfc_compare_interfaces): Call gfc_compare_intr_interfaces
if second argument is an intrinsic.
(compare_intr_interfaces): Correctly set attr.function, attr.subroutine
and ts.
(compare_parameter): Call gfc_compare_interfaces also for intrinsics.
* resolve.c (resolve_specific_f0,resolve_specific_s0): Don't resolve
intrinsic interfaces here. Must happen earlier.
(resolve_symbol): Resolution of intrinsic interfaces moved here from
resolve_specific_..., and formal args are now copied from intrinsic
interfaces.
* symbol.c (copy_formal_args_intr): New function to copy the formal
arguments from an intinsic procedure.
2009-04-07 Janus Weil <janus@gcc.gnu.org>
PR fortran/38920
* gfortran.dg/proc_decl_1.f90: Modified.
* gfortran.dg/proc_ptr_11.f90: Extended.
* gfortran.dg/proc_ptr_13.f90: Modified.
From-SVN: r145651
Diffstat (limited to 'gcc/fortran/interface.c')
| -rw-r--r-- | gcc/fortran/interface.c | 31 |
1 files changed, 19 insertions, 12 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 88638070..162816c 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -967,6 +967,9 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag) { gfc_formal_arglist *f1, *f2; + if (s2->attr.intrinsic) + return compare_intr_interfaces (s1, s2); + if (s1->attr.function != s2->attr.function || s1->attr.subroutine != s2->attr.subroutine) return 0; /* Disagreement between function/subroutine. */ @@ -1006,6 +1009,21 @@ compare_intr_interfaces (gfc_symbol *s1, gfc_symbol *s2) gfc_intrinsic_arg *fi, *f2; gfc_intrinsic_sym *isym; + isym = gfc_find_function (s2->name); + if (isym) + { + if (!s2->attr.function) + gfc_add_function (&s2->attr, s2->name, &gfc_current_locus); + s2->ts = isym->ts; + } + else + { + isym = gfc_find_subroutine (s2->name); + gcc_assert (isym); + if (!s2->attr.subroutine) + gfc_add_subroutine (&s2->attr, s2->name, &gfc_current_locus); + } + if (s1->attr.function != s2->attr.function || s1->attr.subroutine != s2->attr.subroutine) return 0; /* Disagreement between function/subroutine. */ @@ -1022,12 +1040,6 @@ compare_intr_interfaces (gfc_symbol *s1, gfc_symbol *s2) return 1; } - isym = gfc_find_function (s2->name); - - /* This should already have been checked in - resolve.c (resolve_actual_arglist). */ - gcc_assert (isym); - f1 = s1->formal; f2 = isym->formal; @@ -1463,12 +1475,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, || actual->symtree->n.sym->attr.external) return 1; /* Assume match. */ - if (actual->symtree->n.sym->attr.intrinsic) - { - if (!compare_intr_interfaces (formal, actual->symtree->n.sym)) - goto proc_fail; - } - else if (!gfc_compare_interfaces (formal, actual->symtree->n.sym, 0)) + if (!gfc_compare_interfaces (formal, actual->symtree->n.sym, 0)) goto proc_fail; return 1; |