re PR fortran/23373 ([4.0 only] Functions returning pointers with pointer argument)

	PR fortran/23373
	* trans-expr.c (gfc_trans_pointer_assignment): Assign to a temporary
	descriptor if the rhs is not a null pointer or variable.

From-SVN: r104029

gcc/fortran/ChangeLog

+2005-09-07  Richard Sandiford  <richard@codesourcery.com>
+
+	PR fortran/23373
+	* trans-expr.c (gfc_trans_pointer_assignment): Assign to a temporary
+	descriptor if the rhs is not a null pointer or variable.
+
 2005-09-07  Thomas Koenig  <Thomas.Koenig@online.de>
 
 	PR fortran/20848

gcc/fortran/trans-expr.c

@@ -2041,6 +2041,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
   gfc_ss *lss;
   gfc_ss *rss;
   stmtblock_t block;
+  tree desc;
+  tree tmp;
 
   gfc_start_block (&block);
 
@@ -2068,13 +2070,30 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
     {
       /* Array pointer.  */
       gfc_conv_expr_descriptor (&lse, expr1, lss);
-      /* Implement Nullify.  */
-      if (expr2->expr_type == EXPR_NULL)
-	gfc_conv_descriptor_data_set (&block, lse.expr, null_pointer_node);
-      else
-        {
+      switch (expr2->expr_type)
+	{
+	case EXPR_NULL:
+	  /* Just set the data pointer to null.  */
+	  gfc_conv_descriptor_data_set (&block, lse.expr, null_pointer_node);
+	  break;
+
+	case EXPR_VARIABLE:
+	  /* Assign directly to the pointer's descriptor.  */
           lse.direct_byref = 1;
-          gfc_conv_expr_descriptor (&lse, expr2, rss);
+	  gfc_conv_expr_descriptor (&lse, expr2, rss);
+	  break;
+
+	default:
+	  /* Assign to a temporary descriptor and then copy that
+	     temporary to the pointer.  */
+	  desc = lse.expr;
+	  tmp = gfc_create_var (TREE_TYPE (desc), "ptrtemp");
+
+	  lse.expr = tmp;
+	  lse.direct_byref = 1;
+	  gfc_conv_expr_descriptor (&lse, expr2, rss);
+	  gfc_add_modify_expr (&lse.pre, desc, tmp);
+	  break;
         }
       gfc_add_block_to_block (&block, &lse.pre);
       gfc_add_block_to_block (&block, &lse.post);

gcc/testsuite/ChangeLog

+2005-09-07  Richard Sandiford  <richard@codesourcery.com>
+
+	PR fortran/23373
+	* gfortran.fortran-torture/execute/pr23373-1.f90,
+	* gfortran.fortran-torture/execute/pr23373-1.f90: New tests.
+
 2005-09-07  Jerry DeLisle  <jvdelisle@verizon.net>
 
 	PR libfortran/23760

gcc/testsuite/gfortran.fortran-torture/execute/pr23373-1.f90

+program main
+  implicit none
+  real, dimension (:), pointer :: x
+  x => null ()
+  x => test (x)
+  if (.not. associated (x)) call abort
+  if (size (x) .ne. 10) call abort
+contains
+  function test (p)
+    real, dimension (:), pointer :: p, test
+    if (associated (p)) call abort
+    allocate (test (10))
+    if (associated (p)) call abort
+  end function test
+end program main

gcc/testsuite/gfortran.fortran-torture/execute/pr23373-2.f90

+program main
+  implicit none
+  real, dimension (:), pointer :: x
+  x => null ()
+  x => test ()
+  if (.not. associated (x)) call abort
+  if (size (x) .ne. 10) call abort
+contains
+  function test
+    real, dimension (:), pointer :: test
+    if (associated (x)) call abort
+    allocate (test (10))
+    if (associated (x)) call abort
+  end function test
+end program main