* [Fortran, gcc-5, patch, pr69268, v1] [5 Regression] Sourced allocation calls function twice
[not found] ` <bug-69268-26035-6uQXzC9EtN@http.gcc.gnu.org/bugzilla/>
@ 2016-01-26 12:28 ` Andre Vehreschild
2016-01-26 17:36 ` Paul Richard Thomas
0 siblings, 1 reply; 3+ messages in thread
From: Andre Vehreschild @ 2016-01-26 12:28 UTC (permalink / raw)
To: GCC-Patches-ML, GCC-Fortran-ML
[-- Attachment #1: Type: text/plain, Size: 773 bytes --]
Hi all,
please find attached a patch to solve the issue of evaluating a source=
expression of an allocate() twice in gcc-5. The patch is a combination
and partial back port of several prs of the mainline (namely, but not
the complete list: pr44672, pr65548).
The patch needed the counts of builtin_mallocs/frees in
allocatable_scalar_13 to be adapted. There are now fewer calls to the
memory management routines. Valgrind does not report any memory issues
in the modified code, but that does not mean there aren't any. I am
happy to hear about any issue, this patch causes (still having issues
getting the sanitizer to work).
Bootstrapped and regtested on x86_64-linux-gnu/F23.
Ok, for gcc-5-branch?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: pr69268_1.txt --]
[-- Type: text/plain, Size: 549 bytes --]
gcc/testsuite/ChangeLog:
2016-01-26 Andre Vehreschild <vehre@gcc.gnu.org>
* gfortran.dg/allocatable_scalar_13.f90: Fixing counts of malloc/
free to fit the actual number of calls.
* gfortran.dg/allocate_with_source_16.f90: New test.
gcc/fortran/ChangeLog:
2016-01-26 Andre Vehreschild <vehre@gcc.gnu.org>
* trans-stmt.c (gfc_trans_allocate): Make sure the source=
expression is evaluated once only. Use gfc_trans_assignment ()
instead of explicitly calling gfc_trans_string_copy () to
reduce the code complexity in trans_allocate.
[-- Attachment #3: pr69268_1.patch --]
[-- Type: text/x-patch, Size: 8195 bytes --]
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 68601f6..0be92cd 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5108,7 +5108,7 @@ tree
gfc_trans_allocate (gfc_code * code)
{
gfc_alloc *al;
- gfc_expr *expr;
+ gfc_expr *expr, *e3rhs = NULL;
gfc_se se, se_sz;
tree tmp;
tree parm;
@@ -5130,6 +5130,7 @@ gfc_trans_allocate (gfc_code * code)
stmtblock_t post;
tree nelems;
bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set;
+ gfc_symtree *newsym = NULL;
if (!code->ext.alloc.list)
return NULL_TREE;
@@ -5239,16 +5240,28 @@ gfc_trans_allocate (gfc_code * code)
false, false);
gfc_add_block_to_block (&block, &se.pre);
gfc_add_block_to_block (&post, &se.post);
- /* Prevent aliasing, i.e., se.expr may be already a
- variable declaration. */
+
if (!VAR_P (se.expr))
{
+ tree var;
+
tmp = build_fold_indirect_ref_loc (input_location,
se.expr);
- tmp = gfc_evaluate_now (tmp, &block);
+
+ /* We need a regular (non-UID) symbol here, therefore give a
+ prefix. */
+ var = gfc_create_var (TREE_TYPE (tmp), "source");
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+ {
+ gfc_allocate_lang_decl (var);
+ GFC_DECL_SAVED_DESCRIPTOR (var) = GFC_DECL_SAVED_DESCRIPTOR (tmp);
+ }
+ gfc_add_modify_loc (input_location, &block, var, tmp);
+ tmp = var;
}
else
tmp = se.expr;
+
if (!code->expr3->mold)
expr3 = tmp;
else
@@ -5357,6 +5370,71 @@ gfc_trans_allocate (gfc_code * code)
else
expr3_esize = TYPE_SIZE_UNIT (
gfc_typenode_for_spec (&code->expr3->ts));
+
+ /* The routine gfc_trans_assignment () already implements all
+ techniques needed. Unfortunately we may have a temporary
+ variable for the source= expression here. When that is the
+ case convert this variable into a temporary gfc_expr of type
+ EXPR_VARIABLE and used it as rhs for the assignment. The
+ advantage is, that we get scalarizer support for free,
+ don't have to take care about scalar to array treatment and
+ will benefit of every enhancements gfc_trans_assignment ()
+ gets.
+ Exclude variables since the following block does not handle
+ array sections. In any case, there is no harm in sending
+ variables to gfc_trans_assignment because there is no
+ evaluation of variables. */
+ if (code->expr3->expr_type != EXPR_VARIABLE
+ && code->expr3->mold != 1 && expr3 != NULL_TREE
+ && DECL_P (expr3) && DECL_ARTIFICIAL (expr3))
+ {
+ /* Build a temporary symtree and symbol. Do not add it to
+ the current namespace to prevent accidently modifying
+ a colliding symbol's as. */
+ newsym = XCNEW (gfc_symtree);
+ /* The name of the symtree should be unique, because
+ gfc_create_var () took care about generating the
+ identifier. */
+ newsym->name = gfc_get_string (IDENTIFIER_POINTER (
+ DECL_NAME (expr3)));
+ newsym->n.sym = gfc_new_symbol (newsym->name, NULL);
+ /* The backend_decl is known. It is expr3, which is inserted
+ here. */
+ newsym->n.sym->backend_decl = expr3;
+ e3rhs = gfc_get_expr ();
+ e3rhs->ts = code->expr3->ts;
+ e3rhs->rank = code->expr3->rank;
+ e3rhs->symtree = newsym;
+ /* Mark the symbol referenced or gfc_trans_assignment will
+ bug. */
+ newsym->n.sym->attr.referenced = 1;
+ e3rhs->expr_type = EXPR_VARIABLE;
+ e3rhs->where = code->expr3->where;
+ /* Set the symbols type, upto it was BT_UNKNOWN. */
+ newsym->n.sym->ts = e3rhs->ts;
+ /* Check whether the expr3 is array valued. */
+ if (e3rhs->rank)
+ {
+ gfc_array_spec *arr;
+ arr = gfc_get_array_spec ();
+ arr->rank = e3rhs->rank;
+ arr->type = AS_DEFERRED;
+ /* Set the dimension and pointer attribute for arrays
+ to be on the safe side. */
+ newsym->n.sym->attr.dimension = 1;
+ newsym->n.sym->attr.pointer = 1;
+ newsym->n.sym->as = arr;
+ gfc_add_full_array_ref (e3rhs, arr);
+ }
+ else if (POINTER_TYPE_P (TREE_TYPE (expr3)))
+ newsym->n.sym->attr.pointer = 1;
+ /* The string length is known to. Set it for char arrays. */
+ if (e3rhs->ts.type == BT_CHARACTER)
+ newsym->n.sym->ts.u.cl->backend_decl = expr3_len;
+ gfc_commit_symbol (newsym->n.sym);
+ }
+ else
+ e3rhs = gfc_copy_expr (code->expr3);
}
gcc_assert (expr3_esize);
expr3_esize = fold_convert (sizetype, expr3_esize);
@@ -5674,7 +5752,6 @@ gfc_trans_allocate (gfc_code * code)
{
/* Initialization via SOURCE block
(or static default initializer). */
- gfc_expr *rhs = gfc_copy_expr (code->expr3);
if (expr3 != NULL_TREE
&& ((POINTER_TYPE_P (TREE_TYPE (expr3))
&& TREE_CODE (expr3) != POINTER_PLUS_EXPR)
@@ -5688,25 +5765,13 @@ gfc_trans_allocate (gfc_code * code)
tmp = gfc_copy_class_to_class (expr3, to,
nelems, upoly_expr);
}
- else if (code->expr3->ts.type == BT_CHARACTER
- && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)))
- {
- tmp = INDIRECT_REF_P (se.expr) ?
- se.expr :
- build_fold_indirect_ref_loc (input_location,
- se.expr);
- gfc_trans_string_copy (&block, al_len, tmp,
- code->expr3->ts.kind,
- expr3_len, expr3,
- code->expr3->ts.kind);
- tmp = NULL_TREE;
- }
else if (al->expr->ts.type == BT_CLASS)
{
gfc_actual_arglist *actual, *last_arg;
gfc_expr *ppc;
gfc_code *ppc_code;
gfc_ref *ref, *dataref;
+ gfc_expr *rhs = e3rhs ? e3rhs : gfc_copy_expr (code->expr3);
/* Do a polymorphic deep copy. */
actual = gfc_get_actual_arglist ();
@@ -5818,6 +5883,8 @@ gfc_trans_allocate (gfc_code * code)
void_type_node, tmp, extcopy, stdcopy);
}
gfc_free_statements (ppc_code);
+ if (rhs != e3rhs)
+ gfc_free_expr (rhs);
}
else
{
@@ -5826,10 +5893,9 @@ gfc_trans_allocate (gfc_code * code)
int realloc_lhs = flag_realloc_lhs;
flag_realloc_lhs = 0;
tmp = gfc_trans_assignment (gfc_expr_to_initialize (expr),
- rhs, false, false);
+ e3rhs, false, false);
flag_realloc_lhs = realloc_lhs;
}
- gfc_free_expr (rhs);
gfc_add_expr_to_block (&block, tmp);
}
else if (code->expr3 && code->expr3->mold
@@ -5847,6 +5913,15 @@ gfc_trans_allocate (gfc_code * code)
gfc_free_expr (expr);
} // for-loop
+ if (e3rhs)
+ {
+ if (newsym)
+ {
+ gfc_free_symbol (newsym->n.sym);
+ XDELETE (newsym);
+ }
+ gfc_free_expr (e3rhs);
+ }
/* STAT. */
if (code->expr1)
{
diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90
index 532f364..1d60154 100644
--- a/gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90
+++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90
@@ -67,6 +67,6 @@ contains
! allocate(res, source = arg) ! Caused an ICE
! end subroutine
end
-! { dg-final { scan-tree-dump-times "builtin_malloc" 15 "original" } }
-! { dg-final { scan-tree-dump-times "builtin_free" 17 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_malloc" 16 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_free" 16 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_16.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_16.f90
new file mode 100644
index 0000000..977202d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_16.f90
@@ -0,0 +1,26 @@
+!{ dg-do compile }
+! PR69268
+!
+! Contributed by Rich Townsend <townsend@astro.wisc.edu>
+
+program test_sourced_alloc
+
+ implicit none
+
+ type :: foo_t
+ end type foo_t
+
+ class(foo_t), allocatable :: f
+
+ allocate(f, SOURCE=f_func())
+
+contains
+
+ function f_func () result (f)
+ type(foo_t) :: f
+ integer, save :: c = 0
+ c = c + 1
+ if (c .gt. 1) call abort()
+ end function f_func
+
+end program test_sourced_alloc
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [Fortran, gcc-5, patch, pr69268, v1] [5 Regression] Sourced allocation calls function twice
2016-01-26 12:28 ` [Fortran, gcc-5, patch, pr69268, v1] [5 Regression] Sourced allocation calls function twice Andre Vehreschild
@ 2016-01-26 17:36 ` Paul Richard Thomas
2016-01-27 14:49 ` Andre Vehreschild
0 siblings, 1 reply; 3+ messages in thread
From: Paul Richard Thomas @ 2016-01-26 17:36 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: GCC-Patches-ML, GCC-Fortran-ML
Dear Andre,
The patch looks fine to me. OK for 5-branch.
Thanks for the patch.
Paul
On 26 January 2016 at 13:28, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi all,
>
> please find attached a patch to solve the issue of evaluating a source=
> expression of an allocate() twice in gcc-5. The patch is a combination
> and partial back port of several prs of the mainline (namely, but not
> the complete list: pr44672, pr65548).
>
> The patch needed the counts of builtin_mallocs/frees in
> allocatable_scalar_13 to be adapted. There are now fewer calls to the
> memory management routines. Valgrind does not report any memory issues
> in the modified code, but that does not mean there aren't any. I am
> happy to hear about any issue, this patch causes (still having issues
> getting the sanitizer to work).
>
> Bootstrapped and regtested on x86_64-linux-gnu/F23.
>
> Ok, for gcc-5-branch?
>
> Regards,
> Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
--
The difference between genius and stupidity is; genius has its limits.
Albert Einstein
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [Fortran, gcc-5, patch, pr69268, v1] [5 Regression] Sourced allocation calls function twice
2016-01-26 17:36 ` Paul Richard Thomas
@ 2016-01-27 14:49 ` Andre Vehreschild
0 siblings, 0 replies; 3+ messages in thread
From: Andre Vehreschild @ 2016-01-27 14:49 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: GCC-Patches-ML, GCC-Fortran-ML
[-- Attachment #1: Type: text/plain, Size: 1268 bytes --]
Hi Paul,
thanks for the review. Commited as r232876.
Regards,
Andre
On Tue, 26 Jan 2016 18:36:28 +0100
Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:
> Dear Andre,
>
> The patch looks fine to me. OK for 5-branch.
>
> Thanks for the patch.
>
> Paul
>
> On 26 January 2016 at 13:28, Andre Vehreschild <vehre@gmx.de> wrote:
> > Hi all,
> >
> > please find attached a patch to solve the issue of evaluating a source=
> > expression of an allocate() twice in gcc-5. The patch is a combination
> > and partial back port of several prs of the mainline (namely, but not
> > the complete list: pr44672, pr65548).
> >
> > The patch needed the counts of builtin_mallocs/frees in
> > allocatable_scalar_13 to be adapted. There are now fewer calls to the
> > memory management routines. Valgrind does not report any memory issues
> > in the modified code, but that does not mean there aren't any. I am
> > happy to hear about any issue, this patch causes (still having issues
> > getting the sanitizer to work).
> >
> > Bootstrapped and regtested on x86_64-linux-gnu/F23.
> >
> > Ok, for gcc-5-branch?
> >
> > Regards,
> > Andre
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
>
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 9112 bytes --]
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 232870)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,11 @@
+2016-01-27 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ PR fortran/p69268
+ * trans-stmt.c (gfc_trans_allocate): Make sure the source=
+ expression is evaluated once only. Use gfc_trans_assignment ()
+ instead of explicitly calling gfc_trans_string_copy () to
+ reduce the code complexity in trans_allocate.
+
2016-01-25 Dominique d'Humieres <dominiq@lps.ens.fr>
PR fortran/68283
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (Revision 232870)
+++ gcc/fortran/trans-stmt.c (Arbeitskopie)
@@ -5108,7 +5108,7 @@
gfc_trans_allocate (gfc_code * code)
{
gfc_alloc *al;
- gfc_expr *expr;
+ gfc_expr *expr, *e3rhs = NULL;
gfc_se se, se_sz;
tree tmp;
tree parm;
@@ -5130,6 +5130,7 @@
stmtblock_t post;
tree nelems;
bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set;
+ gfc_symtree *newsym = NULL;
if (!code->ext.alloc.list)
return NULL_TREE;
@@ -5239,16 +5240,28 @@
false, false);
gfc_add_block_to_block (&block, &se.pre);
gfc_add_block_to_block (&post, &se.post);
- /* Prevent aliasing, i.e., se.expr may be already a
- variable declaration. */
+
if (!VAR_P (se.expr))
{
+ tree var;
+
tmp = build_fold_indirect_ref_loc (input_location,
se.expr);
- tmp = gfc_evaluate_now (tmp, &block);
+
+ /* We need a regular (non-UID) symbol here, therefore give a
+ prefix. */
+ var = gfc_create_var (TREE_TYPE (tmp), "source");
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+ {
+ gfc_allocate_lang_decl (var);
+ GFC_DECL_SAVED_DESCRIPTOR (var) = GFC_DECL_SAVED_DESCRIPTOR (tmp);
+ }
+ gfc_add_modify_loc (input_location, &block, var, tmp);
+ tmp = var;
}
else
tmp = se.expr;
+
if (!code->expr3->mold)
expr3 = tmp;
else
@@ -5357,6 +5370,71 @@
else
expr3_esize = TYPE_SIZE_UNIT (
gfc_typenode_for_spec (&code->expr3->ts));
+
+ /* The routine gfc_trans_assignment () already implements all
+ techniques needed. Unfortunately we may have a temporary
+ variable for the source= expression here. When that is the
+ case convert this variable into a temporary gfc_expr of type
+ EXPR_VARIABLE and used it as rhs for the assignment. The
+ advantage is, that we get scalarizer support for free,
+ don't have to take care about scalar to array treatment and
+ will benefit of every enhancements gfc_trans_assignment ()
+ gets.
+ Exclude variables since the following block does not handle
+ array sections. In any case, there is no harm in sending
+ variables to gfc_trans_assignment because there is no
+ evaluation of variables. */
+ if (code->expr3->expr_type != EXPR_VARIABLE
+ && code->expr3->mold != 1 && expr3 != NULL_TREE
+ && DECL_P (expr3) && DECL_ARTIFICIAL (expr3))
+ {
+ /* Build a temporary symtree and symbol. Do not add it to
+ the current namespace to prevent accidently modifying
+ a colliding symbol's as. */
+ newsym = XCNEW (gfc_symtree);
+ /* The name of the symtree should be unique, because
+ gfc_create_var () took care about generating the
+ identifier. */
+ newsym->name = gfc_get_string (IDENTIFIER_POINTER (
+ DECL_NAME (expr3)));
+ newsym->n.sym = gfc_new_symbol (newsym->name, NULL);
+ /* The backend_decl is known. It is expr3, which is inserted
+ here. */
+ newsym->n.sym->backend_decl = expr3;
+ e3rhs = gfc_get_expr ();
+ e3rhs->ts = code->expr3->ts;
+ e3rhs->rank = code->expr3->rank;
+ e3rhs->symtree = newsym;
+ /* Mark the symbol referenced or gfc_trans_assignment will
+ bug. */
+ newsym->n.sym->attr.referenced = 1;
+ e3rhs->expr_type = EXPR_VARIABLE;
+ e3rhs->where = code->expr3->where;
+ /* Set the symbols type, upto it was BT_UNKNOWN. */
+ newsym->n.sym->ts = e3rhs->ts;
+ /* Check whether the expr3 is array valued. */
+ if (e3rhs->rank)
+ {
+ gfc_array_spec *arr;
+ arr = gfc_get_array_spec ();
+ arr->rank = e3rhs->rank;
+ arr->type = AS_DEFERRED;
+ /* Set the dimension and pointer attribute for arrays
+ to be on the safe side. */
+ newsym->n.sym->attr.dimension = 1;
+ newsym->n.sym->attr.pointer = 1;
+ newsym->n.sym->as = arr;
+ gfc_add_full_array_ref (e3rhs, arr);
+ }
+ else if (POINTER_TYPE_P (TREE_TYPE (expr3)))
+ newsym->n.sym->attr.pointer = 1;
+ /* The string length is known to. Set it for char arrays. */
+ if (e3rhs->ts.type == BT_CHARACTER)
+ newsym->n.sym->ts.u.cl->backend_decl = expr3_len;
+ gfc_commit_symbol (newsym->n.sym);
+ }
+ else
+ e3rhs = gfc_copy_expr (code->expr3);
}
gcc_assert (expr3_esize);
expr3_esize = fold_convert (sizetype, expr3_esize);
@@ -5674,7 +5752,6 @@
{
/* Initialization via SOURCE block
(or static default initializer). */
- gfc_expr *rhs = gfc_copy_expr (code->expr3);
if (expr3 != NULL_TREE
&& ((POINTER_TYPE_P (TREE_TYPE (expr3))
&& TREE_CODE (expr3) != POINTER_PLUS_EXPR)
@@ -5688,19 +5765,6 @@
tmp = gfc_copy_class_to_class (expr3, to,
nelems, upoly_expr);
}
- else if (code->expr3->ts.type == BT_CHARACTER
- && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)))
- {
- tmp = INDIRECT_REF_P (se.expr) ?
- se.expr :
- build_fold_indirect_ref_loc (input_location,
- se.expr);
- gfc_trans_string_copy (&block, al_len, tmp,
- code->expr3->ts.kind,
- expr3_len, expr3,
- code->expr3->ts.kind);
- tmp = NULL_TREE;
- }
else if (al->expr->ts.type == BT_CLASS)
{
gfc_actual_arglist *actual, *last_arg;
@@ -5707,6 +5771,7 @@
gfc_expr *ppc;
gfc_code *ppc_code;
gfc_ref *ref, *dataref;
+ gfc_expr *rhs = e3rhs ? e3rhs : gfc_copy_expr (code->expr3);
/* Do a polymorphic deep copy. */
actual = gfc_get_actual_arglist ();
@@ -5818,6 +5883,8 @@
void_type_node, tmp, extcopy, stdcopy);
}
gfc_free_statements (ppc_code);
+ if (rhs != e3rhs)
+ gfc_free_expr (rhs);
}
else
{
@@ -5826,10 +5893,9 @@
int realloc_lhs = flag_realloc_lhs;
flag_realloc_lhs = 0;
tmp = gfc_trans_assignment (gfc_expr_to_initialize (expr),
- rhs, false, false);
+ e3rhs, false, false);
flag_realloc_lhs = realloc_lhs;
}
- gfc_free_expr (rhs);
gfc_add_expr_to_block (&block, tmp);
}
else if (code->expr3 && code->expr3->mold
@@ -5847,6 +5913,15 @@
gfc_free_expr (expr);
} // for-loop
+ if (e3rhs)
+ {
+ if (newsym)
+ {
+ gfc_free_symbol (newsym->n.sym);
+ XDELETE (newsym);
+ }
+ gfc_free_expr (e3rhs);
+ }
/* STAT. */
if (code->expr1)
{
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 232870)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,10 @@
+2016-01-27 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ PR fortran/69268
+ * gfortran.dg/allocatable_scalar_13.f90: Fixing counts of malloc/
+ free to fit the actual number of calls.
+ * gfortran.dg/allocate_with_source_16.f90: New test.
+
2016-01-27 Tom de Vries <tom@codesourcery.com>
* gcc.dg/autopar/pr69110.c: Fix pass number.
Index: gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90 (Revision 232870)
+++ gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90 (Arbeitskopie)
@@ -67,6 +67,6 @@
! allocate(res, source = arg) ! Caused an ICE
! end subroutine
end
-! { dg-final { scan-tree-dump-times "builtin_malloc" 15 "original" } }
-! { dg-final { scan-tree-dump-times "builtin_free" 17 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_malloc" 16 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_free" 16 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
Index: gcc/testsuite/gfortran.dg/allocate_with_source_16.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_source_16.f90 (nicht existent)
+++ gcc/testsuite/gfortran.dg/allocate_with_source_16.f90 (Arbeitskopie)
@@ -0,0 +1,26 @@
+!{ dg-do compile }
+! PR69268
+!
+! Contributed by Rich Townsend <townsend@astro.wisc.edu>
+
+program test_sourced_alloc
+
+ implicit none
+
+ type :: foo_t
+ end type foo_t
+
+ class(foo_t), allocatable :: f
+
+ allocate(f, SOURCE=f_func())
+
+contains
+
+ function f_func () result (f)
+ type(foo_t) :: f
+ integer, save :: c = 0
+ c = c + 1
+ if (c .gt. 1) call abort()
+ end function f_func
+
+end program test_sourced_alloc
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2016-01-27 14:49 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
[not found] <bug-69268-26035@http.gcc.gnu.org/bugzilla/>
[not found] ` <bug-69268-26035-6uQXzC9EtN@http.gcc.gnu.org/bugzilla/>
2016-01-26 12:28 ` [Fortran, gcc-5, patch, pr69268, v1] [5 Regression] Sourced allocation calls function twice Andre Vehreschild
2016-01-26 17:36 ` Paul Richard Thomas
2016-01-27 14:49 ` Andre Vehreschild
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).