[multiple changes]

2005-11-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/15809
	* trans-decl.c (gfc_get_symbol_decl):  In the case of automatic
	character length, dummy pointer arrays, build an expression for
	unit size of the array elements, to be picked up and used in the
	descriptor dtype.
	* trans-io.c (gfc_trans_transfer):  Modify the detection of
	components of derived type arrays to use the gfc_expr references
	instead of the array descriptor dtype.  This allows the latter
	to contain expressions.

2005-11-30  Erik Edelmann  <erik.edelmann@iki.fi>

	PR fortran/15809
	* trans-array.c (gfc_trans_deferred_array):  Allow PARM_DECLs past
	in addition to VAR_DECLs.

2005-11-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/15809
	*  gfortran.dg/auto_char_dummy_array.f90: New test.

From-SVN: r107727

gcc/fortran/ChangeLog

+2005-11-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/15809
+	* trans-decl.c (gfc_get_symbol_decl):  In the case of automatic
+	character length, dummy pointer arrays, build an expression for
+	unit size of the array elements, to be picked up and used in the
+	descriptor dtype.
+	* trans-io.c (gfc_trans_transfer):  Modify the detection of
+	components of derived type arrays to use the gfc_expr references
+	instead of the array descriptor dtype.  This allows the latter
+	to contain expressions.
+
+2005-11-30  Erik Edelmann  <erik.edelmann@iki.fi>
+
+	PR fortran/15809
+	* trans-array.c (gfc_trans_deferred_array):  Allow PARM_DECLs past
+	in addition to VAR_DECLs.
+
 2005-11-29  Jakub Jelinek  <jakub@redhat.com>
 
 	* io.c (gfc_resolve_open): RESOLVE_TAG access field as well.

gcc/fortran/trans-array.c

@@ -4173,7 +4173,9 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
 
   gfc_init_block (&fnblock);
 
-  gcc_assert (TREE_CODE (sym->backend_decl) == VAR_DECL);
+  gcc_assert (TREE_CODE (sym->backend_decl) == VAR_DECL
+                || TREE_CODE (sym->backend_decl) == PARM_DECL);
+
   if (sym->ts.type == BT_CHARACTER
       && !INTEGER_CST_P (sym->ts.cl->backend_decl))
     gfc_trans_init_string_length (sym->ts.cl, &fnblock);

gcc/fortran/trans-decl.c

@@ -809,7 +809,9 @@ tree
 gfc_get_symbol_decl (gfc_symbol * sym)
 {
   tree decl;
+  tree etype = NULL_TREE;
   tree length = NULL_TREE;
+  tree tmp = NULL_TREE;
   int byref;
 
   gcc_assert (sym->attr.referenced);
@@ -845,6 +847,22 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	      if (TREE_CODE (length) != INTEGER_CST)
 		{
 		  gfc_finish_var_decl (length, sym);
+
+		  /* Set the element size of automatic character length
+		     length, dummy, pointer arrays.  */
+		  if (sym->attr.pointer && sym->attr.dummy
+			&& sym->attr.dimension)
+		    {
+		      tmp = gfc_build_indirect_ref (sym->backend_decl);
+		      etype = gfc_get_element_type (TREE_TYPE (tmp));
+		      if (TYPE_SIZE_UNIT (etype) == NULL_TREE)
+			{
+			  tmp = TYPE_SIZE_UNIT (gfc_character1_type_node);
+			  tmp = fold_convert (TREE_TYPE (tmp), length);
+			  TYPE_SIZE_UNIT (etype) = tmp;
+			}
+		    }
+
 		  gfc_defer_symbol_init (sym);
 		}
 	    }

gcc/fortran/trans-io.c

@@ -1768,6 +1768,7 @@ gfc_trans_transfer (gfc_code * code)
   stmtblock_t block, body;
   gfc_loopinfo loop;
   gfc_expr *expr;
+  gfc_ref *ref;
   gfc_ss *ss;
   gfc_se se;
   tree tmp;
@@ -1778,6 +1779,7 @@ gfc_trans_transfer (gfc_code * code)
   expr = code->expr;
   ss = gfc_walk_expr (expr);
 
