From 8a92488f1a9238839c542dd77303db2032378c42 Mon Sep 17 00:00:00 2001 From: tkoenig Date: Fri, 3 Mar 2006 16:18:46 +0000 Subject: 2006-03-03 Thomas Koenig 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 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 PR fortran/25031 * multiple_allocation_1.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@111677 138bc75d-0d04-0410-961f-82ee72b054a4 --- libgfortran/runtime/memory.c | 47 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 46 insertions(+), 1 deletion(-) (limited to 'libgfortran/runtime/memory.c') diff --git a/libgfortran/runtime/memory.c b/libgfortran/runtime/memory.c index d52319f4f3a..34d70f2f17b 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 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. */ -- cgit v1.2.1