re PR fortran/25619 (temporary array of constant size character type goes wrong)

gcc/fortran/

2006-04-04  H.J. Lu  <hongjiu.lu@intel.com>

	PR fortran/25619
	* trans-array.c (gfc_conv_expr_descriptor): Only dereference
	character pointer when copying temporary.

	PR fortran/23634
	* trans-array.c (gfc_conv_expr_descriptor): Properly copy
	temporary character with non constant size.

gcc/testsuite/

2006-04-04  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/23634
	PR fortran/25619
	* gfortran.dg/actual_array_constructor_1.f90: New testcase.

From-SVN: r112695

gcc/fortran/ChangeLog

@@ -1,3 +1,13 @@
+2006-04-04  H.J. Lu  <hongjiu.lu@intel.com>
+
+	PR fortran/25619
+	* trans-array.c (gfc_conv_expr_descriptor): Only dereference
+	character pointer when copying temporary.
+
+	PR fortran/23634
+	* trans-array.c (gfc_conv_expr_descriptor): Properly copy
+	temporary character with non constant size.
+
 2006-04-03  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/26981

gcc/fortran/trans-array.c

@@ -3973,23 +3973,32 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       loop.temp_ss->next = gfc_ss_terminator;
       if (expr->ts.type == BT_CHARACTER)
 	{
-	  gcc_assert (expr->ts.cl && expr->ts.cl->length
-		      && expr->ts.cl->length->expr_type == EXPR_CONSTANT);
-	  loop.temp_ss->string_length = gfc_conv_mpz_to_tree
-			(expr->ts.cl->length->value.integer,
-			 expr->ts.cl->length->ts.kind);
-	  expr->ts.cl->backend_decl = loop.temp_ss->string_length;
-	}
-        loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
-
-      /* ... which can hold our string, if present.  */
-      if (expr->ts.type == BT_CHARACTER)
-	{
-	  loop.temp_ss->string_length = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type);
+	  if (expr->ts.cl
+	      && expr->ts.cl->length
+	      && expr->ts.cl->length->expr_type == EXPR_CONSTANT)
+	    {
+	      expr->ts.cl->backend_decl
+		= gfc_conv_mpz_to_tree (expr->ts.cl->length->value.integer,
+					expr->ts.cl->length->ts.kind);
+	      loop.temp_ss->data.temp.type
+		= gfc_typenode_for_spec (&expr->ts);
+	      loop.temp_ss->string_length
+		= TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type);
+	    }
+	  else
+	    {
+	      loop.temp_ss->data.temp.type
+		= gfc_typenode_for_spec (&expr->ts);
+	      loop.temp_ss->string_length = expr->ts.cl->backend_decl;
+	    }
 	  se->string_length = loop.temp_ss->string_length;
 	}
       else
-	loop.temp_ss->string_length = NULL;
+	{
+	  loop.temp_ss->data.temp.type
+	    = gfc_typenode_for_spec (&expr->ts);
+	  loop.temp_ss->string_length = NULL;
+	}
       loop.temp_ss->data.temp.dimen = loop.dimen;
       gfc_add_ss_to_loop (&loop, loop.temp_ss);
     }
@@ -4022,7 +4031,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       if (expr->ts.type == BT_CHARACTER)
 	{
 	  gfc_conv_expr (&rse, expr);
-	  rse.expr = build_fold_indirect_ref (rse.expr);
+	  if (POINTER_TYPE_P (TREE_TYPE (rse.expr)))
+	    rse.expr = build_fold_indirect_ref (rse.expr);
 	}
       else
         gfc_conv_expr_val (&rse, expr);

gcc/testsuite/ChangeLog

@@ -1,3 +1,9 @@
+2006-04-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/23634
+	PR fortran/25619
+	* gfortran.dg/actual_array_constructor_1.f90: New testcase.
+
 2006-04-04  Eric Christopher  <echristo@apple.com>
 
 	* gcc.target/i386/387-1.c: Allow regexp to match darwin

gcc/testsuite/gfortran.dg/actual_array_constructor_1.f90

@@ -0,0 +1,82 @@
+! { dg-do run }
+! Test the fix by HJ Lu for PR23634 and friends. All involve the ICE
+! that arose from a character array constructor usedas an actual
+! argument.
+!
+! The various parts of this test are taken from the PRs.
+!
+! Test PR26491
+module global
+  public    p, line
+  interface p
+    module procedure p
+  end interface
+  character(128) :: line = 'abcdefghijklmnopqrstuvwxyz'
+contains
+  subroutine p()
+    character(128) :: word
+    word = line
+    call redirect_((/word/))
+  end subroutine
+  subroutine redirect_ (ch)
+    character(*) :: ch(:)
+    if (ch(1) /= line) call abort ()
+  end subroutine redirect_
+end module global
+
+! Test PR26550
+module my_module
+  implicit none
+  type point
+    real :: x
+  end type point
+  type(point), pointer, public :: stdin => NULL()
+contains
+  subroutine my_p(w)
+    character(128) :: w
+    call r(stdin,(/w/))
+  end subroutine my_p
+  subroutine r(ptr, io)
+    use global
+    type(point), pointer :: ptr
+    character(128) :: io(:)
+    if (associated (ptr)) call abort ()
+    if (io(1) .ne. line) call abort ()
+  end subroutine r
+end module my_module
+
+program main
+  use global
+  use my_module
+
+  integer :: i(6) = (/1,6,3,4,5,2/)
+  character (6) :: a = 'hello ', t
+  character(len=1) :: s(6) = (/'g','g','d','d','a','o'/)
+  equivalence (s, t)
+
+  call option_stopwatch_s (a) ! Call test of PR25619
+  call p ()                   ! Call test of PR26491
+  call my_p (line)            ! Call test of PR26550
+
+! Test Vivek Rao's bug, as reported in PR25619.
+  s = s(i)
+  call option_stopwatch_a ((/a,'hola! ', t/))
+
+contains
+
+! Test PR23634
+  subroutine option_stopwatch_s(a)
+    character (*), intent(in) :: a
+    character (len=len(a)) :: b
+
+    b = 'hola! '
+    call option_stopwatch_a((/a, b, 'goddag'/))
+  end subroutine option_stopwatch_s 
+  subroutine option_stopwatch_a (a)
+    character (*) :: a(:)
+    if (any (a .ne. (/'hello ','hola! ','goddag'/))) call abort ()
+  end subroutine option_stopwatch_a
+
+end program main
+! { dg-final { cleanup-modules "global my_module" } }
+