OSDN Git Service

2006-03-03 Thomas Koenig <Thomas.Koenig@online.de>
authortkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 3 Mar 2006 16:18:46 +0000 (16:18 +0000)
committertkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 3 Mar 2006 16:18:46 +0000 (16:18 +0000)
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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@111677 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/trans-array.c
gcc/fortran/trans-array.h
gcc/fortran/trans-decl.c
gcc/fortran/trans-stmt.c
gcc/fortran/trans.h
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/multiple_allocation_1.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/libgfortran.h
libgfortran/runtime/memory.c

index 4e1c223..81f27ec 100644 (file)
@@ -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
index 5e4405e..20647b1 100644 (file)
@@ -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;
 }
 
 
index 2f9fd2d..8038f40 100644 (file)
@@ -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 47911ff..41f5abe 100644 (file)
@@ -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,
index 1c792d2..2ec8ba7 100644 (file)
@@ -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;
index 82f74e0..89f4058 100644 (file)
@@ -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;
index 28dcd43..8580d28 100644 (file)
@@ -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 (file)
index 0000000..9c14248
--- /dev/null
@@ -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
index 39039a6..ff9e599 100644 (file)
@@ -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
index 524c57e..5efc8ae 100644 (file)
@@ -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;
index d52319f..34d70f2 100644 (file)
@@ -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. */