From: Paul Richard Thomas <paul.richard.thomas@gmail.com>
To: Mikael Morin <mikael.morin@sfr.fr>,
Andre Vehreschild <vehre@gmx.de>,
"fortran@gcc.gnu.org" <fortran@gcc.gnu.org>,
gcc-patches <gcc-patches@gcc.gnu.org>
Subject: [Patch, fortran] PR65792 - allocation of scalar elemental function with structure constructor fails
Date: Sun, 26 Apr 2015 18:35:00 -0000 [thread overview]
Message-ID: <CAGkQGiKfuxfsnHuwGnsk5R7f=bOu3OzvxtZweL0cGzMmHDGAkQ@mail.gmail.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 932 bytes --]
Dear All,
This patch exploits Mikael's identification of the location of the
problem and his testcase. It requires Andre's patch for PR59678 as a
prerequisite. It is almost certainly a bit over-conservative but it
seems to be free of any memory leakage. The ChangeLog and the comments
describe it sufficiently for review.
OK for trunk and 5.x?
Paul
2015-04-26 Mikael Morin <mikael@gcc.gnu.org
Paul Thomas <pault@gcc.gnu.org>
PR fortran/65792
* trans-expr.c (gfc_trans_subcomponent_assign): Always assign
the expression component to the destination. In addition, if
the component has allocatable components, copy them and
deallocate those of the expression, if it is not a variable.
The expression is fixed if not a variable to prevent multiple
evaluations.
2015-04-26 Mikael Morin <mikael@gcc.gnu.org>
PR fortran/65792
* gfortran.dg/derived_constructor_components_5: New test
[-- Attachment #2: submit.diff --]
[-- Type: text/plain, Size: 1944 bytes --]
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 222439)
--- gcc/fortran/trans-expr.c (working copy)
*************** gfc_trans_subcomponent_assign (tree dest
*** 7062,7080 ****
{
if (expr->expr_type != EXPR_STRUCTURE)
{
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
gfc_add_block_to_block (&block, &se.pre);
if (cm->ts.u.derived->attr.alloc_comp
! && expr->expr_type == EXPR_VARIABLE)
{
tmp = gfc_copy_alloc_comp (cm->ts.u.derived, se.expr,
dest, expr->rank);
gfc_add_expr_to_block (&block, tmp);
}
- else
- gfc_add_modify (&block, dest,
- fold_convert (TREE_TYPE (dest), se.expr));
gfc_add_block_to_block (&block, &se.post);
}
else
--- 7062,7091 ----
{
if (expr->expr_type != EXPR_STRUCTURE)
{
+ tree dealloc = NULL_TREE;
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
gfc_add_block_to_block (&block, &se.pre);
+ /* Prevent repeat evaluations in gfc_copy_alloc_comp by fixing the
+ expression in a temporary variable and deallocate is allocatable
+ components the copy to the result. */
if (cm->ts.u.derived->attr.alloc_comp
! && expr->expr_type != EXPR_VARIABLE)
! {
! se.expr = gfc_evaluate_now (se.expr, &block);
! dealloc = gfc_deallocate_alloc_comp (cm->ts.u.derived, se.expr,
! expr->rank);
! }
! gfc_add_modify (&block, dest,
! fold_convert (TREE_TYPE (dest), se.expr));
! if (cm->ts.u.derived->attr.alloc_comp)
{
tmp = gfc_copy_alloc_comp (cm->ts.u.derived, se.expr,
dest, expr->rank);
gfc_add_expr_to_block (&block, tmp);
+ if (dealloc != NULL_TREE)
+ gfc_add_expr_to_block (&block, dealloc);
}
gfc_add_block_to_block (&block, &se.post);
}
else
[-- Attachment #3: derived_constructor_comps_5.f90 --]
[-- Type: text/plain, Size: 1647 bytes --]
! { dg-do run }
!
! PR fortran/65792
! The evaluation of the argument in the call to new_prt_spec2
! failed to properly initialize the comp component.
! While the array contents were properly copied, the array bounds remained
! uninitialized.
!
! Contributed by Dominique D'Humieres <dominiq@lps.ens.fr>
program main
implicit none
integer, parameter :: n = 2
type :: string_t
character(LEN=1), dimension(:), allocatable :: chars
end type string_t
type :: string_container_t
type(string_t) :: comp
end type string_container_t
type(string_t) :: prt_in, tmp, tmpa(n)
type(string_container_t) :: tmpc, tmpca(n)
integer :: i, j, k
do i=1,2
! scalar elemental function with structure constructor
prt_in = string_t(["D"])
tmpc = new_prt_spec2 (string_container_t(prt_in))
if (any(tmpc%comp%chars .ne. ["D"])) call abort
deallocate (prt_in%chars)
deallocate(tmpc%comp%chars)
! Check that function arguments are OK too
tmpc = new_prt_spec2 (string_container_t(new_str_t(["h","e","l","l","o"])))
if (any(tmpc%comp%chars .ne. ["h","e","l","l","o"])) call abort
deallocate(tmpc%comp%chars)
end do
contains
impure elemental function new_prt_spec2 (name) result (prt_spec)
type(string_container_t), intent(in) :: name
type(string_container_t) :: prt_spec
prt_spec = name
end function new_prt_spec2
function new_str_t (name) result (prt_spec)
character (*), intent(in), dimension (:) :: name
type(string_t) :: prt_spec
prt_spec = string_t(name)
end function new_str_t
end program main
next reply other threads:[~2015-04-26 18:35 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2015-04-26 18:35 Paul Richard Thomas [this message]
2015-04-26 18:53 ` Steve Kargl
2015-04-27 20:42 ` Paul Richard Thomas
2015-05-01 18:25 ` Paul Richard Thomas
2015-05-09 13:13 ` Mikael Morin
2015-05-15 17:02 ` *ping* " Mikael Morin
2015-05-15 18:07 ` Paul Richard Thomas
2015-05-16 9:39 ` Paul Richard Thomas
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='CAGkQGiKfuxfsnHuwGnsk5R7f=bOu3OzvxtZweL0cGzMmHDGAkQ@mail.gmail.com' \
--to=paul.richard.thomas@gmail.com \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
--cc=mikael.morin@sfr.fr \
--cc=vehre@gmx.de \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).