re PR fortran/25031 ([4.1 only] Allocatable array can be reallocated.)

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.

From-SVN: r111677

8 files changed, 89 insertions, 21 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4e1c223..81f27ec 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,20 @@
+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-01  Roger Sayle  <roger@eyesopen.com>
 
 	* trans-stmt.c (generate_loop_for_temp_to_lhs): Add an additional
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 5e4405e..20647b1 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;
 }
 
 
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 2f9fd2d..8038f40 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -24,7 +24,7 @@ tree gfc_array_deallocate (tree, tree);
 
 /* Generate code to initialize an allocate an array.  Statements are added to
    se, which should contain an expression for the array descriptor.  */
-void gfc_array_allocate (gfc_se *, gfc_ref *, tree);
+bool gfc_array_allocate (gfc_se *, gfc_expr *, tree);
 
 /* Allow the bounds of a loop to be set from a callee's array spec.  */
 void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *,
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 47911ff..41f5abe 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -80,6 +80,8 @@ tree gfor_fndecl_internal_realloc64;
 tree gfor_fndecl_internal_free;
 tree gfor_fndecl_allocate;
 tree gfor_fndecl_allocate64;
+tree gfor_fndecl_allocate_array;
+tree gfor_fndecl_allocate64_array;
 tree gfor_fndecl_deallocate;
 tree gfor_fndecl_pause_numeric;
 tree gfor_fndecl_pause_string;
@@ -2193,6 +2195,16 @@ gfc_build_builtin_function_decls (void)
 				     void_type_node, 2, ppvoid_type_node,
 				     gfc_int8_type_node);
 
+  gfor_fndecl_allocate_array =
+    gfc_build_library_function_decl (get_identifier (PREFIX("allocate_array")),
+				     void_type_node, 2, ppvoid_type_node,
+				     gfc_int4_type_node);
+
+  gfor_fndecl_allocate64_array =
+    gfc_build_library_function_decl (get_identifier (PREFIX("allocate64_array")),
+				     void_type_node, 2, ppvoid_type_node,
+				     gfc_int8_type_node);
+
   gfor_fndecl_deallocate =
     gfc_build_library_function_decl (get_identifier (PREFIX("deallocate")),
 				     void_type_node, 2, ppvoid_type_node,
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 1c792d2..2ec8ba7 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -3389,7 +3389,6 @@ gfc_trans_allocate (gfc_code * code)
   gfc_se se;
   tree tmp;
   tree parm;
-  gfc_ref *ref;
   tree stat;
   tree pstat;
   tree error_label;
@@ -3428,21 +3427,7 @@ gfc_trans_allocate (gfc_code * code)
       se.descriptor_only = 1;
       gfc_conv_expr (&se, expr);
 
-      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)
-	{
-	  /* An array.  */
-	  gfc_array_allocate (&se, ref, pstat);
-	}
-      else
+      if (!gfc_array_allocate (&se, expr, pstat))
 	{
 	  /* A scalar or derived type.  */
 	  tree val;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 82f74e0..89f4058 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -455,6 +455,8 @@ extern GTY(()) tree gfor_fndecl_internal_realloc64;
 extern GTY(()) tree gfor_fndecl_internal_free;
 extern GTY(()) tree gfor_fndecl_allocate;
 extern GTY(()) tree gfor_fndecl_allocate64;
+extern GTY(()) tree gfor_fndecl_allocate_array;
+extern GTY(()) tree gfor_fndecl_allocate64_array;
 extern GTY(()) tree gfor_fndecl_deallocate;
 extern GTY(()) tree gfor_fndecl_pause_numeric;
 extern GTY(()) tree gfor_fndecl_pause_string;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 28dcd43..8580d28 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-03-03  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/25031
+	* multiple_allocation_1.f90:  New test.
+
 2006-03-03  Roger Sayle  <roger@eyesopen.com>
 
 	PR tree-optimization/26524
diff --git a/gcc/testsuite/gfortran.dg/multiple_allocation_1.f90 b/gcc/testsuite/gfortran.dg/multiple_allocation_1.f90
new file mode 100644
index 0000000..9c14248
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/multiple_allocation_1.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! PR 25031 - We didn't cause an error when allocating an already
+!            allocated array.
+program alloc_test
+  implicit none
+  integer :: i
+  integer, allocatable :: a(:)
+  integer, pointer :: b(:)
+
+  allocate(a(4))
+  ! This should set the stat code without changing the size
+  allocate(a(4),stat=i)
+  if (i == 0) call abort
+  if (.not. allocated(a)) call abort
+  ! It's OK to allocate pointers twice (even though this causes
+  ! a memory leak)
+  allocate(b(4))
+  allocate(b(4))
+end program