[patch] Fix fortran/25031, multiple allocations
Thomas Koenig
Thomas.Koenig@online.de
Fri Mar 3 16:21:00 GMT 2006
On Thu, Mar 02, 2006 at 08:53:45PM +0100, Paul Thomas wrote:
Hi Paul,
> OK.
Thanks!
>
> Before you commit, you might like to take a look at my version, which is
> attached. The TREE work does produce more cumbersome looking
> code(attached is the code for your testcase) than yours (or at least
> many more braces), it could do with special treatment for constant sizes
> and needs a proper code for stat. However, it is an amusing
> self-education exercise and you might care to incorporate the interface
> to gfc_allocate array.
I found it quite interesting (especially because I am currently trying
to learn walking with TREEs). I have also incorporated your change.
For the record, this is what I committed.
Thomas
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.
-------------- next part --------------
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c (revision 111562)
+++ gcc/fortran/trans-array.c (working copy)
@@ -3000,8 +3000,8 @@ gfc_array_init_size (tree descriptor, in
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;
@@ -3010,6 +3010,20 @@ gfc_array_allocate (gfc_se * se, gfc_ref
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)
@@ -3043,10 +3057,22 @@ gfc_array_allocate (gfc_se * se, gfc_ref
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 ();
@@ -3058,6 +3084,8 @@ gfc_array_allocate (gfc_se * se, gfc_ref
tmp = gfc_conv_descriptor_offset (se->expr);
gfc_add_modify_expr (&se->pre, tmp, offset);
+
+ return true;
}
Index: gcc/fortran/trans-array.h
===================================================================
--- gcc/fortran/trans-array.h (revision 111562)
+++ gcc/fortran/trans-array.h (working copy)
@@ -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 *,
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (revision 111562)
+++ gcc/fortran/trans-stmt.c (working copy)
@@ -3329,7 +3329,6 @@ gfc_trans_allocate (gfc_code * code)
gfc_se se;
tree tmp;
tree parm;
- gfc_ref *ref;
tree stat;
tree pstat;
tree error_label;
@@ -3368,21 +3367,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;
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h (revision 111562)
+++ gcc/fortran/trans.h (working copy)
@@ -455,6 +455,8 @@ extern GTY(()) tree gfor_fndecl_internal
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;
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (revision 111562)
+++ gcc/fortran/trans-decl.c (working copy)
@@ -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;
@@ -2192,6 +2194,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,
Index: libgfortran/runtime/memory.c
===================================================================
--- libgfortran/runtime/memory.c (revision 111562)
+++ libgfortran/runtime/memory.c (working copy)
@@ -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 si
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. */
Index: libgfortran/libgfortran.h
===================================================================
--- libgfortran/libgfortran.h (revision 111562)
+++ libgfortran/libgfortran.h (working copy)
@@ -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;
More information about the Fortran
mailing list