re PR fortran/27709 (Using size of array pointer component as dimension of function result causes gfortran internal error.)

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

	PR fortran/27709
	* resolve.c (find_array_spec): Add gfc_symbol, derived, and
	use to track repeated component references.

	PR fortran/27155
	PR fortran/27449
	* trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): Use
	se->string_length throughout and use memcpy to populate the
	expression returned to the scalarizer.
	(gfc_size_in_bytes): New function.

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

	PR fortran/27709
	* gfortran.dg/spec_expr_4.f90: New test.

	PR fortran/27155
	* gfortran.dg/transfer_array_intrinsic_4.f90: New test.

From-SVN: r114127

6 files changed, 138 insertions, 12 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7f80e37..0117eb6 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2006-05-26  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/27709
+	* resolve.c (find_array_spec): Add gfc_symbol, derived, and
+	use to track repeated component references.
+
+	PR fortran/27155
+	PR fortran/27449
+	* trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): Use
+	se->string_length throughout and use memcpy to populate the
+	expression returned to the scalarizer.
+	(gfc_size_in_bytes): New function.
+
 2006-05-21  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/27613
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 0affecc..660f1c0 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2285,9 +2285,11 @@ find_array_spec (gfc_expr * e)
 {
   gfc_array_spec *as;
   gfc_component *c;
+  gfc_symbol *derived;
   gfc_ref *ref;
 
   as = e->symtree->n.sym->as;
+  derived = NULL;
 
   for (ref = e->ref; ref; ref = ref->next)
     switch (ref->type)
@@ -2301,9 +2303,19 @@ find_array_spec (gfc_expr * e)
 	break;
 
       case REF_COMPONENT:
-	for (c = e->symtree->n.sym->ts.derived->components; c; c = c->next)
+	if (derived == NULL)
+	  derived = e->symtree->n.sym->ts.derived;
+
+	c = derived->components;
+
+	for (; c; c = c->next)
 	  if (c == ref->u.c.component)
-	    break;
+	    {
+	      /* Track the sequence of component references.  */
+	      if (c->ts.type == BT_DERIVED)
+		derived = c->ts.derived;
+	      break;
+	    }
 
 	if (c == NULL)
 	  gfc_internal_error ("find_array_spec(): Component not found");
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index eb5286e..1d1858c 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2482,6 +2482,30 @@ gfc_conv_intrinsic_adjust (gfc_se * se, gfc_expr * expr, tree fndecl)
 }
 
 
+/* A helper function for gfc_conv_intrinsic_array_transfer to compute
+   the size of tree expressions in bytes.  */
+static tree
+gfc_size_in_bytes (gfc_se *se, gfc_expr *e)
+{
+  tree tmp;
+
+  if (e->ts.type == BT_CHARACTER)
+    tmp = se->string_length;
+  else
+    {
+      if (e->rank)
+	{
+	  tmp = gfc_get_element_type (TREE_TYPE (se->expr));
+	  tmp = size_in_bytes (tmp);
+	}
+      else
+	tmp = size_in_bytes (TREE_TYPE (TREE_TYPE (se->expr)));
+    }
+
+  return fold_convert (gfc_array_index_type, tmp);
+}
+
+
 /* Array transfer statement.
      DEST(1:N) = TRANSFER (SOURCE, MOLD[, SIZE])
    where:
@@ -2504,6 +2528,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
   tree lower;
   tree stride;
   tree stmt;
+  tree args;
   gfc_actual_arglist *arg;
   gfc_se argse;
   gfc_ss *ss;
@@ -2530,8 +2555,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
       source = argse.expr;
 
       /* Obtain the source word length.  */
-      tmp = size_in_bytes(TREE_TYPE(TREE_TYPE (source)));
-      tmp =  fold_convert (gfc_array_index_type, tmp);
+      tmp = gfc_size_in_bytes (&argse, arg->expr);
     }
   else
     {
@@ -2569,8 +2593,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
 	}
 
       /* Obtain the source word length.  */
-      tmp = gfc_get_element_type (TREE_TYPE(argse.expr));
-      tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp));
+      tmp = gfc_size_in_bytes (&argse, arg->expr);
 
       /* Obtain the size of the array in bytes.  */
       extent = gfc_create_var (gfc_array_index_type, NULL);
