2006-03-03 Thomas Koenig <Thomas.Koenig@online.de>

	PR fortran/25031
	* trans-array.h:  Adjust gfc_array_allocate prototype.
	* trans-array.c (gfc_array_allocate):  Change type of
	gfc_array_allocatate to bool.  Function returns true if
	it operates on an array.  Change second argument to gfc_expr.
	Find last reference in chain.
	If the function operates on an allocatable array, emit call to
	allocate_array() or allocate64_array().
	* trans-stmt.c (gfc_trans_allocate):  Code to follow to last
	reference has been moved to gfc_array_allocate.
	* trans.h:  Add declaration for gfor_fndecl_allocate_array and
	gfor_fndecl_allocate64_array.
	(gfc_build_builtin_function_decls):  Add gfor_fndecl_allocate_array
	and gfor_fndecl_allocate64_array.

2006-03-03  Thomas Koenig  <Thomas.Koenig@online.de>

	PR fortran/25031
	* runtime/memory.c:  Adjust copyright years.
	(allocate_array):  New function.
	(allocate64_array):  New function.
	* libgfortran.h (error_codes):  Add ERROR_ALLOCATION.

2006-03-03  Thomas Koenig  <Thomas.Koenig@online.de>

	PR fortran/25031
	* multiple_allocation_1.f90:  New test.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@111677 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 32 insertions, 4 deletions

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 5e4405ec263..20647b18bc2 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3001,8 +3001,8 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset,
    the work for an ALLOCATE statement.  */
 /*GCC ARRAYS*/
 
-void
-gfc_array_allocate (gfc_se * se, gfc_ref * ref, tree pstat)
+bool
+gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
 {
   tree tmp;
   tree pointer;
@@ -3011,6 +3011,20 @@ gfc_array_allocate (gfc_se * se, gfc_ref * ref, tree pstat)
   tree size;
   gfc_expr **lower;
   gfc_expr **upper;
+  gfc_ref *ref;
+  int allocatable_array;
+
+  ref = expr->ref;
+
+  /* Find the last reference in the chain.  */
+  while (ref && ref->next != NULL)
+    {
+      gcc_assert (ref->type != REF_ARRAY || ref->u.ar.type == AR_ELEMENT);
+      ref = ref->next;
+    }
+
+  if (ref == NULL || ref->type != REF_ARRAY)
+    return false;
 
   /* Figure out the size of the array.  */
   switch (ref->u.ar.type)
@@ -3044,10 +3058,22 @@ gfc_array_allocate (gfc_se * se, gfc_ref * ref, tree pstat)
   tmp = gfc_conv_descriptor_data_addr (se->expr);
   pointer = gfc_evaluate_now (tmp, &se->pre);
 
+  allocatable_array = expr->symtree->n.sym->attr.allocatable;
+
   if (TYPE_PRECISION (gfc_array_index_type) == 32)
-    allocate = gfor_fndecl_allocate;
+    {
+      if (allocatable_array)
+	allocate = gfor_fndecl_allocate_array;
+      else
+	allocate = gfor_fndecl_allocate;
+    }
   else if (TYPE_PRECISION (gfc_array_index_type) == 64)
-    allocate = gfor_fndecl_allocate64;
+    {
+      if (allocatable_array)
+	allocate = gfor_fndecl_allocate64_array;
+      else
+	allocate = gfor_fndecl_allocate64;
+    }
   else
     gcc_unreachable ();
 
@@ -3059,6 +3085,8 @@ gfc_array_allocate (gfc_se * se, gfc_ref * ref, tree pstat)
 
   tmp = gfc_conv_descriptor_offset (se->expr);
   gfc_add_modify_expr (&se->pre, tmp, offset);
+
+  return true;
 }