re PR fortran/47421 (Wrong-code: Value of scalar ALLOCATABLE CHARACTER(len=n) dummy is mangled)

2011-01-23  Tobias Burnus  <burnus@net-b.de>

        PR fortran/47421
        * trans-decl.c (gfc_trans_deferred_vars): Do not nullify
        scalar allocatable dummy arguments.

2011-01-23  Tobias Burnus  <burnus@net-b.de>

        PR fortran/47421
        * gfortran.dg/allocatable_scalar_12.f90: New.

From-SVN: r169145

gcc/fortran/ChangeLog

+2011-01-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47421
+	* trans-decl.c (gfc_trans_deferred_vars): Do not nullify
+	scalar allocatable dummy arguments.
+
 2011-01-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/38536

gcc/fortran/trans-decl.c

@@ -3304,9 +3304,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	  if (sym_has_alloc_comp && !seen_trans_deferred_array)
 	    gfc_trans_deferred_array (sym, block);
 	}
-      else if (sym->attr.allocatable
-	       || (sym->ts.type == BT_CLASS
-		   && CLASS_DATA (sym)->attr.allocatable))
+      else if (!sym->attr.dummy
+		&& (sym->attr.allocatable
+		    || (sym->ts.type == BT_CLASS
+			&& CLASS_DATA (sym)->attr.allocatable)))
 	{
 	  if (!sym->attr.save)
 	    {

gcc/testsuite/ChangeLog

+2011-01-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47421
+	* gfortran.dg/allocatable_scalar_12.f90: New.
+
 2011-01-23  Ira Rosen  <irar@il.ibm.com>
 
 	* gcc.dg/vect/costmodel/spu/costmodel-vect-33.c: Expect

gcc/testsuite/gfortran.dg/allocatable_scalar_12.f90

+! { dg-do run }
+!
+! PR fortran/47421
+!
+! Don't auto-deallocatable scalar character allocatables.
+!
+implicit none
+character(len=5), allocatable :: str
+allocate(str)
+str = '1bcde'
+if(str /= '1bcde') call abort()
+call sub(str,len(str))
+if(str /= '1bcde') call abort()
+call subOUT(str,len(str))
+if (len(str) /= 5) call abort()
+if(allocated(str)) call abort()
+contains
+  subroutine sub(x,n)
+     integer :: n
+     character(len=n), allocatable :: x
+     if(len(x) /= 5) call abort()
+     if(x /= '1bcde') call abort()
+  end subroutine sub
+  subroutine subOUT(x,n)
+     integer :: n
+     character(len=n), allocatable,intent(out) :: x
+     if(allocated(x)) call abort()
+     if(len(x) /= 5) call abort()
+  end subroutine subOUT
+end