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

gcc/fortran/ChangeLog

+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

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

gcc/testsuite/ChangeLog

+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.

gcc/testsuite/gfortran.dg/allocatable_scalar_7.f90

+! { 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