From 64b33a7e1eb495404a6a74b8b69368580b1ee874 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Thu, 7 Jan 2010 09:09:51 +0100 Subject: [PATCH] re PR fortran/41872 (wrong-code: Issues with allocatable scalars) 2010-01-07 Tobias Burnus PR fortran/41872 * trans-decl.c (gfc_trans_deferred_vars): Don't initialize allocatable scalars with SAVE attribute. 2010-01-07 Tobias Burnus PR fortran/41872 * gfortran.dg/allocatable_scalar_7.f90: New test. From-SVN: r155687 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/trans-decl.c | 49 +++++++++++-------- gcc/testsuite/ChangeLog | 7 ++- .../gfortran.dg/allocatable_scalar_7.f90 | 26 ++++++++++ 4 files changed, 66 insertions(+), 22 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/allocatable_scalar_7.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7de1ba76ba3..43a3af2fe19 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2010-01-07 Tobias Burnus + + PR fortran/41872 + * trans-decl.c (gfc_trans_deferred_vars): Don't initialize + allocatable scalars with SAVE attribute. + 2010-01-05 Tobias Burnus PR fortran/42517 diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index ce33b2abc19..cf9bef31d93 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3188,31 +3188,38 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) || (sym->ts.type == BT_CLASS && sym->ts.u.derived->components->attr.allocatable)) { - /* Nullify and automatic deallocation of allocatable scalars. */ - tree tmp; - gfc_expr *e; - gfc_se se; - stmtblock_t block; + if (!sym->attr.save) + { + /* Nullify and automatic deallocation of allocatable + scalars. */ + tree tmp; + gfc_expr *e; + gfc_se se; + stmtblock_t block; - e = gfc_lval_expr_from_sym (sym); - if (sym->ts.type == BT_CLASS) - gfc_add_component_ref (e, "$data"); + e = gfc_lval_expr_from_sym (sym); + if (sym->ts.type == BT_CLASS) + gfc_add_component_ref (e, "$data"); - gfc_init_se (&se, NULL); - se.want_pointer = 1; - gfc_conv_expr (&se, e); - gfc_free_expr (e); + gfc_init_se (&se, NULL); + se.want_pointer = 1; + gfc_conv_expr (&se, e); + gfc_free_expr (e); - /* Nullify when entering the scope. */ - gfc_start_block (&block); - gfc_add_modify (&block, se.expr, fold_convert (TREE_TYPE (se.expr), - null_pointer_node)); - gfc_add_expr_to_block (&block, fnbody); + /* Nullify when entering the scope. */ + gfc_start_block (&block); + gfc_add_modify (&block, se.expr, + fold_convert (TREE_TYPE (se.expr), + null_pointer_node)); + gfc_add_expr_to_block (&block, fnbody); - /* Deallocate when leaving the scope. Nullifying is not needed. */ - tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true, NULL); - gfc_add_expr_to_block (&block, tmp); - fnbody = gfc_finish_block (&block); + /* Deallocate when leaving the scope. Nullifying is not + needed. */ + tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true, + NULL); + gfc_add_expr_to_block (&block, tmp); + fnbody = gfc_finish_block (&block); + } } else if (sym->ts.type == BT_CHARACTER) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ef879dedc29..6e0a9038ba8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,9 +1,14 @@ +2010-01-07 Tobias Burnus + + PR fortran/41872 + * gfortran.dg/allocatable_scalar_7.f90: New test. + 2010-01-06 Richard Guenther * gcc.c-torture/compile/pr42632.c: New testcase. 2010-01-05 H.J. Lu - + PR target/42542 * gcc.target/i386/pr42542-4.c: New. * gcc.target/i386/pr42542-4a.c: Likewise. diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_7.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_7.f90 new file mode 100644 index 00000000000..001dd241b94 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_7.f90 @@ -0,0 +1,26 @@ +! { dg-do run } +! +! PR fortran/41872 +! +! Allocatable scalars with SAVE +! +program test + implicit none + call sub (0) + call sub (1) + call sub (2) +contains + subroutine sub (no) + integer, intent(in) :: no + integer, allocatable, save :: a + if (no == 0) then + if (allocated (a)) call abort () + allocate (a) + else if (no == 1) then + if (.not. allocated (a)) call abort () + deallocate (a) + else + if (allocated (a)) call abort () + end if + end subroutine sub +end program test