@@ -2606,16 +2629,18 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
   if (ss == gfc_ss_terminator)
     {
       gfc_conv_expr_reference (&argse, arg->expr);
-      tmp = TREE_TYPE(TREE_TYPE (argse.expr));
-      tmp =  fold_convert (gfc_array_index_type, size_in_bytes(tmp));
+
+      /* Obtain the source word length.  */
+      tmp = gfc_size_in_bytes (&argse, arg->expr);
     }
   else
     {
       gfc_init_se (&argse, NULL);
       argse.want_pointer = 0;
       gfc_conv_expr_descriptor (&argse, arg->expr, ss);
-      tmp = gfc_get_element_type (TREE_TYPE(argse.expr));
-      tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp));
+
+      /* Obtain the source word length.  */
+      tmp = gfc_size_in_bytes (&argse, arg->expr);
     }
 
   dest_word_len = gfc_create_var (gfc_array_index_type, NULL);
@@ -2687,10 +2712,18 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
      data field.  This is already allocated so set callee_alloc.  */
   tmp = gfc_typenode_for_spec (&expr->ts);
   gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
-			       info, tmp, false, false, true);
+			       info, tmp, false, true, false);
 
+  /* Use memcpy to do the transfer.  */
+  tmp = gfc_conv_descriptor_data_get (info->descriptor);
+  args = gfc_chainon_list (NULL_TREE, tmp);
   tmp = fold_convert (pvoid_type_node, source);
-  gfc_conv_descriptor_data_set (&se->pre, info->descriptor, tmp);
+  args = gfc_chainon_list (args, source);
+  args = gfc_chainon_list (args, size_bytes);
+  tmp = built_in_decls[BUILT_IN_MEMCPY];
+  tmp = build_function_call_expr (tmp, args);
+  gfc_add_expr_to_block (&se->pre, tmp);
+
   se->expr = info->descriptor;
   if (expr->ts.type == BT_CHARACTER)
     se->string_length = dest_word_len;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 78fa87a..c55a9ec 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2006-05-26  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/27709
+	* gfortran.dg/spec_expr_4.f90: New test.
+
+	PR fortran/27155
+	* gfortran.dg/transfer_array_intrinsic_4.f90: New test.
+
 2006-05-25  Mark Mitchell  <mark@codesourcery.com>
 
 	PR c++/20103
diff --git a/gcc/testsuite/gfortran.dg/spec_expr_4.f90 b/gcc/testsuite/gfortran.dg/spec_expr_4.f90
new file mode 100644
index 0000000..7b2d5b6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spec_expr_4.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! Tests the fix for PR27709 in which the specification expression on
+! line 22 was not resolved because of the multiple component references.
+!
+! Contributed by David Ham  <David@ham.dropbear.id.au>
+!
+module elements
+  implicit none
+  type element_type
+     type(ele_numbering_type), pointer :: numbering
+  end type element_type
+  type ele_numbering_type
+     integer, dimension(:,:), pointer :: number2count
+  end type ele_numbering_type
+end module elements
+module global_numbering
+  use elements
+  implicit none
+contains
+  function element_local_coords(element) result (coords)
+    type(element_type), intent(in) :: element    
+    real, dimension(size(element%numbering%number2count, 1)) :: coords
+    coords=0.0 
+  end function element_local_coords
+end module global_numbering
+
+  use global_numbering
+  type (element_type) :: e
+  type (ele_numbering_type), target :: ent
+  allocate (ent%number2count (2,2))
+  e%numbering => ent
+  print *, element_local_coords (e)
+end
diff --git a/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_4.f90 b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_4.f90
new file mode 100644
index 0000000..3a929a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_4.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! Tests patch for pr27155, where character scalar string_lengths
+! were not correctly translated by the array transfer intrinsic.
+!
+! Contributed by Bo Berggren  <bo.berggren@glocalnet.net>
+!
+program trf_test
+      implicit none
+      character(11) :: s1, s2
+      integer(4) :: ia(3)
+      integer(1) :: ba(12)
+      equivalence (ia, ba)
+
+      s1 = 'ABCDEFGHIJK'
+      ia = TRANSFER (s1, (/ 0_4 /))
+      s2 = TRANSFER(ba + 32_1, s2)
+
+      if (s2 .ne. 'abcdefghijk') call abort ()
+
+      s1 = 'AB'
+      ba = TRANSFER (trim (s1)//'       JK' , (/ 0_1 /))
+      s2 = TRANSFER(ia, s2)
+
+      if (trim (s1)//'       JK' .ne. s2) call abort ()
+
+end program trf_test