Now as bonus with the proper patch.
Tobias
PS: I really wonder why Thunderbird's attach file dialog shows an
outdated directory content, unless one hits F5, if one opens the dialog
again :-(
Tobias Burnus wrote:
Currently, ALLOCATE ignores the typespec for arrays. Such that:
ALLOCATE (t2 :: var(5))
will allocate as much memory as the base type requires instead of
using as much as "t2" does.
I explicitly exclude characters as it otherwise will fail for
allocate_with_typespec_1.f90, which uses:
allocate(character :: c1(1))
The problem is that gfc_typenode_for_spec will return an array type
and not an element type, hence TYPE_SIZE_UNIT won't work. The current
version is fine, except for deferred-length strings. To properly
handle it, one has to do it as gfortran currently does for scalars.
(Best by consolidating the support. See PR.)
As I want to work on other things first, I would like to get this in
as band aid - until someone has the time to do it properly. (I found
it when trying to write a test case for the already submitted final
patch.)
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
2013-05-29 Tobias Burnus <bur...@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-29 Tobias Burnus <bur...@net-b.de>
PR fortran/57456
* gfortran.dg/class_array_17.f90: New.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index be3a5a0..b0748b7 100644
--- 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;
@@ -4834,7 +4834,8 @@ 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 +5084,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 +5169,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 6f44d79..d00e156 100644
--- 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 7812934..7759b86 100644
--- 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;
--- /dev/null 2013-05-29 07:55:34.977108520 +0200
+++ gcc/gcc/testsuite/gfortran.dg/class_array_17.f90 2013-05-29 19:36:00.239941803 +0200
@@ -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 (t :: 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 (20);" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }