From b82657f4a84dd4abb65bbf4179a109f1d8a36e92 Mon Sep 17 00:00:00 2001 From: Daniel Kraft Date: Sun, 5 Oct 2008 08:39:37 +0200 Subject: re PR fortran/37638 (ICE in update_arglist_pass) 2008-10-05 Daniel Kraft PR fortran/37638 * gfortran.h (struct gfc_typebound_proc): New flag `error'. * resolve.c (update_arglist_pass): Added assertion. (update_compcall_arglist): Fail early for erraneous procedures to avoid confusion later. (resolve_typebound_generic_call): Ignore erraneous specific targets and added assertions. (resolve_typebound_procedure): Set new `error' flag. 2008-10-05 Daniel Kraft PR fortran/37638 * gfortran.dg/typebound_call_9.f03: New test. From-SVN: r140880 --- gcc/fortran/ChangeLog | 11 +++++++++++ gcc/fortran/gfortran.h | 1 + gcc/fortran/resolve.c | 13 +++++++++++++ 3 files changed, 25 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d462da0..df358b8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2008-10-05 Daniel Kraft + + PR fortran/37638 + * gfortran.h (struct gfc_typebound_proc): New flag `error'. + * resolve.c (update_arglist_pass): Added assertion. + (update_compcall_arglist): Fail early for erraneous procedures to avoid + confusion later. + (resolve_typebound_generic_call): Ignore erraneous specific targets + and added assertions. + (resolve_typebound_procedure): Set new `error' flag. + 2008-10-04 Paul Thomas PR fortran/37706 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 60d9bac..55cca72 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1037,6 +1037,7 @@ typedef struct gfc_typebound_proc unsigned non_overridable:1; unsigned is_generic:1; unsigned function:1, subroutine:1; + unsigned error:1; /* Ignore it, when an error occurred during resolution. */ } gfc_typebound_proc; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index d682e10..6976e64 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4366,6 +4366,8 @@ fixup_charlen (gfc_expr *e) static gfc_actual_arglist* update_arglist_pass (gfc_actual_arglist* lst, gfc_expr* po, unsigned argpos) { + gcc_assert (argpos > 0); + if (argpos == 1) { gfc_actual_arglist* result; @@ -4417,6 +4419,9 @@ update_compcall_arglist (gfc_expr* e) tbp = e->value.compcall.tbp; + if (tbp->error) + return FAILURE; + po = extract_compcall_passed_object (e); if (!po) return FAILURE; @@ -4497,6 +4502,10 @@ resolve_typebound_generic_call (gfc_expr* e) bool matches; gcc_assert (g->specific); + + if (g->specific->error) + continue; + target = g->specific->u.specific->n.sym; /* Get the right arglist by handling PASS/NOPASS. */ @@ -4508,6 +4517,8 @@ resolve_typebound_generic_call (gfc_expr* e) if (!po) return FAILURE; + gcc_assert (g->specific->pass_arg_num > 0); + gcc_assert (!g->specific->error); args = update_arglist_pass (args, po, g->specific->pass_arg_num); } resolve_actual_arglist (args, target->attr.proc, @@ -8448,10 +8459,12 @@ resolve_typebound_procedure (gfc_symtree* stree) goto error; } + stree->typebound->error = 0; return; error: resolve_bindings_result = FAILURE; + stree->typebound->error = 1; } static gfc_try -- cgit v1.1