procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/55854 (ICE on intent(out) dummy argument with unlimited polymorphic component)

Browse source 
2013-01-03  Tobias Burnus  <burnus@net-b.de>

        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  Tobias Burnus  <burnus@net-b.de>

        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.

From-SVN: r194885
This commit is contained in:
Tobias Burnus 2013-01-04 09:57:58 +01:00 • committed by Tobias Burnus
parent e58d2e48e4
commit 15115f7aa8
6 changed files with 58 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View file

@ -1,3 +1,10 @@
2013-01-04 Tobias Burnus <burnus@net-b.de>
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 <janus@gcc.gnu.org>
PR fortran/55855

12
gcc/fortran/class.c
View file

@ -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 <pault@gcc.gnu.org>
and Janus Weil <janus@gcc.gnu.org>
@ -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. */

8
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,11 @@
2013-01-04 Tobias Burnus <burnus@net-b.de>
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 <rdsandiford@googlemail.com>
* gcc.dg/torture/tls/tls-reload-1.c (main): Make testing more thorough.

2
gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03
View file

@ -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

19
gcc/testsuite/gfortran.dg/unlimited_polymorphic_7.f90 Normal file
View file

@ -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

20
gcc/testsuite/gfortran.dg/unlimited_polymorphic_8.f90 Normal file
View file

@ -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" } }