Index: gcc/fortran/resolve.c =================================================================== *** gcc/fortran/resolve.c (revision 158502) --- gcc/fortran/resolve.c (working copy) *************** ensure_not_abstract_walker (gfc_symbol* *** 10617,10623 **** { gfc_symtree* overriding; overriding = gfc_find_typebound_proc (sub, NULL, st->name, true, NULL); ! gcc_assert (overriding && overriding->n.tb); if (overriding->n.tb->deferred) { gfc_error ("Derived-type '%s' declared at %L must be ABSTRACT because" --- 10617,10625 ---- { gfc_symtree* overriding; overriding = gfc_find_typebound_proc (sub, NULL, st->name, true, NULL); ! if (!overriding) ! return FAILURE; ! gcc_assert (overriding->n.tb); if (overriding->n.tb->deferred) { gfc_error ("Derived-type '%s' declared at %L must be ABSTRACT because" *************** resolve_fl_derived (gfc_symbol *sym) *** 10784,10791 **** /* Copy char length. */ if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl) { ! c->ts.u.cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl); ! gfc_expr_replace_comp (c->ts.u.cl->length, c); } } else if (c->ts.interface->name[0] != '\0') --- 10786,10798 ---- /* Copy char length. */ if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl) { ! gfc_charlen *cl = c->ts.u.cl; ! cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl); ! gfc_expr_replace_comp (cl->length, c); ! if (cl->length && !cl->resolved ! && gfc_resolve_expr (cl->length) == FAILURE) ! return FAILURE; ! c->ts.u.cl = cl; } } else if (c->ts.interface->name[0] != '\0') *************** resolve_symbol (gfc_symbol *sym) *** 11298,11303 **** --- 11305,11313 ---- { sym->ts.u.cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl); gfc_expr_replace_symbols (sym->ts.u.cl->length, sym); + if (sym->ts.u.cl->length && !sym->ts.u.cl->resolved + && gfc_resolve_expr (sym->ts.u.cl->length) == FAILURE) + return; } } else if (sym->ts.interface->name[0] != '\0') Index: gcc/fortran/trans-decl.c =================================================================== *** gcc/fortran/trans-decl.c (revision 158502) --- gcc/fortran/trans-decl.c (working copy) *************** gfc_create_module_variable (gfc_symbol * *** 3477,3483 **** tree length; length = sym->ts.u.cl->backend_decl; ! if (!INTEGER_CST_P (length)) { pushdecl (length); rest_of_decl_compilation (length, 1, 0); --- 3477,3484 ---- tree length; length = sym->ts.u.cl->backend_decl; ! gcc_assert (length || sym->attr.proc_pointer); ! if (length && !INTEGER_CST_P (length)) { pushdecl (length); rest_of_decl_compilation (length, 1, 0); Index: gcc/testsuite/gfortran.dg/proc_decl_23.f90 =================================================================== *** gcc/testsuite/gfortran.dg/proc_decl_23.f90 (revision 0) --- gcc/testsuite/gfortran.dg/proc_decl_23.f90 (revision 0) *************** *** 0 **** --- 1,43 ---- + ! { dg-do compile } + ! Test the fix for PR43227, in which the lines below would segfault. + ! + ! Dominique d'Humieres + ! + function char1 (s) result(res) + character, dimension(:), intent(in) :: s + character(len=size(s)) :: res + do i = 1, size(s) + res(i:i) = s(i) + end do + end function char1 + + module m_string + + procedure(string_to_char) :: char1 ! segfault + procedure(string_to_char), pointer :: char2 ! segfault + type t_string + procedure(string_to_char), pointer, nopass :: char3 ! segfault + end type t_string + + contains + + function string_to_char (s) result(res) + character, dimension(:), intent(in) :: s + character(len=size(s)) :: res + do i = 1, size(s) + res(i:i) = s(i) + end do + end function string_to_char + + end module m_string + + use m_string + type(t_string) :: t + print *, string_to_char (["a","b","c"]) + char2 => string_to_char + print *, char2 (["d","e","f"]) + t%char3 => string_to_char + print *, t%char3 (["g","h","i"]) + print *, char1 (["j","k","l"]) + end + ! { dg-final { cleanup-tree-dump "m_string" } } Index: gcc/testsuite/gfortran.dg/abstract_type_6.f03 =================================================================== *** gcc/testsuite/gfortran.dg/abstract_type_6.f03 (revision 0) --- gcc/testsuite/gfortran.dg/abstract_type_6.f03 (revision 0) *************** *** 0 **** --- 1,53 ---- + ! { dg-do "compile" } + ! Test the fix for PR43266, in which an ICE followed correct error messages. + ! + ! Contributed by Tobias Burnus + ! Reported in http://groups.google.ca/group/comp.lang.fortran/browse_thread/thread/f5ec99089ea72b79 + ! + !---------------- + ! library code + + module m + TYPE, ABSTRACT :: top + CONTAINS + PROCEDURE(xxx), DEFERRED :: proc_a ! { dg-error "must be a module procedure" } + ! some useful default behaviour + PROCEDURE :: proc_c => top_c ! { dg-error "must be a module procedure" } + END TYPE top + + ! Concrete middle class with useful behaviour + TYPE, EXTENDS(top) :: middle + CONTAINS + ! do nothing, empty proc just to make middle concrete + PROCEDURE :: proc_a => dummy_middle_a ! { dg-error "must be a module procedure" } + ! some useful default behaviour + PROCEDURE :: proc_b => middle_b ! { dg-error "must be a module procedure" } + END TYPE middle + + !---------------- + ! client code + + TYPE, EXTENDS(middle) :: bottom + CONTAINS + ! useful proc to satisfy deferred procedure in top. Because we've + ! extended middle we wouldn't get told off if we forgot this. + PROCEDURE :: proc_a => bottom_a + ! calls middle%proc_b and then provides extra behaviour + PROCEDURE :: proc_b => bottom_b + ! calls top_c and then provides extra behaviour + PROCEDURE :: proc_c => bottom_c + END TYPE bottom + contains + SUBROUTINE bottom_b(obj) + CLASS(Bottom) :: obj + CALL obj%middle%proc_b ! { dg-error "should be a SUBROUTINE" } + ! other stuff + END SUBROUTINE bottom_b + + SUBROUTINE bottom_c(obj) + CLASS(Bottom) :: obj + CALL top_c(obj) + ! other stuff + END SUBROUTINE bottom_c + end module + ! { dg-final { cleanup-modules "m" } }