+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
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;
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)
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 ();
tmp = gfc_conv_descriptor_offset (se->expr);
gfc_add_modify_expr (&se->pre, tmp, offset);
+
+ return true;
}
/* 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 *,
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;
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,
gfc_se se;
tree tmp;
tree parm;
- gfc_ref *ref;
tree stat;
tree pstat;
tree error_label;
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;
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;
+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
--- /dev/null
+! { 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
+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
ERROR_READ_OVERFLOW,
ERROR_INTERNAL,
ERROR_INTERNAL_UNIT,
+ ERROR_ALLOCATION,
ERROR_LAST /* Not a real error, the last error # + 1. */
}
error_codes;
/* 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).
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. */
git://gcc.gnu.org / gcc.git / commitdiff