From 5b725b8d04fff8583103bbea88f3d42f5443367d Mon Sep 17 00:00:00 2001
From: Thomas Koenig <Thomas.Koenig@online.de>
Date: Fri, 3 Mar 2006 16:18:46 +0000
Subject: [PATCH] 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
---
gcc/fortran/ChangeLog | 17 +++++++
gcc/fortran/trans-array.c | 36 ++++++++++++--
gcc/fortran/trans-array.h | 2 +-
gcc/fortran/trans-decl.c | 12 +++++
gcc/fortran/trans-stmt.c | 17 +------
gcc/fortran/trans.h | 2 +
gcc/testsuite/ChangeLog | 5 ++
.../gfortran.dg/multiple_allocation_1.f90 | 19 ++++++++
libgfortran/ChangeLog | 8 ++++
libgfortran/libgfortran.h | 1 +
libgfortran/runtime/memory.c | 47 ++++++++++++++++++-
11 files changed, 144 insertions(+), 22 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/multiple_allocation_1.f90
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4e1c223b7e88..81f27ecdcb27 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 5e4405ec2631..20647b18bc20 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 2f9fd2d74ffd..8038f40e9d0e 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 47911ff14553..41f5abe831fd 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 1c792d228ccc..2ec8ba7d181a 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 82f74e049fab..89f4058a8343 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 28dcd430c22d..8580d28d0714 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 000000000000..9c14248a05d6
--- /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
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 39039a66e9b0..ff9e599edc55 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,11 @@
+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-02-28 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/26136
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 524c57e37bcf..5efc8ae2e0ef 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -379,6 +379,7 @@ typedef enum
ERROR_READ_OVERFLOW,
ERROR_INTERNAL,
ERROR_INTERNAL_UNIT,
+ ERROR_ALLOCATION,
ERROR_LAST /* Not a real error, the last error # + 1. */
}
error_codes;
diff --git a/libgfortran/runtime/memory.c b/libgfortran/runtime/memory.c
index d52319f4f3aa..34d70f2f17b0 100644
--- a/libgfortran/runtime/memory.c
+++ b/libgfortran/runtime/memory.c
@@ -1,5 +1,5 @@
/* Memory mamagement routines.
- Copyright 2002, 2005 Free Software Foundation, Inc.
+ Copyright 2002, 2005, 2006 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfortran).
@@ -233,6 +233,51 @@ allocate64 (void **mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
allocate_size (mem, (size_t) size, stat);
}
+/* Function to call in an ALLOCATE statement when the argument is an
+ allocatable array. If the array is currently allocated, it is
+ an error to allocate it again. 32-bit version. */
+
+extern void allocate_array (void **, GFC_INTEGER_4, GFC_INTEGER_4 *);
+export_proto(allocate_array);
+
+void
+allocate_array (void **mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
+{
+ if (*mem == NULL)
+ {
+ allocate (mem, size, stat);
+ return;
+ }
+ if (stat)
+ *stat = ERROR_ALLOCATION;
+ else
+ runtime_error ("Attempting to allocate already allocated array.");
+
+ return;
+}
+
+/* Function to call in an ALLOCATE statement when the argument is an
+ allocatable array. If the array is currently allocated, it is
+ an error to allocate it again. 64-bit version. */
+
+extern void allocate64_array (void **, GFC_INTEGER_8, GFC_INTEGER_4 *);
+export_proto(allocate64_array);
+
+void
+allocate64_array (void **mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
+{
+ if (*mem == NULL)
+ {
+ allocate64 (mem, size, stat);
+ return;
+ }
+ if (stat)
+ *stat = ERROR_ALLOCATION;
+ else
+ runtime_error ("Attempting to allocate already allocated array.");
+
+ return;
+}
/* User-deallocate; pointer is NULLified. */
--
GitLab