diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2b050b12d7f..591a2891b2a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2013-01-04 Tobias Burnus + + PR fortran/55854 + PR fortran/55763 + * class.c (gfc_class_null_initializer): Fix finding the vtab. + (gfc_find_intrinsic_vtab): Use BT_VOID for some components. + 2013-01-03 Janus Weil PR fortran/55855 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 61d65e7a30b..607af1090fd 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -1,5 +1,5 @@ /* Implementation of Fortran 2003 Polymorphism. - Copyright (C) 2009, 2010, 2011, 2012 + Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. Contributed by Paul Richard Thomas and Janus Weil @@ -414,7 +414,7 @@ gfc_class_null_initializer (gfc_typespec *ts, gfc_expr *init_expr) && ts->u.derived->components->ts.u.derived->attr.unlimited_polymorphic; if (is_unlimited_polymorphic && init_expr) - vtab = gfc_find_intrinsic_vtab (&(init_expr->ts)); + vtab = gfc_find_intrinsic_vtab (&ts->u.derived->components->ts); else vtab = gfc_find_derived_vtab (ts->u.derived); @@ -2224,9 +2224,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts) goto cleanup; c->attr.pointer = 1; c->attr.access = ACCESS_PRIVATE; - /* Avoid segfaults because due to character length. */ - c->ts.type = ts->type == BT_CHARACTER ? BT_VOID : ts->type; - c->ts.kind = ts->kind; + c->ts.type = BT_VOID; c->initializer = gfc_get_null_expr (NULL); /* Add component _def_init. */ @@ -2234,9 +2232,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts) goto cleanup; c->attr.pointer = 1; c->attr.access = ACCESS_PRIVATE; - /* Avoid segfaults due to missing character length. */ - c->ts.type = ts->type == BT_CHARACTER ? BT_VOID : ts->type; - c->ts.kind = ts->kind; + c->ts.type = BT_VOID; c->initializer = gfc_get_null_expr (NULL); /* Add component _copy. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ed8cd6520c8..5357e0bdab5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2013-01-04 Tobias Burnus + + PR fortran/55854 + PR fortran/55763 + * gfortran.dg/unlimited_polymorphic_3.f03: Remove invalid code. + * gfortran.dg/unlimited_polymorphic_7.f90: New. + * gfortran.dg/unlimited_polymorphic_8.f90: New. + 2013-01-03 Richard Sandiford * gcc.dg/torture/tls/tls-reload-1.c (main): Make testing more thorough. diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03 index 5ed98974d7c..05a4b3f54ec 100644 --- a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03 +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03 @@ -28,9 +28,7 @@ contains end type t type(t), pointer :: x class(*), pointer :: ptr1 => null() ! pointer initialization - class(*), pointer :: ptr2 => null(x) ! pointer initialization if (same_type_as (ptr1, x) .neqv. .FALSE.) call abort - if (same_type_as (ptr2, x) .neqv. .TRUE.) call abort end subroutine bar end program main diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_7.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_7.f90 new file mode 100644 index 00000000000..3bd4d4d7340 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_7.f90 @@ -0,0 +1,19 @@ +! { dg-do compile } +! +! PR fortran/55763 +! +! Contributed by Harald Anlauf +! + +module gfcbug121 + implicit none + type myobj + class(*), allocatable :: x + contains + procedure :: print + end type myobj +contains + subroutine print(this) + class(myobj) :: this + end subroutine print +end module gfcbug121 diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_8.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_8.f90 new file mode 100644 index 00000000000..e0fa931eb4a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_8.f90 @@ -0,0 +1,20 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/55854 +! +! Contributed by Damian Rouson +! + + type foo + class(*), allocatable :: x + end type +contains + subroutine bar(this) + type(foo), intent(out) :: this + end +end + +! { dg-final { scan-tree-dump-times "foo.0.x._data = 0B;" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo.0.x._vptr = .* &__vtab__.tar;" 1 "original" } } +! { dg-final { cleanup-tree-dump "optimized" } }