OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/43227 (ICE: segmentation fault in mio_expr)

Browse Source 
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
This commit is contained in:
Paul Thomas 2010-04-20 19:07:14 +00:00
parent e96ccb30f5
commit 9c4174d853
6 changed files with 132 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/fortran/ChangeLog
View File

@ -1,3 +1,17 @@
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

15
gcc/fortran/resolve.c
View File

@ -10617,7 +10617,9 @@ ensure_not_abstract_walker (gfc_symbol* sub, gfc_symtree* st)
{
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"
@ -10784,8 +10786,12 @@ resolve_fl_derived (gfc_symbol *sym)
/* 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')
@ -11298,6 +11304,9 @@ resolve_symbol (gfc_symbol *sym)
{
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')

3
gcc/fortran/trans-decl.c
View File

@ -3477,7 +3477,8 @@ gfc_create_module_variable (gfc_symbol * sym)
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);

8
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,11 @@
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.

53
gcc/testsuite/gfortran.dg/abstract_type_6.f03 Normal file
View File

@ -0,0 +1,53 @@
! { 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" } }

43
gcc/testsuite/gfortran.dg/proc_decl_23.f90 Normal file
View File

@ -0,0 +1,43 @@
! { 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" } }