2010-04-20 Paul Thomas <pault@gcc.gnu.org>
PR fortran/43227
* resolve.c (resolve_fl_derived): If a component character
length has not been resolved, do so now.
(resolve_symbol): The same as above for a symbol character
length.
* trans-decl.c (gfc_create_module_variable): A 'length' decl is
not needed for a character valued, procedure pointer.
PR fortran/43266
* resolve.c (ensure_not_abstract_walker): If 'overriding' is
not found, return FAILURE rather than ICEing.
2010-04-20 Paul Thomas <pault@gcc.gnu.org>
PR fortran/43227
* gfortran.dg/proc_decl_23.f90: New test.
PR fortran/43266
* gfortran.dg/abstract_type_6.f03: New test.
From-SVN: r158570
+2010-04-20 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/43227
+ * resolve.c (resolve_fl_derived): If a component character
+ length has not been resolved, do so now.
+ (resolve_symbol): The same as above for a symbol character
+ length.
+ * trans-decl.c (gfc_create_module_variable): A 'length' decl is
+ not needed for a character valued, procedure pointer.
+
+ PR fortran/43266
+ * resolve.c (ensure_not_abstract_walker): If 'overriding' is
+ not found, return FAILURE rather than ICEing.
+
2010-04-19 Jakub Jelinek <jakub@redhat.com>
PR fortran/43339
{
gfc_symtree* overriding;
overriding = gfc_find_typebound_proc (sub, NULL, st->name, true, NULL);
- gcc_assert (overriding && overriding->n.tb);
+ 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"
/* 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);
+ gfc_charlen *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')
{
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')
tree length;
length = sym->ts.u.cl->backend_decl;
- if (!INTEGER_CST_P (length))
+ gcc_assert (length || sym->attr.proc_pointer);
+ if (length && !INTEGER_CST_P (length))
{
pushdecl (length);
rest_of_decl_compilation (length, 1, 0);
+2010-04-20 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/43227
+ * gfortran.dg/proc_decl_23.f90: New test.
+
+ PR fortran/43266
+ * gfortran.dg/abstract_type_6.f03: New test.
+
2010-04-20 Xinliang David Li <davidxl@google.com>
* g++.dg/tree-ssa/fold-compare.C: New.
--- /dev/null
+! { dg-do "compile" }
+! Test the fix for PR43266, in which an ICE followed correct error messages.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+! 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" } }
--- /dev/null
+! { dg-do compile }
+! Test the fix for PR43227, in which the lines below would segfault.
+!
+! Dominique d'Humieres <dominiq@lps.ens.fr>
+!
+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" } }
projects / thirdparty / gcc.git / commitdiff
