aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog17
-rw-r--r--gcc/fortran/trans-array.c36
-rw-r--r--gcc/fortran/trans-array.h2
-rw-r--r--gcc/fortran/trans-decl.c12
-rw-r--r--gcc/fortran/trans-stmt.c17
-rw-r--r--gcc/fortran/trans.h2
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/multiple_allocation_1.f9019
-rw-r--r--libgfortran/ChangeLog8
-rw-r--r--libgfortran/libgfortran.h1
-rw-r--r--libgfortran/runtime/memory.c47
11 files changed, 144 insertions, 22 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
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 39039a6..ff9e599 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 524c57e..5efc8ae 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 d52319f..34d70f2 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. */
generated by cgit v1.1 at 2024-11-04 19:28:58 +0000