OSDN Git Service

2010-01-07 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 7 Jan 2010 08:09:51 +0000 (08:09 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 7 Jan 2010 08:09:51 +0000 (08:09 +0000)
        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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@155687 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/trans-decl.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/allocatable_scalar_7.f90 [new file with mode: 0644]

index 7de1ba7..43a3af2 100644 (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
index ce33b2a..cf9bef3 100644 (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;
-
-         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);
-
-         /* 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);
+         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");
+
+             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);
+
+             /* 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)
        {
index ef879de..6e0a903 100644 (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.
diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_7.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_7.f90
new file mode 100644 (file)
index 0000000..001dd24
--- /dev/null
@@ -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