This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] PR fortran/92178 -- Re-order argument deallocation
- From: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Wed, 23 Oct 2019 11:12:18 -0700
- Subject: [PATCH] PR fortran/92178 -- Re-order argument deallocation
- Reply-to: sgk at troutmask dot apl dot washington dot edu
The attached patch has been tested on x86_64-*-freebsd. OK to commit?
2019-10-23 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/92178
* trans-expr.c (gfc_conv_procedure_call): Evaluate args and then
deallocate actual args assocated with intent(out) dummies.
2019-10-23 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/92178
* gfortran.dg/pr92178.f90: New test.
Note, in gfc_conv_procedure_call() there are 3 blocks of
code that deal with the deallocation of actual arguments
assocated with intent(out) dummy arguments. The patch
affects the first and third blocks. The 2nd block, lines
6071-6111, concerns CLASS and finalization. I use neither,
so have no idea what Fortran requires. More importantly,
I have very little understanding of gfortran's internal
implementation for CLASS and finalization. Someone who
cares about CLASS and finalization will need to consider
how to possibly fix a possible issue.
--
Steve
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 277296)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -5405,6 +5405,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym
gfc_component *comp = NULL;
int arglen;
unsigned int argc;
+ stmtblock_t dealloc_blk;
+ bool saw_dealloc = false;
arglist = NULL;
retargs = NULL;
@@ -5445,6 +5447,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym
info = NULL;
gfc_init_block (&post);
+ gfc_init_block (&dealloc_blk);
gfc_init_interface_mapping (&mapping);
if (!comp)
{
@@ -5976,8 +5979,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym
}
else
tmp = gfc_finish_block (&block);
-
- gfc_add_expr_to_block (&se->pre, tmp);
+ saw_dealloc = true;
+ gfc_add_expr_to_block (&dealloc_blk, tmp);
}
if (fsym && (fsym->ts.type == BT_DERIVED
@@ -6265,7 +6268,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym
void_type_node,
gfc_conv_expr_present (e->symtree->n.sym),
tmp, build_empty_stmt (input_location));
- gfc_add_expr_to_block (&se->pre, tmp);
+ saw_dealloc = true;
+ gfc_add_expr_to_block (&dealloc_blk, tmp);
}
}
}
@@ -6636,6 +6640,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym
vec_safe_push (arglist, parmse.expr);
}
+ if (saw_dealloc)
+ gfc_add_block_to_block (&se->pre, &dealloc_blk);
gfc_finish_interface_mapping (&mapping, &se->pre, &se->post);
if (comp)
Index: gcc/testsuite/gfortran.dg/pr92178.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr92178.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr92178.f90 (working copy)
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Original code contributed by Vladimir Fuka
+! PR fortran/92178
+program foo
+
+ implicit none
+
+ integer, allocatable :: a(:)
+
+ allocate(a, source=[1])
+
+ call assign(a, (a(1)))
+
+ if (allocated(a) .neqv. .false.) stop 1
+
+ contains
+ subroutine assign(a, b)
+ integer, allocatable, intent(out) :: a(:)
+ integer :: b
+ if (b /= 1) stop 2
+ end subroutine
+end program