From 0173c67b308f2662712a187e17663b09e3313be9 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 6 Dec 2011 19:10:01 +0100 Subject: re PR fortran/51435 (Bad association status after null() of derived type component) 2011-12-06 Tobias Burnus PR fortran/51435 * expr.c (gfc_has_default_initializer): Fix handling of DT with initialized pointer components. 2011-12-06 Tobias Burnus PR fortran/51435 * gfortran.dg/default_initialization_5.f90: New. From-SVN: r182059 --- gcc/fortran/ChangeLog | 6 ++ gcc/fortran/expr.c | 3 + gcc/testsuite/ChangeLog | 5 ++ .../gfortran.dg/default_initialization_5.f90 | 66 ++++++++++++++++++++++ 4 files changed, 80 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/default_initialization_5.f90 (limited to 'gcc') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4b23c58..6959a70 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-12-06 Tobias Burnus + + PR fortran/51435 + * expr.c (gfc_has_default_initializer): Fix handling of + DT with initialized pointer components. + 2011-12-05 Thomas Koenig PR fortran/51338 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 8817c2c..f3c367c 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3735,6 +3735,8 @@ gfc_has_default_initializer (gfc_symbol *der) if (!c->attr.pointer && gfc_has_default_initializer (c->ts.u.derived)) return true; + if (c->attr.pointer && c->initializer) + return true; } else { @@ -3745,6 +3747,7 @@ gfc_has_default_initializer (gfc_symbol *der) return false; } + /* Get an expression for a default initializer. */ gfc_expr * diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0472974..989fa34 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-12-06 Tobias Burnus + + PR fortran/51435 + * gfortran.dg/default_initialization_5.f90: New. + 2011-12-06 Jakub Jelinek PR target/51354 diff --git a/gcc/testsuite/gfortran.dg/default_initialization_5.f90 b/gcc/testsuite/gfortran.dg/default_initialization_5.f90 new file mode 100644 index 0000000..1192761 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/default_initialization_5.f90 @@ -0,0 +1,66 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/51435 +! +! Contributed by darmar.xxl@gmail.com +! +module arr_m + type arr_t + real(8), dimension(:), allocatable :: rsk + end type + type arr_t2 + integer :: a = 77 + end type +end module arr_m +!********************* +module list_m + use arr_m + implicit none + + type(arr_t2), target :: tgt + + type my_list + type(arr_t), pointer :: head => null() + end type my_list + type my_list2 + type(arr_t2), pointer :: head => tgt + end type my_list2 +end module list_m +!*********************** +module worker_mod + use list_m + implicit none + + type data_all_t + type(my_list) :: my_data + end type data_all_t + type data_all_t2 + type(my_list2) :: my_data + end type data_all_t2 +contains + subroutine do_job() + type(data_all_t) :: dum + type(data_all_t2) :: dum2 + + if (associated(dum%my_data%head)) then + call abort() + else + print *, 'OK: do_job my_data%head is NOT associated' + end if + + if (dum2%my_data%head%a /= 77) & + call abort() + end subroutine +end module +!*************** +program hello + use worker_mod + implicit none + call do_job() +end program + +! { dg-final { scan-tree-dump-times "my_data.head = 0B" 1 "original" } } +! { dg-final { scan-tree-dump-times "my_data.head = &tgt" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } +! { dg-final { cleanup-modules "arr_m list_m worker_mod" } } -- cgit v1.1