* [PATCH, Fortran, v1] Restructure initialization of allocatable components
@ 2016-11-03 13:16 Andre Vehreschild
2016-11-04 0:58 ` Steve Kargl
2016-11-06 19:22 ` Mikael Morin
0 siblings, 2 replies; 5+ messages in thread
From: Andre Vehreschild @ 2016-11-03 13:16 UTC (permalink / raw)
To: GCC-Patches-ML, GCC-Fortran-ML, Dominique Dhumieres
[-- Attachment #1: Type: text/plain, Size: 1800 bytes --]
Hi all,
the attached patch restructures gfortran's way of initializing components of
derived types in ALLOCATE. The old way was to generate a new gfc_code-node and
add it after the ALLOCATE node to initialize the the derived type on certain
conditions (like initializer or allocatable components exist). This patch
proposes to do the initialization as part of the ALLOCATE. This way it makes the
ALLOCATE-statement more atomic in that the ALLOCATE does everything it is
responsible for itself and does rely on other nodes adding to its
responsibilities. The patch furthermore enables to use the knowledge we have in
the allocate, i.e., a freshly allocated object can never have allocated
allocatable components, so no need to check before resetting them.
At the same time I remove some dead code from the resolve_alloc_expr and moved
a loop invariant piece out of the loop iterating over all objects to allocate.
This of course is only cosmetic.
Of course did I not do this out of fun. I have a patch upcoming for allocatable
components in coarrayed derived types. For this I needed to identify the
initialization of the structure and to parameterize it further. This was hard
when for the default initialization an additional code-node was created, but
now that everything necessary for ALLOCATE is done in ALLOCATE parameterizing
the initialization is way easier. The coarray patch is not yet perfect, but I
thought to publish this part already to get your opinions.
Bootstraps and regtests fine on x86_64-linux/F23. Ok for trunk?
@Dominique: Would you give it a go on your open patch collection? Maybe it
fixes one PR, but I am not very hopeful, because the patch is merely removing
complexity instead of doing new things.
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: rework_derived_alloc.clog --]
[-- Type: application/octet-stream, Size: 1296 bytes --]
gcc/testsuite/ChangeLog:
2016-11-03 Andre Vehreschild <vehre@gcc.gnu.org>
* gfortran.dg/allocate_with_source_14.f03: Fixed number mallocs
occuring.
gcc/fortran/ChangeLog:
2016-11-03 Andre Vehreschild <vehre@gcc.gnu.org>
* expr.c (is_non_empty_structure_constructor): New function to detect
non-empty structure constructor.
(gfc_has_default_initializer): Analyse initializers.
* resolve.c (cond_init): Removed.
(resolve_allocate_expr): Removed dead code. Moved invariant code out
of the loop over all objects to allocate.
(resolve_allocate_deallocate): Added the invariant code remove from
resolve_allocate_expr.
* trans-array.c (gfc_array_allocate): Removed nullify of structure
components in favour of doing this in gfc_trans_allocate for both
scalars and arrays in the same place.
* trans-expr.c (gfc_trans_init_assign): Always using _vptr->copy for
class objects.
* trans-stmt.c (allocate_get_initializer): Get the initializer
expression for object allocated.
(gfc_trans_allocate): Nullify a derived type only, when no SOURCE=
or MOLD= is present preventing duplicate work. Moved the creation
of the init-expression here to prevent code for conditions that
can not occur on freshly allocated object, like checking for the need
to free allocatable components.
[-- Attachment #3: rework_derived_alloc.patch --]
[-- Type: text/x-patch, Size: 10023 bytes --]
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index bb183d4..0e94ae8 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4131,6 +4131,26 @@ gfc_apply_init (gfc_typespec *ts, symbol_attribute *attr, gfc_expr *init)
}
+/* Check whether an expression is a structure constructor and whether it has
+ other values than NULL. */
+
+bool
+is_non_empty_structure_constructor (gfc_expr * e)
+{
+ if (e->expr_type != EXPR_STRUCTURE)
+ return false;
+
+ gfc_constructor *cons = gfc_constructor_first (e->value.constructor);
+ while (cons)
+ {
+ if (!cons->expr || cons->expr->expr_type != EXPR_NULL)
+ return true;
+ cons = gfc_constructor_next (cons);
+ }
+ return false;
+}
+
+
/* Check for default initializer; sym->value is not enough
as it is also set for EXPR_NULL of allocatables. */
@@ -4145,7 +4165,9 @@ gfc_has_default_initializer (gfc_symbol *der)
{
if (!c->attr.pointer && !c->attr.proc_pointer
&& !(c->attr.allocatable && der == c->ts.u.derived)
- && gfc_has_default_initializer (c->ts.u.derived))
+ && ((c->initializer
+ && is_non_empty_structure_constructor (c->initializer))
+ || gfc_has_default_initializer (c->ts.u.derived)))
return true;
if (c->attr.pointer && c->initializer)
return true;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 14685d2..c341bbc 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7046,35 +7046,6 @@ conformable_arrays (gfc_expr *e1, gfc_expr *e2)
return true;
}
-static void
-cond_init (gfc_code *code, gfc_expr *e, int pointer, gfc_expr *init_e)
-{
- gfc_code *block;
- gfc_expr *cond;
- gfc_code *init_st;
- gfc_expr *e_to_init = gfc_expr_to_initialize (e);
-
- cond = pointer
- ? gfc_build_intrinsic_call (gfc_current_ns, GFC_ISYM_ASSOCIATED,
- "associated", code->loc, 2, gfc_copy_expr (e_to_init), NULL)
- : gfc_build_intrinsic_call (gfc_current_ns, GFC_ISYM_ALLOCATED,
- "allocated", code->loc, 1, gfc_copy_expr (e_to_init));
-
- init_st = gfc_get_code (EXEC_INIT_ASSIGN);
- init_st->loc = code->loc;
- init_st->expr1 = e_to_init;
- init_st->expr2 = init_e;
-
- block = gfc_get_code (EXEC_IF);
- block->loc = code->loc;
- block->block = gfc_get_code (EXEC_IF);
- block->block->loc = code->loc;
- block->block->expr1 = cond;
- block->block->next = init_st;
- block->next = code->next;
-
- code->next = block;
-}
/* Resolve the expression in an ALLOCATE statement, doing the additional
checks to see whether the expression is OK or not. The expression must
@@ -7325,34 +7296,6 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
/* We have to zero initialize the integer variable. */
code->expr3 = gfc_get_int_expr (gfc_default_integer_kind, &e->where, 0);
}
- else if (!code->expr3)
- {
- /* Set up default initializer if needed. */
- gfc_typespec ts;
- gfc_expr *init_e;
-
- if (gfc_bt_struct (code->ext.alloc.ts.type))
- ts = code->ext.alloc.ts;
- else
- ts = e->ts;
-
- if (ts.type == BT_CLASS)
- ts = ts.u.derived->components->ts;
-
- if (gfc_bt_struct (ts.type) && (init_e = gfc_default_initializer (&ts)))
- cond_init (code, e, pointer, init_e);
- }
- else if (code->expr3->mold && code->expr3->ts.type == BT_DERIVED)
- {
- /* Default initialization via MOLD (non-polymorphic). */
- gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts);
- if (rhs != NULL)
- {
- gfc_resolve_expr (rhs);
- gfc_free_expr (code->expr3);
- code->expr3 = rhs;
- }
- }
if (e->ts.type == BT_CLASS && !unlimited && !UNLIMITED_POLY (code->expr3))
{
@@ -7364,10 +7307,9 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
else if (code->ext.alloc.ts.type == BT_DERIVED)
ts = code->ext.alloc.ts;
+ /* Finding the vtab also publishes the type's symbol. Therefore this
+ statement is necessary. */
gfc_find_derived_vtab (ts.u.derived);
-
- if (dimension)
- e = gfc_expr_to_initialize (e);
}
else if (unlimited && !UNLIMITED_POLY (code->expr3))
{
@@ -7381,10 +7323,9 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
gcc_assert (ts);
+ /* Finding the vtab also publishes the type's symbol. Therefore this
+ statement is necessary. */
gfc_find_vtab (ts);
-
- if (dimension)
- e = gfc_expr_to_initialize (e);
}
if (dimension == 0 && codimension == 0)
@@ -7688,6 +7629,22 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
if (strcmp (fcn, "ALLOCATE") == 0)
{
bool arr_alloc_wo_spec = false;
+
+ /* Resolving the expr3 in the loop over all objects to allocate would
+ execute loop invariant code for each loop item. Therefore do it just
+ once here. */
+ if (code->expr3 && code->expr3->mold
+ && code->expr3->ts.type == BT_DERIVED)
+ {
+ /* Default initialization via MOLD (non-polymorphic). */
+ gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts);
+ if (rhs != NULL)
+ {
+ gfc_resolve_expr (rhs);
+ gfc_free_expr (code->expr3);
+ code->expr3 = rhs;
+ }
+ }
for (a = code->ext.alloc.list; a; a = a->next)
resolve_allocate_expr (a->expr, code, &arr_alloc_wo_spec);
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 74935b1..1708f7c 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5623,14 +5623,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
else
gfc_add_expr_to_block (&se->pre, set_descriptor);
- if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp
- && !coarray)
- {
- tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, se->expr,
- ref->u.ar.as->rank);
- gfc_add_expr_to_block (&se->pre, tmp);
- }
-
return true;
}
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 7159b17..b5bcb22 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -10036,7 +10036,7 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
tree
gfc_trans_init_assign (gfc_code * code)
{
- return gfc_trans_assignment (code->expr1, code->expr2, true, false);
+ return gfc_trans_assignment (code->expr1, code->expr2, true, false, true);
}
tree
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index c52066f..490b18d 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5450,13 +5450,41 @@ gfc_trans_exit (gfc_code * code)
}
+/* Get the initializer expression for the code and expr of an allocate.
+ When no initializer is needed return NULL. */
+
+static gfc_expr *
+allocate_get_initializer (gfc_code * code, gfc_expr * expr)
+{
+ if (!gfc_bt_struct (expr->ts.type) && expr->ts.type != BT_CLASS)
+ return NULL;
+
+ /* An explicit type was given in allocate ( T:: object). */
+ if (code->ext.alloc.ts.type == BT_DERIVED
+ && (code->ext.alloc.ts.u.derived->attr.alloc_comp
+ || gfc_has_default_initializer (code->ext.alloc.ts.u.derived)))
+ return gfc_default_initializer (&code->ext.alloc.ts);
+
+ if (gfc_bt_struct (expr->ts.type)
+ && (expr->ts.u.derived->attr.alloc_comp
+ || gfc_has_default_initializer (expr->ts.u.derived)))
+ return gfc_default_initializer (&expr->ts);
+
+ if (expr->ts.type == BT_CLASS
+ && (CLASS_DATA (expr)->ts.u.derived->attr.alloc_comp
+ || gfc_has_default_initializer (CLASS_DATA (expr)->ts.u.derived)))
+ return gfc_default_initializer (&CLASS_DATA (expr)->ts);
+
+ return NULL;
+}
+
/* Translate the ALLOCATE statement. */
tree
gfc_trans_allocate (gfc_code * code)
{
gfc_alloc *al;
- gfc_expr *expr, *e3rhs = NULL;
+ gfc_expr *expr, *e3rhs = NULL, *init_expr;
gfc_se se, se_sz;
tree tmp;
tree parm;
@@ -6080,14 +6108,6 @@ gfc_trans_allocate (gfc_code * code)
label_finish, expr, 0);
else
gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat);
-
- if (al->expr->ts.type == BT_DERIVED
- && expr->ts.u.derived->attr.alloc_comp)
- {
- tmp = build_fold_indirect_ref_loc (input_location, se.expr);
- tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0);
- gfc_add_expr_to_block (&se.pre, tmp);
- }
}
else
{
@@ -6217,6 +6237,8 @@ gfc_trans_allocate (gfc_code * code)
fold_convert (TREE_TYPE (al_len),
integer_zero_node));
}
+
+ init_expr = NULL;
if (code->expr3 && !code->expr3->mold && e3_is != E3_MOLD)
{
/* Initialization via SOURCE block (or static default initializer).
@@ -6246,6 +6268,23 @@ gfc_trans_allocate (gfc_code * code)
gfc_free_statements (ini);
gfc_add_expr_to_block (&block, tmp);
}
+ else if ((init_expr = allocate_get_initializer (code, expr)))
+ {
+ /* Use class_init_assign to initialize expr. */
+ gfc_code *ini;
+ int realloc_lhs = flag_realloc_lhs;
+ ini = gfc_get_code (EXEC_INIT_ASSIGN);
+ ini->expr1 = gfc_expr_to_initialize (expr);
+ ini->expr2 = init_expr;
+ flag_realloc_lhs = 0;
+ tmp= gfc_trans_init_assign (ini);
+ flag_realloc_lhs = realloc_lhs;
+ gfc_free_statements (ini);
+ /* Init_expr is freeed by above free_statements, just need to null
+ it here. */
+ init_expr = NULL;
+ gfc_add_expr_to_block (&block, tmp);
+ }
gfc_free_expr (expr);
} // for-loop
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03 b/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03
index 36c1245..fd2db74 100644
--- a/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03
@@ -210,5 +210,5 @@ program main
call v%free()
deallocate(av)
end program
-! { dg-final { scan-tree-dump-times "__builtin_malloc" 23 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_malloc" 22 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_free" 29 "original" } }
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [PATCH, Fortran, v1] Restructure initialization of allocatable components
2016-11-03 13:16 [PATCH, Fortran, v1] Restructure initialization of allocatable components Andre Vehreschild
@ 2016-11-04 0:58 ` Steve Kargl
2016-11-05 9:46 ` Paul Richard Thomas
2016-11-06 19:22 ` Mikael Morin
1 sibling, 1 reply; 5+ messages in thread
From: Steve Kargl @ 2016-11-04 0:58 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: GCC-Patches-ML, GCC-Fortran-ML, Dominique Dhumieres
On Thu, Nov 03, 2016 at 02:16:48PM +0100, Andre Vehreschild wrote:
>
> Bootstraps and regtests fine on x86_64-linux/F23. Ok for trunk?
>
> @Dominique: Would you give it a go on your open patch collection? Maybe it
> fixes one PR, but I am not very hopeful, because the patch is merely removing
> complexity instead of doing new things.
>
Andre,
I did not see anything that looked dubious. I think
it is OK to commit, but you may want to see if Paul
has any comment.
--
Steve
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [PATCH, Fortran, v1] Restructure initialization of allocatable components
2016-11-04 0:58 ` Steve Kargl
@ 2016-11-05 9:46 ` Paul Richard Thomas
2016-11-06 16:13 ` Andre Vehreschild
0 siblings, 1 reply; 5+ messages in thread
From: Paul Richard Thomas @ 2016-11-05 9:46 UTC (permalink / raw)
To: kargl
Cc: Andre Vehreschild, GCC-Patches-ML, GCC-Fortran-ML, Dominique Dhumieres
Dear Andre,
The patch looks fine to me. OK for trunk.
Cheers
Paul
On 4 November 2016 at 01:57, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> On Thu, Nov 03, 2016 at 02:16:48PM +0100, Andre Vehreschild wrote:
>>
>> Bootstraps and regtests fine on x86_64-linux/F23. Ok for trunk?
>>
>> @Dominique: Would you give it a go on your open patch collection? Maybe it
>> fixes one PR, but I am not very hopeful, because the patch is merely removing
>> complexity instead of doing new things.
>>
>
> Andre,
>
> I did not see anything that looked dubious. I think
> it is OK to commit, but you may want to see if Paul
> has any comment.
>
> --
> Steve
--
The difference between genius and stupidity is; genius has its limits.
Albert Einstein
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [PATCH, Fortran, v1] Restructure initialization of allocatable components
2016-11-05 9:46 ` Paul Richard Thomas
@ 2016-11-06 16:13 ` Andre Vehreschild
0 siblings, 0 replies; 5+ messages in thread
From: Andre Vehreschild @ 2016-11-06 16:13 UTC (permalink / raw)
To: Paul Richard Thomas
Cc: kargl, GCC-Patches-ML, GCC-Fortran-ML, Dominique Dhumieres
[-- Attachment #1: Type: text/plain, Size: 1035 bytes --]
Hi Steve, hi Paul, hi Dominique, hi all,
thanks for the reviews, Steve and Paul, thanks for the heavy testing, Dominique.
Committed as r241885.
Regards,
Andre
On Sat, 5 Nov 2016 10:46:46 +0100
Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:
> Dear Andre,
>
> The patch looks fine to me. OK for trunk.
>
> Cheers
>
> Paul
>
> On 4 November 2016 at 01:57, Steve Kargl
> <sgk@troutmask.apl.washington.edu> wrote:
> > On Thu, Nov 03, 2016 at 02:16:48PM +0100, Andre Vehreschild wrote:
> >>
> >> Bootstraps and regtests fine on x86_64-linux/F23. Ok for trunk?
> >>
> >> @Dominique: Would you give it a go on your open patch collection? Maybe it
> >> fixes one PR, but I am not very hopeful, because the patch is merely
> >> removing complexity instead of doing new things.
> >>
> >
> > Andre,
> >
> > I did not see anything that looked dubious. I think
> > it is OK to commit, but you may want to see if Paul
> > has any comment.
> >
> > --
> > Steve
>
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 11398 bytes --]
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 241884)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,26 @@
+2016-11-06 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ * expr.c (is_non_empty_structure_constructor): New function to detect
+ non-empty structure constructor.
+ (gfc_has_default_initializer): Analyse initializers.
+ * resolve.c (cond_init): Removed.
+ (resolve_allocate_expr): Removed dead code. Moved invariant code out
+ of the loop over all objects to allocate.
+ (resolve_allocate_deallocate): Added the invariant code remove from
+ resolve_allocate_expr.
+ * trans-array.c (gfc_array_allocate): Removed nullify of structure
+ components in favour of doing this in gfc_trans_allocate for both
+ scalars and arrays in the same place.
+ * trans-expr.c (gfc_trans_init_assign): Always using _vptr->copy for
+ class objects.
+ * trans-stmt.c (allocate_get_initializer): Get the initializer
+ expression for object allocated.
+ (gfc_trans_allocate): Nullify a derived type only, when no SOURCE=
+ or MOLD= is present preventing duplicate work. Moved the creation
+ of the init-expression here to prevent code for conditions that
+ can not occur on freshly allocated object, like checking for the need
+ to free allocatable components.
+
2016-11-06 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/78221
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c (Revision 241884)
+++ gcc/fortran/expr.c (Arbeitskopie)
@@ -4131,6 +4131,26 @@
}
+/* Check whether an expression is a structure constructor and whether it has
+ other values than NULL. */
+
+bool
+is_non_empty_structure_constructor (gfc_expr * e)
+{
+ if (e->expr_type != EXPR_STRUCTURE)
+ return false;
+
+ gfc_constructor *cons = gfc_constructor_first (e->value.constructor);
+ while (cons)
+ {
+ if (!cons->expr || cons->expr->expr_type != EXPR_NULL)
+ return true;
+ cons = gfc_constructor_next (cons);
+ }
+ return false;
+}
+
+
/* Check for default initializer; sym->value is not enough
as it is also set for EXPR_NULL of allocatables. */
@@ -4145,7 +4165,9 @@
{
if (!c->attr.pointer && !c->attr.proc_pointer
&& !(c->attr.allocatable && der == c->ts.u.derived)
- && gfc_has_default_initializer (c->ts.u.derived))
+ && ((c->initializer
+ && is_non_empty_structure_constructor (c->initializer))
+ || gfc_has_default_initializer (c->ts.u.derived)))
return true;
if (c->attr.pointer && c->initializer)
return true;
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (Revision 241884)
+++ gcc/fortran/resolve.c (Arbeitskopie)
@@ -7048,36 +7048,7 @@
return true;
}
-static void
-cond_init (gfc_code *code, gfc_expr *e, int pointer, gfc_expr *init_e)
-{
- gfc_code *block;
- gfc_expr *cond;
- gfc_code *init_st;
- gfc_expr *e_to_init = gfc_expr_to_initialize (e);
- cond = pointer
- ? gfc_build_intrinsic_call (gfc_current_ns, GFC_ISYM_ASSOCIATED,
- "associated", code->loc, 2, gfc_copy_expr (e_to_init), NULL)
- : gfc_build_intrinsic_call (gfc_current_ns, GFC_ISYM_ALLOCATED,
- "allocated", code->loc, 1, gfc_copy_expr (e_to_init));
-
- init_st = gfc_get_code (EXEC_INIT_ASSIGN);
- init_st->loc = code->loc;
- init_st->expr1 = e_to_init;
- init_st->expr2 = init_e;
-
- block = gfc_get_code (EXEC_IF);
- block->loc = code->loc;
- block->block = gfc_get_code (EXEC_IF);
- block->block->loc = code->loc;
- block->block->expr1 = cond;
- block->block->next = init_st;
- block->next = code->next;
-
- code->next = block;
-}
-
/* Resolve the expression in an ALLOCATE statement, doing the additional
checks to see whether the expression is OK or not. The expression must
have a trailing array reference that gives the size of the array. */
@@ -7327,35 +7298,7 @@
/* We have to zero initialize the integer variable. */
code->expr3 = gfc_get_int_expr (gfc_default_integer_kind, &e->where, 0);
}
- else if (!code->expr3)
- {
- /* Set up default initializer if needed. */
- gfc_typespec ts;
- gfc_expr *init_e;
- if (gfc_bt_struct (code->ext.alloc.ts.type))
- ts = code->ext.alloc.ts;
- else
- ts = e->ts;
-
- if (ts.type == BT_CLASS)
- ts = ts.u.derived->components->ts;
-
- if (gfc_bt_struct (ts.type) && (init_e = gfc_default_initializer (&ts)))
- cond_init (code, e, pointer, init_e);
- }
- else if (code->expr3->mold && code->expr3->ts.type == BT_DERIVED)
- {
- /* Default initialization via MOLD (non-polymorphic). */
- gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts);
- if (rhs != NULL)
- {
- gfc_resolve_expr (rhs);
- gfc_free_expr (code->expr3);
- code->expr3 = rhs;
- }
- }
-
if (e->ts.type == BT_CLASS && !unlimited && !UNLIMITED_POLY (code->expr3))
{
/* Make sure the vtab symbol is present when
@@ -7366,10 +7309,9 @@
else if (code->ext.alloc.ts.type == BT_DERIVED)
ts = code->ext.alloc.ts;
+ /* Finding the vtab also publishes the type's symbol. Therefore this
+ statement is necessary. */
gfc_find_derived_vtab (ts.u.derived);
-
- if (dimension)
- e = gfc_expr_to_initialize (e);
}
else if (unlimited && !UNLIMITED_POLY (code->expr3))
{
@@ -7383,10 +7325,9 @@
gcc_assert (ts);
+ /* Finding the vtab also publishes the type's symbol. Therefore this
+ statement is necessary. */
gfc_find_vtab (ts);
-
- if (dimension)
- e = gfc_expr_to_initialize (e);
}
if (dimension == 0 && codimension == 0)
@@ -7690,6 +7631,22 @@
if (strcmp (fcn, "ALLOCATE") == 0)
{
bool arr_alloc_wo_spec = false;
+
+ /* Resolving the expr3 in the loop over all objects to allocate would
+ execute loop invariant code for each loop item. Therefore do it just
+ once here. */
+ if (code->expr3 && code->expr3->mold
+ && code->expr3->ts.type == BT_DERIVED)
+ {
+ /* Default initialization via MOLD (non-polymorphic). */
+ gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts);
+ if (rhs != NULL)
+ {
+ gfc_resolve_expr (rhs);
+ gfc_free_expr (code->expr3);
+ code->expr3 = rhs;
+ }
+ }
for (a = code->ext.alloc.list; a; a = a->next)
resolve_allocate_expr (a->expr, code, &arr_alloc_wo_spec);
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (Revision 241884)
+++ gcc/fortran/trans-expr.c (Arbeitskopie)
@@ -10042,7 +10042,7 @@
tree
gfc_trans_init_assign (gfc_code * code)
{
- return gfc_trans_assignment (code->expr1, code->expr2, true, false);
+ return gfc_trans_assignment (code->expr1, code->expr2, true, false, true);
}
tree
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c (Revision 241884)
+++ gcc/fortran/trans-array.c (Arbeitskopie)
@@ -5623,14 +5623,6 @@
else
gfc_add_expr_to_block (&se->pre, set_descriptor);
- if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp
- && !coarray)
- {
- tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, se->expr,
- ref->u.ar.as->rank);
- gfc_add_expr_to_block (&se->pre, tmp);
- }
-
return true;
}
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (Revision 241884)
+++ gcc/fortran/trans-stmt.c (Arbeitskopie)
@@ -5450,6 +5450,34 @@
}
+/* Get the initializer expression for the code and expr of an allocate.
+ When no initializer is needed return NULL. */
+
+static gfc_expr *
+allocate_get_initializer (gfc_code * code, gfc_expr * expr)
+{
+ if (!gfc_bt_struct (expr->ts.type) && expr->ts.type != BT_CLASS)
+ return NULL;
+
+ /* An explicit type was given in allocate ( T:: object). */
+ if (code->ext.alloc.ts.type == BT_DERIVED
+ && (code->ext.alloc.ts.u.derived->attr.alloc_comp
+ || gfc_has_default_initializer (code->ext.alloc.ts.u.derived)))
+ return gfc_default_initializer (&code->ext.alloc.ts);
+
+ if (gfc_bt_struct (expr->ts.type)
+ && (expr->ts.u.derived->attr.alloc_comp
+ || gfc_has_default_initializer (expr->ts.u.derived)))
+ return gfc_default_initializer (&expr->ts);
+
+ if (expr->ts.type == BT_CLASS
+ && (CLASS_DATA (expr)->ts.u.derived->attr.alloc_comp
+ || gfc_has_default_initializer (CLASS_DATA (expr)->ts.u.derived)))
+ return gfc_default_initializer (&CLASS_DATA (expr)->ts);
+
+ return NULL;
+}
+
/* Translate the ALLOCATE statement. */
tree
@@ -5456,7 +5484,7 @@
gfc_trans_allocate (gfc_code * code)
{
gfc_alloc *al;
- gfc_expr *expr, *e3rhs = NULL;
+ gfc_expr *expr, *e3rhs = NULL, *init_expr;
gfc_se se, se_sz;
tree tmp;
tree parm;
@@ -6080,14 +6108,6 @@
label_finish, expr, 0);
else
gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat);
-
- if (al->expr->ts.type == BT_DERIVED
- && expr->ts.u.derived->attr.alloc_comp)
- {
- tmp = build_fold_indirect_ref_loc (input_location, se.expr);
- tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0);
- gfc_add_expr_to_block (&se.pre, tmp);
- }
}
else
{
@@ -6217,6 +6237,8 @@
fold_convert (TREE_TYPE (al_len),
integer_zero_node));
}
+
+ init_expr = NULL;
if (code->expr3 && !code->expr3->mold && e3_is != E3_MOLD)
{
/* Initialization via SOURCE block (or static default initializer).
@@ -6246,6 +6268,23 @@
gfc_free_statements (ini);
gfc_add_expr_to_block (&block, tmp);
}
+ else if ((init_expr = allocate_get_initializer (code, expr)))
+ {
+ /* Use class_init_assign to initialize expr. */
+ gfc_code *ini;
+ int realloc_lhs = flag_realloc_lhs;
+ ini = gfc_get_code (EXEC_INIT_ASSIGN);
+ ini->expr1 = gfc_expr_to_initialize (expr);
+ ini->expr2 = init_expr;
+ flag_realloc_lhs = 0;
+ tmp= gfc_trans_init_assign (ini);
+ flag_realloc_lhs = realloc_lhs;
+ gfc_free_statements (ini);
+ /* Init_expr is freeed by above free_statements, just need to null
+ it here. */
+ init_expr = NULL;
+ gfc_add_expr_to_block (&block, tmp);
+ }
gfc_free_expr (expr);
} // for-loop
Index: gcc/testsuite/gfortran.dg/allocate_with_source_14.f03
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_source_14.f03 (Revision 241884)
+++ gcc/testsuite/gfortran.dg/allocate_with_source_14.f03 (Arbeitskopie)
@@ -210,5 +210,5 @@
call v%free()
deallocate(av)
end program
-! { dg-final { scan-tree-dump-times "__builtin_malloc" 23 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_malloc" 22 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_free" 29 "original" } }
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 241884)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,8 @@
+2016-11-06 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ * gfortran.dg/allocate_with_source_14.f03: Fixed number mallocs
+ occuring.
+
2016-11-06 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/78221
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [PATCH, Fortran, v1] Restructure initialization of allocatable components
2016-11-03 13:16 [PATCH, Fortran, v1] Restructure initialization of allocatable components Andre Vehreschild
2016-11-04 0:58 ` Steve Kargl
@ 2016-11-06 19:22 ` Mikael Morin
1 sibling, 0 replies; 5+ messages in thread
From: Mikael Morin @ 2016-11-06 19:22 UTC (permalink / raw)
To: Andre Vehreschild, GCC-Patches-ML, GCC-Fortran-ML, Dominique Dhumieres
Le 03/11/2016 à 14:16, Andre Vehreschild a écrit :
> @Dominique: Would you give it a go on your open patch collection? Maybe it
> fixes one PR, but I am not very hopeful, because the patch is merely removing
> complexity instead of doing new things.
>
Hello,
Since you asked:
I think the patch fixes pr60500.
The spurious warning was gone before, it seems, but it is your patch
that fixed the wrong code causing it.
Mikael
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2016-11-06 19:22 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-11-03 13:16 [PATCH, Fortran, v1] Restructure initialization of allocatable components Andre Vehreschild
2016-11-04 0:58 ` Steve Kargl
2016-11-05 9:46 ` Paul Richard Thomas
2016-11-06 16:13 ` Andre Vehreschild
2016-11-06 19:22 ` Mikael Morin
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).