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.



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

4 files changed, 70 insertions, 26 deletions

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