re PR fortran/57456 ([OOP] CLASS + CHARACTER ALLOCATE with typespec: For arrays,...

2013-05-31  Tobias Burnus  <burnus@net-b.de>

        PR fortran/57456
        * trans-array.c (gfc_array_init_size): Use passed type spec,
        when available.
        (gfc_array_allocate): Pass typespec on.
        * trans-array.h (gfc_array_allocate): Update prototype.
        * trans-stmt.c (gfc_trans_allocate): Pass typespec on.

2013-05-31  Tobias Burnus  <burnus@net-b.de>

        PR fortran/57456
        * gfortran.dg/class_array_17.f90: New.

From-SVN: r199528

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index db8d1d09202e15275b2152767269018c36a595bf..8447e7a3496b6d001108dc71a2e21945d5f146f1 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2013-05-31  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/57456
+       * trans-array.c (gfc_array_init_size): Use passed type spec,
+       when available.
+       (gfc_array_allocate): Pass typespec on.
+       * trans-array.h (gfc_array_allocate): Update prototype.
+       * trans-stmt.c (gfc_trans_allocate): Pass typespec on.
+
 2013-05-31  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/54190

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index be3a5a0ef51f0284cdef8198e1d323edb911bdae..855627889c315d4866c4dd72306813fe8963dd57 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -4834,7 +4834,8 @@ static tree
 gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
                     gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock,
                     stmtblock_t * descriptor_block, tree * overflow,
-                    tree expr3_elem_size, tree *nelems, gfc_expr *expr3)
+                    tree expr3_elem_size, tree *nelems, gfc_expr *expr3,
+                    gfc_typespec *ts)
 {
   tree type;
   tree tmp;
@@ -5012,6 +5013,9 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
          tmp = TYPE_SIZE_UNIT (tmp);
        }
     }
+  else if (ts->type != BT_UNKNOWN && ts->type != BT_CHARACTER)
+    /* FIXME: Properly handle characters.  See PR 57456.  */
+    tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (ts));
   else
     tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
 
@@ -5081,7 +5085,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
 bool
 gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
                    tree errlen, tree label_finish, tree expr3_elem_size,
-                   tree *nelems, gfc_expr *expr3)
+                   tree *nelems, gfc_expr *expr3, gfc_typespec *ts)
 {
   tree tmp;
   tree pointer;
@@ -5166,7 +5170,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
   size = gfc_array_init_size (se->expr, ref->u.ar.as->rank,
                              ref->u.ar.as->corank, &offset, lower, upper,
                              &se->pre, &set_descriptor_block, &overflow,
-                             expr3_elem_size, nelems, expr3);
+                             expr3_elem_size, nelems, expr3, ts);
 
   if (dimension)
     {

diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 6f44d797fad2fec6f8de76f23d114a4eea6080e9..d00e156de22110219c7d4a0337416242534fab16 100644 (file)
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -24,7 +24,7 @@ tree gfc_array_deallocate (tree, tree, tree, tree, tree, gfc_expr*);
 /* Generate code to initialize and allocate an array.  Statements are added to
    se, which should contain an expression for the array descriptor.  */
 bool gfc_array_allocate (gfc_se *, gfc_expr *, tree, tree, tree, tree,
-                        tree, tree *, gfc_expr *);
+                        tree, tree *, gfc_expr *, gfc_typespec *);
 
 /* 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-stmt.c b/gcc/fortran/trans-stmt.c
index 781293401af25249e3d74164b7ef1f432ec2078b..7759b869e4891d41673204763ee22a722d31004f 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -4925,7 +4925,7 @@ gfc_trans_allocate (gfc_code * code)
 
       nelems = NULL_TREE;
       if (!gfc_array_allocate (&se, expr, stat, errmsg, errlen, label_finish,
-                              memsz, &nelems, code->expr3))
+                              memsz, &nelems, code->expr3, &code->ext.alloc.ts))
        {
          bool unlimited_char;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fd4ebbb1969f1a9a0ef4d90c3e76674dfe41964a..c2f600f847520753bd6c8261a10a8e18a7630ed8 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-05-31  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/57456
+       * gfortran.dg/class_array_17.f90: New.
+
 2013-05-31  Kyrylo Tkachov  <kyrylo.tkachov@arm.com>
 
        PR target/56315

diff --git a/gcc/testsuite/gfortran.dg/class_array_17.f90 b/gcc/testsuite/gfortran.dg/class_array_17.f90
new file mode 100644 (file)
index 0000000..4b3d5dd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_array_17.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/57456
+!
+module m
+  implicit none
+  type t
+    integer :: i
+   end type t
+  type, extends(t) :: t2
+    integer :: j
+   end type t2
+end module m
+
+program test
+  use m
+  implicit none
+  integer :: i
+  class(t), save, allocatable :: y(:)
+
+  allocate (t2 :: y(5))
+  select type(y)
+  type is (t2)
+    do i = 1, 5
+      y(i)%i = i
+      y(i)%j = i*10
+    end do
+  end select
+  deallocate(y)
+end
+
+! { dg-final { scan-tree-dump-times "__builtin_malloc (40);" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }