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

re PR fortran/41872 (wrong-code: Issues with allocatable scalars) 

2010-01-07  Tobias Burnus  <burnus@net-b.de>

        PR fortran/41872
        * trans-decl.c (gfc_trans_deferred_vars): Don't initialize
        allocatable scalars with SAVE attribute.

2010-01-07  Tobias Burnus  <burnus@net-b.de>

        PR fortran/41872
        * gfortran.dg/allocatable_scalar_7.f90: New test.

From-SVN: r155687
This commit is contained in:
Tobias Burnus 2010-01-07 09:09:51 +01:00 committed by Tobias Burnus
parent 2e8e6a99ee
commit 64b33a7e1e
4 changed files with 66 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2010-01-07 Tobias Burnus <burnus@net-b.de>
PR fortran/41872
* trans-decl.c (gfc_trans_deferred_vars): Don't initialize
allocatable scalars with SAVE attribute.
2010-01-05 Tobias Burnus <burnus@net-b.de>
PR fortran/42517

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

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

7
gcc/testsuite/ChangeLog
View File

@ -1,9 +1,14 @@
2010-01-07 Tobias Burnus <burnus@net-b.de>
PR fortran/41872
* gfortran.dg/allocatable_scalar_7.f90: New test.
2010-01-06 Richard Guenther <rguenther@suse.de>
* gcc.c-torture/compile/pr42632.c: New testcase.
2010-01-05 H.J. Lu <hongjiu.lu@intel.com>
PR target/42542
* gcc.target/i386/pr42542-4.c: New.
* gcc.target/i386/pr42542-4a.c: Likewise.

26
gcc/testsuite/gfortran.dg/allocatable_scalar_7.f90 Normal file
View File

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