+  ref = NULL;
   gfc_init_se (&se, NULL);
 
   if (ss == gfc_ss_terminator)
@@ -1788,33 +1790,23 @@ gfc_trans_transfer (gfc_code * code)
     }
   else
     {
-      /* Transfer an array. There are 3 options:
-      1) An array of an intrinsic type. This is handled by transfering
-	 the descriptor to the library.
-      2) A derived type containing an array. Scalarized by the frontend.
-      3) An array of derived type. Scalarized by the frontend.
-      */
-      if (expr->ts.type != BT_DERIVED)
+      /* Transfer an array. If it is an array of an intrinsic
+	 type, pass the descriptor to the library.  Otherwise
+	 scalarize the transfer.  */
+      if (expr->ref)
+	{
+	  for (ref = expr->ref; ref && ref->type != REF_ARRAY;
+		 ref = ref->next);
+	  gcc_assert (ref->type == REF_ARRAY);
+	}
+
+      if (expr->ts.type != BT_DERIVED && ref && ref->next == NULL)
 	{
 	  /* Get the descriptor.  */
 	  gfc_conv_expr_descriptor (&se, expr, ss);
-	  /* If it's not an array of derived type, transfer the array
-	     descriptor to the library.  */
-	  tmp = gfc_get_dtype (TREE_TYPE (se.expr));
-	  if (((TREE_INT_CST_LOW (tmp) & GFC_DTYPE_TYPE_MASK) 
-	       >> GFC_DTYPE_TYPE_SHIFT) != GFC_DTYPE_DERIVED)
-	    {
-	      tmp = gfc_build_addr_expr (NULL, se.expr);
-	      transfer_array_desc (&se, &expr->ts, tmp);
-	      goto finish_block_label;
-	    }
-	  else
-	    {
-	      /* Cleanup the mess getting the descriptor caused.  */
-	      expr = code->expr;
-	      ss = gfc_walk_expr (expr);
-	      gfc_init_se (&se, NULL);
-	    }
+	  tmp = gfc_build_addr_expr (NULL, se.expr);
+	  transfer_array_desc (&se, &expr->ts, tmp);
+	  goto finish_block_label;
 	}
       
       /* Initialize the scalarizer.  */

gcc/testsuite/ChangeLog

+2005-11-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/15809
+	*  gfortran.dg/auto_char_dummy_array.f90: New test.
+
 2005-11-30  Jeff Law  <law@redhat.com>
 
 	* g++.old-deja/g++.law/pr25000.C: New test.

gcc/testsuite/gfortran.dg/auto_char_dummy_array_1.f90

+! { dg-do run }
+! This tests the fix for pr15809 in which automatic character length,
+! dummy, pointer arrays were broken.
+!
+! contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module global
+  character(12), dimension(2), target :: t
+end module global
+
+program oh_no_not_pr15908_again
+  character(12), dimension(:), pointer :: ptr
+
+  call a (ptr, 12)
+  if (.not.associated (ptr) ) call abort ()
+  if (any (ptr.ne."abc")) call abort ()
+
+  ptr => null ()              ! ptr points to 't' here.
+  allocate (ptr(3))
+  ptr = "xyz"
+  call a (ptr, 12)
+
+  if (.not.associated (ptr)) call abort ()
+  if (any (ptr.ne."lmn")) call abort ()
+
+  call a (ptr, 0)
+
+  if (associated (ptr)) call abort ()
+
+contains
+
+  subroutine a (p, l)
+    use global
+    character(l), dimension(:), pointer :: p
+    character(l), dimension(3)          :: s
+
+    s = "lmn"
+
+    if (l.ne.12) then
+      deallocate (p)           ! ptr was allocated in main.
+      p => null ()
+      return
+    end if
+
+    if (.not.associated (p)) then
+      t = "abc"
+      p => t
+    else
+      if (size (p,1).ne.3) call abort ()
+      if (any (p.ne."xyz")) call abort ()
+      p = s
+    end if
+  end subroutine a
+
+end program oh_no_not_pr15908_again
+