* [Patch, Fortran, PR58586, v1] ICE with derived type with allocatable component passed by value @ 2015-04-15 18:03 Andre Vehreschild 2015-04-19 10:01 ` Mikael Morin 0 siblings, 1 reply; 19+ messages in thread From: Andre Vehreschild @ 2015-04-15 18:03 UTC (permalink / raw) To: GCC-Patches-ML, GCC-Fortran-ML [-- Attachment #1: Type: text/plain, Size: 817 bytes --] Hi all, by accident I patched this pr. For short, when a structure constructor for a structure with an allocatable component or a function returning a type with an allocatable component is passed as actual argument to a function, then gfortran ICEs. This patch fixes, both the ICE and a segfault at runtime. I was pointed to the patch in comment #44 of pr61831 which seemingly fixes the #3 comment of pr58586, too, but causes a memory leak. I therefore like to point out, that adding the a->expr.expr_type != EXPR_STRUCTURE of Mikael's patch in pr61831 should not be added to trans-expr.c::gfc_conv_procedure_call (), when this patch for 58586 is applied. Bootstraps and regtests ok on x86_64-linux-gnu/F21. Ok, for trunk 6.0, when open again? Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de [-- Attachment #2: pr58586_1.clog --] [-- Type: application/octet-stream, Size: 393 bytes --] gcc/testsuite/ChangeLog: 2015-04-15 Andre Vehreschild <vehre@gmx.de> * gfortran.dg/alloc_comp_class_3.f90: New test. gcc/fortran/ChangeLog: 2015-04-15 Andre Vehreschild <vehre@gmx.de> * trans-expr.c (gfc_conv_procedure_call): For EXPR_STRUCTURE hand the tree without indirect ref. And for EXPR_FUNCTIONs add a temporary variable to prevent calling the function multiple times. [-- Attachment #3: pr58586_1.patch --] [-- Type: text/x-patch, Size: 1951 bytes --] diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 9e6432f..80dfed1 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5344,8 +5344,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && (e->expr_type != EXPR_VARIABLE && !e->rank)) { int parm_rank; - tmp = build_fold_indirect_ref_loc (input_location, - parmse.expr); + /* It is known the e returns a structure type with at least one + allocatable component. When e is a function, ensure that the + function is called once only by using a temporary variable. */ + if (e->expr_type == EXPR_FUNCTION) + parmse.expr = gfc_evaluate_now_loc (input_location, + parmse.expr, &se->pre); + + if (POINTER_TYPE_P (TREE_TYPE (parmse.expr))) + tmp = build_fold_indirect_ref_loc (input_location, + parmse.expr); + else + tmp = parmse.expr; + parm_rank = e->rank; switch (parm_kind) { diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f90 new file mode 100644 index 0000000..297fae1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f90 @@ -0,0 +1,41 @@ +! { dg-do run } +! +! Check that pr58586 is fixed now. +! Based on a contribution by Vladimir Fuka +! Contibuted by Andre Vehreschild + +program test_pr58586 + implicit none + + type :: a + end type + + type :: c + type(a), allocatable :: a + end type + + type :: b + integer, allocatable :: a + end type + + ! These two are merely to check, if compilation works + call add(b()) + call add(b(null())) + + ! This needs to execute, to see whether the segfault at runtime is resolved + call add_c(c_init()) + +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + type(c) function c_init() + end function +end program test_pr58586 + ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Patch, Fortran, PR58586, v1] ICE with derived type with allocatable component passed by value 2015-04-15 18:03 [Patch, Fortran, PR58586, v1] ICE with derived type with allocatable component passed by value Andre Vehreschild @ 2015-04-19 10:01 ` Mikael Morin 2015-04-23 18:01 ` [Patch, Fortran, PR58586, v2] " Andre Vehreschild 0 siblings, 1 reply; 19+ messages in thread From: Mikael Morin @ 2015-04-19 10:01 UTC (permalink / raw) To: Andre Vehreschild, GCC-Patches-ML, GCC-Fortran-ML Hello, Le 15/04/2015 20:03, Andre Vehreschild a écrit : > by accident I patched this pr. For short, when a structure constructor for a > structure with an allocatable component or a function returning a type with an > allocatable component is passed as actual argument to a function, then gfortran > ICEs. This patch fixes, both the ICE and a segfault at runtime. > > I was pointed to the patch in comment #44 of pr61831 which seemingly fixes the > #3 comment of pr58586, too, but causes a memory leak. I therefore like to point > out, that adding the a->expr.expr_type != EXPR_STRUCTURE of Mikael's patch in > pr61831 should not be added to trans-expr.c::gfc_conv_procedure_call (), when > this patch for 58586 is applied. Note that I plan to submit the pr61831 patch soon, and that the comment #44 patch doesn't have the a->expr.expr_type != EXPR_STRUCTURE (in opposition to precedent patches). I hope that means the patches are compatible. ;-) > > diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c > index 9e6432f..80dfed1 100644 > --- a/gcc/fortran/trans-expr.c > +++ b/gcc/fortran/trans-expr.c > @@ -5344,8 +5344,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, > && (e->expr_type != EXPR_VARIABLE && !e->rank)) > { > int parm_rank; > - tmp = build_fold_indirect_ref_loc (input_location, > - parmse.expr); > + /* It is known the e returns a structure type with at least one > + allocatable component. When e is a function, ensure that the > + function is called once only by using a temporary variable. */ > + if (e->expr_type == EXPR_FUNCTION) > + parmse.expr = gfc_evaluate_now_loc (input_location, > + parmse.expr, &se->pre); You need not limit this to functions only. I think you can even do this without condition. > + > + if (POINTER_TYPE_P (TREE_TYPE (parmse.expr))) This distinguishes arguments with/without value attribute, right? I think it's better to use the frontend information here (fsym->attr.value). > + tmp = build_fold_indirect_ref_loc (input_location, > + parmse.expr); > + else > + tmp = parmse.expr; > + > parm_rank = e->rank; > switch (parm_kind) > { Otherwise, this looks good. Can you post an updated patch taking the above comments into account? Ah, and don't forget to provide a ChangeLog entry with it. Mikael ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Patch, Fortran, PR58586, v2] ICE with derived type with allocatable component passed by value 2015-04-19 10:01 ` Mikael Morin @ 2015-04-23 18:01 ` Andre Vehreschild 2015-04-24 8:37 ` Andre Vehreschild 2015-04-26 10:23 ` Mikael Morin 0 siblings, 2 replies; 19+ messages in thread From: Andre Vehreschild @ 2015-04-23 18:01 UTC (permalink / raw) To: Mikael Morin; +Cc: GCC-Patches-ML, GCC-Fortran-ML [-- Attachment #1: Type: text/plain, Size: 3163 bytes --] Hi Mikael, hi all, thanks for the review. I have made some changes. Answers to your questions are inline below. On Sun, 19 Apr 2015 12:01:23 +0200 Mikael Morin <mikael.morin@sfr.fr> wrote: <snip> > > I was pointed to the patch in comment #44 of pr61831 which seemingly fixes > > the #3 comment of pr58586, too, but causes a memory leak. I therefore like > > to point out, that adding the a->expr.expr_type != EXPR_STRUCTURE of > > Mikael's patch in pr61831 should not be added to > > trans-expr.c::gfc_conv_procedure_call (), when this patch for 58586 is > > applied. > Note that I plan to submit the pr61831 patch soon, and that the comment > #44 patch doesn't have the a->expr.expr_type != EXPR_STRUCTURE (in > opposition to precedent patches). > I hope that means the patches are compatible. ;-) I have tested the code in the comments of pr61831 with v2 of this patch and got no issues. > > diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c > > index 9e6432f..80dfed1 100644 > > --- a/gcc/fortran/trans-expr.c > > +++ b/gcc/fortran/trans-expr.c > > @@ -5344,8 +5344,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * > > sym, && (e->expr_type != EXPR_VARIABLE && !e->rank)) > > { > > int parm_rank; > > - tmp = build_fold_indirect_ref_loc (input_location, > > - parmse.expr); > > + /* It is known the e returns a structure type with at least one > > + allocatable component. When e is a function, ensure that the > > + function is called once only by using a temporary variable. > > */ > > + if (e->expr_type == EXPR_FUNCTION) > > + parmse.expr = gfc_evaluate_now_loc (input_location, > > + parmse.expr, &se->pre); > You need not limit this to functions only. > I think you can even do this without condition. Yes, one could do that, but then an unnecessary temporary variable in the - for my taste - already too clobbered pseudo code is introduced. Furthermore, is the penalty on doing the check for a function negligible. I therefore have not changed that. > > + if (POINTER_TYPE_P (TREE_TYPE (parmse.expr))) > This distinguishes arguments with/without value attribute, right? > I think it's better to use the frontend information here (fsym->attr.value). Changed to check for value. > Ah, and don't forget to provide a ChangeLog entry with it. The Changelog entry comes in an additional attachment. Version 2 of this patch adds a chunk to resolve.c, where results of functions that are defined in a module, but are not referenced there, are now marked referenced when they use allocatable or pointer components. Furthermore, does the chunk prevent duplicate pseudo code generation. The former code adds a EXPR_INIT_ASSIGN and then gfc_generate_function_code () does nearly the same again. I fixed this in both place. I also have added a test to check this. The chunks in trans-decl.c take care to have variable/result declaration and initialize it properly. For this I had to make gfc_trans_structure_assign () public to the trans-stage. Bootstraps and regtests ok on x86_64-linux-gnu/F21. Ok, for trunk? Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de [-- Attachment #2: pr58586_2.clog --] [-- Type: application/octet-stream, Size: 1126 bytes --] gcc/testsuite/ChangeLog: 2015-04-23 Andre Vehreschild <vehre@gmx.de> * gfortran.dg/alloc_comp_class_3.f03: New test. * gfortran.dg/alloc_comp_class_4.f03: New test. gcc/fortran/ChangeLog: 2015-04-23 Andre Vehreschild <vehre@gmx.de> PR fortran/58586 * resolve.c (resolve_symbol): Non-private functions in modules with allocatable or pointer components are marked referenced now. Furthermore is the default init especially for those components now done in gfc_conf_procedure_call preventing duplicate code. * trans-decl.c (build_function_decl): Set the result decl when the function symbol and the result symbol are equal. (gfc_generate_function_code): Generate a fake result decl for functions returning an object with allocatable components and initialize them. * trans-expr.c (gfc_conv_procedure_call): For value typed trees use the tree without indirect ref. And for function calls add a temporary variable to prevent calling the function multiple times. * trans.h: Made gfc_trans_structure_assign () protoype available, which is now needed by trans-decl.c:gfc_generate_ function_code(), too. [-- Attachment #3: pr58586_2.patch --] [-- Type: text/x-patch, Size: 8242 bytes --] diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 76afd72..a43396c 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -14063,10 +14063,15 @@ resolve_symbol (gfc_symbol *sym) if ((!a->save && !a->dummy && !a->pointer && !a->in_common && !a->use_assoc - && (a->referenced || a->result) - && !(a->function && sym != sym->result)) + && !a->result && !a->function) || (a->dummy && a->intent == INTENT_OUT && !a->pointer)) apply_default_init (sym); + else if (a->function && sym->result && a->access != ACCESS_PRIVATE + && (sym->ts.u.derived->attr.alloc_comp + || sym->ts.u.derived->attr.pointer_comp)) + /* Mark the result symbol to be referenced, when it has allocatable + components. */ + sym->result->attr.referenced = 1; } if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 4c18920..0b63175 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2158,6 +2158,8 @@ build_function_decl (gfc_symbol * sym, bool global) gfc_set_decl_assembler_name (fndecl, gfc_sym_mangled_function_id (sym)); sym->backend_decl = fndecl; + if (sym == sym->result && !sym->result->backend_decl) + sym->result->backend_decl = result_decl; } @@ -5898,8 +5900,21 @@ gfc_generate_function_code (gfc_namespace * ns) if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node) { + bool artificial_result_decl = false; tree result = get_proc_result (sym); + /* Make sure that a function returning an object with + alloc/pointer_components always has a result, where at least + the allocatable/pointer components are set to zero. */ + if (result == NULL_TREE && sym->attr.function + && sym->ts.type == BT_DERIVED + && (sym->ts.u.derived->attr.alloc_comp + || sym->ts.u.derived->attr.pointer_comp)) + { + artificial_result_decl = true; + result = gfc_get_fake_result_decl (sym, 0); + } + if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer) { if (sym->attr.allocatable && sym->attr.dimension == 0 @@ -5918,16 +5933,26 @@ gfc_generate_function_code (gfc_namespace * ns) null_pointer_node)); } else if (sym->ts.type == BT_DERIVED - && sym->ts.u.derived->attr.alloc_comp && !sym->attr.allocatable) { - rank = sym->as ? sym->as->rank : 0; - tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); - gfc_add_expr_to_block (&init, tmp); + gfc_expr *init_exp; + init_exp = gfc_default_initializer (&sym->ts); + if (init_exp) + { + tmp = gfc_trans_structure_assign (result, init_exp, 0); + gfc_free_expr (init_exp); + gfc_add_expr_to_block (&init, tmp); + } + else if (sym->ts.u.derived->attr.alloc_comp) + { + rank = sym->as ? sym->as->rank : 0; + tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); + gfc_add_expr_to_block (&init, tmp); + } } } - if (result == NULL_TREE) + if (result == NULL_TREE || artificial_result_decl) { /* TODO: move to the appropriate place in resolve.c. */ if (warn_return_type && sym == sym->result) @@ -5937,7 +5962,7 @@ gfc_generate_function_code (gfc_namespace * ns) if (warn_return_type) TREE_NO_WARNING(sym->backend_decl) = 1; } - else + if (result != NULL_TREE) gfc_add_expr_to_block (&body, gfc_generate_return ()); } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 9e6432f..2db7524 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1472,7 +1472,6 @@ realloc_lhs_warning (bt type, bool array, locus *where) } -static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init); static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *, gfc_expr *); @@ -5344,8 +5343,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && (e->expr_type != EXPR_VARIABLE && !e->rank)) { int parm_rank; - tmp = build_fold_indirect_ref_loc (input_location, - parmse.expr); + /* It is known the e returns a structure type with at least one + allocatable component. When e is a function, ensure that the + function is called once only by using a temporary variable. */ + if (e->expr_type == EXPR_FUNCTION) + parmse.expr = gfc_evaluate_now_loc (input_location, + parmse.expr, &se->pre); + + if (fsym->attr.value) + tmp = parmse.expr; + else + tmp = build_fold_indirect_ref_loc (input_location, + parmse.expr); + parm_rank = e->rank; switch (parm_kind) { @@ -7136,7 +7146,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr, /* Assign a derived type constructor to a variable. */ -static tree +tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init) { gfc_constructor *c; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index e2a1fea..3198c55 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -666,6 +666,9 @@ tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespe /* Generate code to call realloc(). */ tree gfc_call_realloc (stmtblock_t *, tree, tree); +/* Assign a derived type constructor to a variable. */ +tree gfc_trans_structure_assign (tree, gfc_expr *, bool); + /* Generate code for an assignment, includes scalarization. */ tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool); diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 new file mode 100644 index 0000000..28c0beb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 @@ -0,0 +1,42 @@ +! { dg-do run } +! { dg-options "-Wreturn-type" } +! +! Check that pr58586 is fixed now. +! Based on a contribution by Vladimir Fuka +! Contibuted by Andre Vehreschild + +program test_pr58586 + implicit none + + type :: a + end type + + type :: c + type(a), allocatable :: a + end type + + type :: b + integer, allocatable :: a + end type + + ! These two are merely to check, if compilation works + call add(b()) + call add(b(null())) + + ! This needs to execute, to see whether the segfault at runtime is resolved + call add_c(c_init()) + +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + type(c) function c_init() ! { dg-warning "not set" } + end function +end program test_pr58586 + diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 new file mode 100644 index 0000000..578df83 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 @@ -0,0 +1,74 @@ +! { dg-do run } +! { dg-options "-Wreturn-type" } +! +! Check that pr58586 is fixed now. +! Based on a contribution by Vladimir Fuka +! Contibuted by Andre Vehreschild + +module test_pr58586_mod + implicit none + + type :: a + end type + + type :: c + type(a), allocatable :: a + end type + + type :: d + contains + procedure :: init => d_init + end type + + type, extends(d) :: e + contains + procedure :: init => e_init + end type + + type :: b + integer, allocatable :: a + end type + +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + type(c) function c_init() ! { dg-warning "not set" } + end function + + type(c) function d_init(this) ! { dg-warning "not set" } + class(d) :: this + end function + + type(c) function e_init(this) + class(e) :: this + allocate (e_init%a) + end function +end module test_pr58586_mod + +program test_pr58586 + use test_pr58586_mod + + class(d), allocatable :: od + class(e), allocatable :: oe + ! These two are merely to check, if compilation works + call add(b()) + call add(b(null())) + + ! This needs to execute, to see whether the segfault at runtime is resolved + call add_c(c_init()) + + allocate(od) + call add_c(od%init()) + deallocate(od) + allocate(oe) + call add_c(oe%init()) + deallocate(oe) +end program + ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Patch, Fortran, PR58586, v2] ICE with derived type with allocatable component passed by value 2015-04-23 18:01 ` [Patch, Fortran, PR58586, v2] " Andre Vehreschild @ 2015-04-24 8:37 ` Andre Vehreschild 2015-04-26 10:23 ` Mikael Morin 1 sibling, 0 replies; 19+ messages in thread From: Andre Vehreschild @ 2015-04-24 8:37 UTC (permalink / raw) To: Mikael Morin; +Cc: GCC-Patches-ML, GCC-Fortran-ML Hi all, Just to clear things up, with > I have tested the code in the comments of pr61831 with v2 of this patch and > got no issues. I meant, that I have checked the code in comment #28 of pr61831. With only this patch, there still is an illegal free() of unallocated memory. With this patch and the one of Mikael in comment 44 I get no issues anymore. Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Patch, Fortran, PR58586, v2] ICE with derived type with allocatable component passed by value 2015-04-23 18:01 ` [Patch, Fortran, PR58586, v2] " Andre Vehreschild 2015-04-24 8:37 ` Andre Vehreschild @ 2015-04-26 10:23 ` Mikael Morin 2015-05-05 9:00 ` [Patch, Fortran, PR58586, v3] " Andre Vehreschild 1 sibling, 1 reply; 19+ messages in thread From: Mikael Morin @ 2015-04-26 10:23 UTC (permalink / raw) To: Andre Vehreschild; +Cc: GCC-Patches-ML, GCC-Fortran-ML Hello, I'm reviewing the original patch only for now. The added bits in v2 will have to wait. Le 23/04/2015 20:00, Andre Vehreschild a écrit : >>> diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c >>> index 9e6432f..80dfed1 100644 >>> --- a/gcc/fortran/trans-expr.c >>> +++ b/gcc/fortran/trans-expr.c >>> @@ -5344,8 +5344,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * >>> sym, && (e->expr_type != EXPR_VARIABLE && !e->rank)) >>> { >>> int parm_rank; >>> - tmp = build_fold_indirect_ref_loc (input_location, >>> - parmse.expr); >>> + /* It is known the e returns a structure type with at least one >>> + allocatable component. When e is a function, ensure that the >>> + function is called once only by using a temporary variable. >>> */ >>> + if (e->expr_type == EXPR_FUNCTION) >>> + parmse.expr = gfc_evaluate_now_loc (input_location, >>> + parmse.expr, &se->pre); >> You need not limit this to functions only. >> I think you can even do this without condition. > > Yes, one could do that, but then an unnecessary temporary variable in the - for > my taste - already too clobbered pseudo code is introduced. Furthermore, is the > penalty on doing the check for a function negligible. I therefore have not > changed that. All right; would you mind writing it either if (e->expr_type != EXPR_VARIABLE) or if (!DECL_P (parmse.expr)) or if (!VAR_P (parmse.expr)) instead? > >>> + if (POINTER_TYPE_P (TREE_TYPE (parmse.expr))) >> This distinguishes arguments with/without value attribute, right? >> I think it's better to use the frontend information here (fsym->attr.value). > > Changed to check for value. Please check fsym && fsym->attr.value and add the following testcase (it fails with the patch). module m type :: t integer, allocatable :: comp end type type :: u type(t), allocatable :: comp end type end module m use m call sub(u()) end OK with these changes. > >> Ah, and don't forget to provide a ChangeLog entry with it. > > The Changelog entry comes in an additional attachment. > It doesn't appear inline in my mailer as its content type is application/octet-stream, so I missed it. Sorry. Thanks for the patch. I will review the rest later. Mikael ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Patch, Fortran, PR58586, v3] ICE with derived type with allocatable component passed by value 2015-04-26 10:23 ` Mikael Morin @ 2015-05-05 9:00 ` Andre Vehreschild 2015-05-07 10:15 ` Mikael Morin 0 siblings, 1 reply; 19+ messages in thread From: Andre Vehreschild @ 2015-05-05 9:00 UTC (permalink / raw) To: Mikael Morin; +Cc: GCC-Patches-ML, GCC-Fortran-ML [-- Attachment #1: Type: text/plain, Size: 3213 bytes --] Hi Mikael, hi all, Mikael, thanks for the review so far. I have inserted the changes requested and updated this patch to trunk. For the e->expr_type == EXPR_FUNCTION I have choose !DECL_P(parmse.expr) to not only prevent VAR_DECLs aliasing, but also prevent aliasing for PARM_DECLs and similar. Bootstraps and regtests ok on x86_64-linux-gnu/F21. Note, this patch also fixes the regression in alloc_comp_constructor_1.f90 introduced by my patch for pr44672, v4. The memory loss is also fixed again. Ok for trunk? Regards, Andre On Sun, 26 Apr 2015 12:22:56 +0200 Mikael Morin <mikael.morin@sfr.fr> wrote: > Hello, > > I'm reviewing the original patch only for now. > The added bits in v2 will have to wait. > > Le 23/04/2015 20:00, Andre Vehreschild a écrit : > >>> diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c > >>> index 9e6432f..80dfed1 100644 > >>> --- a/gcc/fortran/trans-expr.c > >>> +++ b/gcc/fortran/trans-expr.c > >>> @@ -5344,8 +5344,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * > >>> sym, && (e->expr_type != EXPR_VARIABLE && !e->rank)) > >>> { > >>> int parm_rank; > >>> - tmp = build_fold_indirect_ref_loc (input_location, > >>> - parmse.expr); > >>> + /* It is known the e returns a structure type with at least one > >>> + allocatable component. When e is a function, ensure that > >>> the > >>> + function is called once only by using a temporary variable. > >>> */ > >>> + if (e->expr_type == EXPR_FUNCTION) > >>> + parmse.expr = gfc_evaluate_now_loc (input_location, > >>> + parmse.expr, &se->pre); > >> You need not limit this to functions only. > >> I think you can even do this without condition. > > > > Yes, one could do that, but then an unnecessary temporary variable in the - > > for my taste - already too clobbered pseudo code is introduced. > > Furthermore, is the penalty on doing the check for a function negligible. I > > therefore have not changed that. > > All right; would you mind writing it either > if (e->expr_type != EXPR_VARIABLE) > or > if (!DECL_P (parmse.expr)) > or > if (!VAR_P (parmse.expr)) > instead? > > > > >>> + if (POINTER_TYPE_P (TREE_TYPE (parmse.expr))) > >> This distinguishes arguments with/without value attribute, right? > >> I think it's better to use the frontend information here > >> (fsym->attr.value). > > > > Changed to check for value. > > Please check fsym && fsym->attr.value > and add the following testcase (it fails with the patch). > > > module m > type :: t > integer, allocatable :: comp > end type > type :: u > type(t), allocatable :: comp > end type > end module m > > use m > call sub(u()) > end > > > OK with these changes. > > > > >> Ah, and don't forget to provide a ChangeLog entry with it. > > > > The Changelog entry comes in an additional attachment. > > > It doesn't appear inline in my mailer as its content type is > application/octet-stream, so I missed it. Sorry. > > Thanks for the patch. I will review the rest later. > > Mikael -- Andre Vehreschild * Email: vehre ad gmx dot de [-- Attachment #2: pr58586_3.clog --] [-- Type: text/plain, Size: 1393 bytes --] gcc/testsuite/ChangeLog: 2015-05-05 Andre Vehreschild <vehre@gmx.de> * gfortran.dg/alloc_comp_class_3.f03: New test. * gfortran.dg/alloc_comp_class_4.f03: New test. gcc/fortran/ChangeLog: 2015-04-23 Andre Vehreschild <vehre@gmx.de> PR fortran/58586 * resolve.c (resolve_symbol): Non-private functions in modules with allocatable or pointer components are marked referenced now. Furthermore is the default init especially for those components now done in gfc_conf_procedure_call preventing duplicate code. * trans-decl.c (build_function_decl): Set the result decl when the function symbol and the result symbol are equal. (gfc_generate_function_code): Generate a fake result decl for functions returning an object with allocatable components and initialize them. * trans-expr.c (gfc_conv_procedure_call): For value typed trees use the tree without indirect ref. And for non-decl trees add a temporary variable to prevent evaluating the tree multiple times (prevent multiple function evaluations). * trans.h: Made gfc_trans_structure_assign () protoype available, which is now needed by trans-decl.c:gfc_generate_ function_code(), too. gcc/fortran/ChangeLog: 2015-05-05 Andre Vehreschild <vehre@gmx.de> * resolve.c (resolve_symbol): * trans-decl.c (build_function_decl): (gfc_generate_function_code): * trans-expr.c (gfc_conv_procedure_call): * trans.h: [-- Attachment #3: pr58586_3.patch --] [-- Type: text/x-patch, Size: 8707 bytes --] diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 2ac4689..72df35e 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -14093,10 +14093,15 @@ resolve_symbol (gfc_symbol *sym) if ((!a->save && !a->dummy && !a->pointer && !a->in_common && !a->use_assoc - && (a->referenced || a->result) - && !(a->function && sym != sym->result)) + && !a->result && !a->function) || (a->dummy && a->intent == INTENT_OUT && !a->pointer)) apply_default_init (sym); + else if (a->function && sym->result && a->access != ACCESS_PRIVATE + && (sym->ts.u.derived->attr.alloc_comp + || sym->ts.u.derived->attr.pointer_comp)) + /* Mark the result symbol to be referenced, when it has allocatable + components. */ + sym->result->attr.referenced = 1; } if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 4c18920..0b63175 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2158,6 +2158,8 @@ build_function_decl (gfc_symbol * sym, bool global) gfc_set_decl_assembler_name (fndecl, gfc_sym_mangled_function_id (sym)); sym->backend_decl = fndecl; + if (sym == sym->result && !sym->result->backend_decl) + sym->result->backend_decl = result_decl; } @@ -5898,8 +5900,21 @@ gfc_generate_function_code (gfc_namespace * ns) if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node) { + bool artificial_result_decl = false; tree result = get_proc_result (sym); + /* Make sure that a function returning an object with + alloc/pointer_components always has a result, where at least + the allocatable/pointer components are set to zero. */ + if (result == NULL_TREE && sym->attr.function + && sym->ts.type == BT_DERIVED + && (sym->ts.u.derived->attr.alloc_comp + || sym->ts.u.derived->attr.pointer_comp)) + { + artificial_result_decl = true; + result = gfc_get_fake_result_decl (sym, 0); + } + if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer) { if (sym->attr.allocatable && sym->attr.dimension == 0 @@ -5918,16 +5933,26 @@ gfc_generate_function_code (gfc_namespace * ns) null_pointer_node)); } else if (sym->ts.type == BT_DERIVED - && sym->ts.u.derived->attr.alloc_comp && !sym->attr.allocatable) { - rank = sym->as ? sym->as->rank : 0; - tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); - gfc_add_expr_to_block (&init, tmp); + gfc_expr *init_exp; + init_exp = gfc_default_initializer (&sym->ts); + if (init_exp) + { + tmp = gfc_trans_structure_assign (result, init_exp, 0); + gfc_free_expr (init_exp); + gfc_add_expr_to_block (&init, tmp); + } + else if (sym->ts.u.derived->attr.alloc_comp) + { + rank = sym->as ? sym->as->rank : 0; + tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); + gfc_add_expr_to_block (&init, tmp); + } } } - if (result == NULL_TREE) + if (result == NULL_TREE || artificial_result_decl) { /* TODO: move to the appropriate place in resolve.c. */ if (warn_return_type && sym == sym->result) @@ -5937,7 +5962,7 @@ gfc_generate_function_code (gfc_namespace * ns) if (warn_return_type) TREE_NO_WARNING(sym->backend_decl) = 1; } - else + if (result != NULL_TREE) gfc_add_expr_to_block (&body, gfc_generate_return ()); } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 4bbd685..16e584a 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1472,7 +1472,6 @@ realloc_lhs_warning (bt type, bool array, locus *where) } -static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init); static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *, gfc_expr *); @@ -5341,12 +5340,22 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (e && (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS) && e->ts.u.derived->attr.alloc_comp && !(e->symtree && e->symtree->n.sym->attr.pointer) - && e->expr_type != EXPR_VARIABLE && !e->rank - && e->expr_type != EXPR_STRUCTURE) + && e->expr_type != EXPR_VARIABLE && !e->rank) { int parm_rank; - tmp = build_fold_indirect_ref_loc (input_location, - parmse.expr); + /* It is known the e returns a structure type with at least one + allocatable component. When e is a function, ensure that the + function is called once only by using a temporary variable. */ + if (!DECL_P (parmse.expr)) + parmse.expr = gfc_evaluate_now_loc (input_location, + parmse.expr, &se->pre); + + if (fsym && fsym->attr.value) + tmp = parmse.expr; + else + tmp = build_fold_indirect_ref_loc (input_location, + parmse.expr); + parm_rank = e->rank; switch (parm_kind) { @@ -7137,7 +7146,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr, /* Assign a derived type constructor to a variable. */ -static tree +tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init) { gfc_constructor *c; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index e2a1fea..3198c55 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -666,6 +666,9 @@ tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespe /* Generate code to call realloc(). */ tree gfc_call_realloc (stmtblock_t *, tree, tree); +/* Assign a derived type constructor to a variable. */ +tree gfc_trans_structure_assign (tree, gfc_expr *, bool); + /* Generate code for an assignment, includes scalarization. */ tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool); diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 new file mode 100644 index 0000000..0753e33 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 @@ -0,0 +1,55 @@ +! { dg-do run } +! { dg-options "-Wreturn-type" } +! +! Check that pr58586 is fixed now. +! Based on a contribution by Vladimir Fuka +! Contibuted by Andre Vehreschild + +program test_pr58586 + implicit none + + type :: a + end type + + type :: c + type(a), allocatable :: a + end type + + type :: b + integer, allocatable :: a + end type + + type :: t + integer, allocatable :: comp + end type + type :: u + type(t), allocatable :: comp + end type + + + ! These two are merely to check, if compilation works + call add(b()) + call add(b(null())) + + ! This needs to execute, to see whether the segfault at runtime is resolved + call add_c(c_init()) + + call sub(u()) +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + type(c) function c_init() ! { dg-warning "not set" } + end function + + subroutine sub(d) + type(u), value :: d + end subroutine +end program test_pr58586 + diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 new file mode 100644 index 0000000..578df83 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 @@ -0,0 +1,74 @@ +! { dg-do run } +! { dg-options "-Wreturn-type" } +! +! Check that pr58586 is fixed now. +! Based on a contribution by Vladimir Fuka +! Contibuted by Andre Vehreschild + +module test_pr58586_mod + implicit none + + type :: a + end type + + type :: c + type(a), allocatable :: a + end type + + type :: d + contains + procedure :: init => d_init + end type + + type, extends(d) :: e + contains + procedure :: init => e_init + end type + + type :: b + integer, allocatable :: a + end type + +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + type(c) function c_init() ! { dg-warning "not set" } + end function + + type(c) function d_init(this) ! { dg-warning "not set" } + class(d) :: this + end function + + type(c) function e_init(this) + class(e) :: this + allocate (e_init%a) + end function +end module test_pr58586_mod + +program test_pr58586 + use test_pr58586_mod + + class(d), allocatable :: od + class(e), allocatable :: oe + ! These two are merely to check, if compilation works + call add(b()) + call add(b(null())) + + ! This needs to execute, to see whether the segfault at runtime is resolved + call add_c(c_init()) + + allocate(od) + call add_c(od%init()) + deallocate(od) + allocate(oe) + call add_c(oe%init()) + deallocate(oe) +end program + ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Patch, Fortran, PR58586, v3] ICE with derived type with allocatable component passed by value 2015-05-05 9:00 ` [Patch, Fortran, PR58586, v3] " Andre Vehreschild @ 2015-05-07 10:15 ` Mikael Morin 2015-05-08 10:54 ` Andre Vehreschild 0 siblings, 1 reply; 19+ messages in thread From: Mikael Morin @ 2015-05-07 10:15 UTC (permalink / raw) To: Andre Vehreschild; +Cc: GCC-Patches-ML, GCC-Fortran-ML Hello, Le 05/05/2015 11:00, Andre Vehreschild a écrit : > diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c > index 4c18920..0b63175 100644 > --- a/gcc/fortran/trans-decl.c > +++ b/gcc/fortran/trans-decl.c > @@ -2158,6 +2158,8 @@ build_function_decl (gfc_symbol * sym, bool global) > gfc_set_decl_assembler_name (fndecl, gfc_sym_mangled_function_id (sym)); > > sym->backend_decl = fndecl; > + if (sym == sym->result && !sym->result->backend_decl) > + sym->result->backend_decl = result_decl; Something is seriously misbehaving if the condition is true, and setting sym->backend_decl to result_decl doesn't seem any better than keeping it NULL. So, please remove this change > } > > > @@ -5898,8 +5900,21 @@ gfc_generate_function_code (gfc_namespace * ns) > > if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node) > { > + bool artificial_result_decl = false; > tree result = get_proc_result (sym); > > + /* Make sure that a function returning an object with > + alloc/pointer_components always has a result, where at least > + the allocatable/pointer components are set to zero. */ > + if (result == NULL_TREE && sym->attr.function > + && sym->ts.type == BT_DERIVED > + && (sym->ts.u.derived->attr.alloc_comp > + || sym->ts.u.derived->attr.pointer_comp)) > + { > + artificial_result_decl = true; > + result = gfc_get_fake_result_decl (sym, 0); > + } I expect the "fake" result decl to be needed in more cases. For example, if type is BT_CLASS. Here is a variant of alloc_comp_class_4.f03:c_init for such a case. class(c) function c_init2() allocatable :: c_init2 end function or even without class: type(t) function t_init() allocatable :: t_init end function for some any type t. So, remove the check for alloc_comp/pointer_comp and permit BT_CLASS. One minor thing, check sym->result's type and attribute instead of sym's here. It should not make a difference, but I think it's more correct. The rest looks good. The patch is OK with the suggested changes above. Thanks. I don't think the test functions above work well enough to be incorporated in a testcase for now. Mikael ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Patch, Fortran, PR58586, v3] ICE with derived type with allocatable component passed by value 2015-05-07 10:15 ` Mikael Morin @ 2015-05-08 10:54 ` Andre Vehreschild 2015-05-08 13:21 ` Mikael Morin 0 siblings, 1 reply; 19+ messages in thread From: Andre Vehreschild @ 2015-05-08 10:54 UTC (permalink / raw) To: Mikael Morin; +Cc: GCC-Patches-ML, GCC-Fortran-ML [-- Attachment #1: Type: text/plain, Size: 4908 bytes --] Hi Mikael, thanks for the review. I still have some questions/remarks before commiting: On Thu, 07 May 2015 12:14:59 +0200 Mikael Morin <mikael.morin@sfr.fr> wrote: <snip> > > @@ -2158,6 +2158,8 @@ build_function_decl (gfc_symbol * sym, bool global) > > gfc_set_decl_assembler_name (fndecl, gfc_sym_mangled_function_id > > (sym)); > > sym->backend_decl = fndecl; > > + if (sym == sym->result && !sym->result->backend_decl) > > + sym->result->backend_decl = result_decl; > > Something is seriously misbehaving if the condition is true, and setting > sym->backend_decl to result_decl doesn't seem any better than keeping it > NULL. > So, please remove this change Did that. I think this was a relic from the start of me trying to understand what was the issue and how to fix it. Later I didn't check, if it was still necessary. Sorry for that. > > @@ -5898,8 +5900,21 @@ gfc_generate_function_code (gfc_namespace * ns) > > > > if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node) > > { > > + bool artificial_result_decl = false; > > tree result = get_proc_result (sym); > > > > + /* Make sure that a function returning an object with > > + alloc/pointer_components always has a result, where at least > > + the allocatable/pointer components are set to zero. */ > > + if (result == NULL_TREE && sym->attr.function > > + && sym->ts.type == BT_DERIVED > > + && (sym->ts.u.derived->attr.alloc_comp > > + || sym->ts.u.derived->attr.pointer_comp)) > > + { > > + artificial_result_decl = true; > > + result = gfc_get_fake_result_decl (sym, 0); > > + } > > I expect the "fake" result decl to be needed in more cases. > For example, if type is BT_CLASS. > Here is a variant of alloc_comp_class_4.f03:c_init for such a case. > > class(c) function c_init2() > allocatable :: c_init2 > end function > > or even without class: > > type(t) function t_init() > allocatable :: t_init > end function > > for some any type t. > > So, remove the check for alloc_comp/pointer_comp and permit BT_CLASS. > One minor thing, check sym->result's type and attribute instead of sym's > here. It should not make a difference, but I think it's more correct. I am d'accord with checking sym->result, but I am not happy with removing the checks for alloc_comp|pointer_comp. When I got you right there, you propose the if to be like this: if (result == NULL_TREE && sym->attr.function && (sym->result->ts.type == BT_DERIVED || sym->result->ts.type == BT_CLASS)) Removing the attribute checks means to initialize every derived/class type result, which may change the semantics of the code more than intented. Look for example at this code type t integer :: i = 5 end type type(t) function static_t_init() end function When one compiles this code with -Wreturn-type, then the warning of an uninitialized return value is issued at the function declaration. Nevertheless the result of static_t_init is validly initialized and i is 5. This may confuse users. I therefore came to the very ugly solution to make this: if (result == NULL_TREE && sym->attr.function && ((sym->result->ts.type == BT_DERIVED && (sym->results->attr.allocatable || sym->result->ts.u.derived->attr.alloc_comp || sym->result->ts.u.derived->attr.pointer_comp)) || (sym->result->ts.type == BT_CLASS && (CLASS_DATA (sym->result)->attr.allocatable || CLASS_DATA (sym->result)->attr.alloc_comp || CLASS_DATA (sym->result)->attr.pointer_comp)))) (I am not yet sure, whether the pointer attribute needs to be added to.) With the code above the result of static_t_init is not initialized with all the consequences. So what do you propose to do here? Btw, I think I found an additional bug during testing: type(t) function t_init() allocatable :: t_init end function when called by: type(t), allocatable :: temp temp = t_init() a segfault occurs, because the result of t_init() is NULL, which is dereferenced by the caller in this pseudo-code: if (temp != 0B) goto L.12; temp = (struct t *) __builtin_malloc (4); L.12:; *temp = *t_init (); <-- This obviously is problematic. > The rest looks good. > The patch is OK with the suggested changes above. Thanks. > I don't think the test functions above work well enough to be > incorporated in a testcase for now. ?? I don't get you there? What do you mean? Do you think the alloc_comp_class_3/4.* are not correctly testing the issue? Any idea of how to test this better? I mean the pr is about this artificial constructs. I merely struck it in search of a pr about allocatable components. Attached is a version of the patch that I currently use. Note the testcase alloc_comp_class_4.f03 fails currently, because of the error noted above in line 94. Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de [-- Attachment #2: pr58586_4.patch --] [-- Type: text/x-patch, Size: 9368 bytes --] diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 2ac4689..72df35e 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -14093,10 +14093,15 @@ resolve_symbol (gfc_symbol *sym) if ((!a->save && !a->dummy && !a->pointer && !a->in_common && !a->use_assoc - && (a->referenced || a->result) - && !(a->function && sym != sym->result)) + && !a->result && !a->function) || (a->dummy && a->intent == INTENT_OUT && !a->pointer)) apply_default_init (sym); + else if (a->function && sym->result && a->access != ACCESS_PRIVATE + && (sym->ts.u.derived->attr.alloc_comp + || sym->ts.u.derived->attr.pointer_comp)) + /* Mark the result symbol to be referenced, when it has allocatable + components. */ + sym->result->attr.referenced = 1; } if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 4c18920..bcafd8c5 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -5898,8 +5898,26 @@ gfc_generate_function_code (gfc_namespace * ns) if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node) { + bool artificial_result_decl = false; tree result = get_proc_result (sym); + /* Make sure that a function returning an object with + alloc/pointer_components always has a result, where at least + the allocatable/pointer components are set to zero. */ + if (result == NULL_TREE && sym->attr.function + && ((sym->result->ts.type == BT_DERIVED + && (sym->result->attr.allocatable + || sym->result->ts.u.derived->attr.alloc_comp + || sym->result->ts.u.derived->attr.pointer_comp)) + || (sym->result->ts.type == BT_CLASS + && (CLASS_DATA (sym->result)->attr.allocatable + || CLASS_DATA (sym->result)->attr.alloc_comp + || CLASS_DATA (sym->result)->attr.pointer_comp)))) + { + artificial_result_decl = true; + result = gfc_get_fake_result_decl (sym, 0); + } + if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer) { if (sym->attr.allocatable && sym->attr.dimension == 0 @@ -5918,16 +5936,26 @@ gfc_generate_function_code (gfc_namespace * ns) null_pointer_node)); } else if (sym->ts.type == BT_DERIVED - && sym->ts.u.derived->attr.alloc_comp && !sym->attr.allocatable) { - rank = sym->as ? sym->as->rank : 0; - tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); - gfc_add_expr_to_block (&init, tmp); + gfc_expr *init_exp; + init_exp = gfc_default_initializer (&sym->ts); + if (init_exp) + { + tmp = gfc_trans_structure_assign (result, init_exp, 0); + gfc_free_expr (init_exp); + gfc_add_expr_to_block (&init, tmp); + } + else if (sym->ts.u.derived->attr.alloc_comp) + { + rank = sym->as ? sym->as->rank : 0; + tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); + gfc_add_expr_to_block (&init, tmp); + } } } - if (result == NULL_TREE) + if (result == NULL_TREE || artificial_result_decl) { /* TODO: move to the appropriate place in resolve.c. */ if (warn_return_type && sym == sym->result) @@ -5937,7 +5965,7 @@ gfc_generate_function_code (gfc_namespace * ns) if (warn_return_type) TREE_NO_WARNING(sym->backend_decl) = 1; } - else + if (result != NULL_TREE) gfc_add_expr_to_block (&body, gfc_generate_return ()); } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 4bbd685..16e584a 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1472,7 +1472,6 @@ realloc_lhs_warning (bt type, bool array, locus *where) } -static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init); static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *, gfc_expr *); @@ -5341,12 +5340,22 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (e && (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS) && e->ts.u.derived->attr.alloc_comp && !(e->symtree && e->symtree->n.sym->attr.pointer) - && e->expr_type != EXPR_VARIABLE && !e->rank - && e->expr_type != EXPR_STRUCTURE) + && e->expr_type != EXPR_VARIABLE && !e->rank) { int parm_rank; - tmp = build_fold_indirect_ref_loc (input_location, - parmse.expr); + /* It is known the e returns a structure type with at least one + allocatable component. When e is a function, ensure that the + function is called once only by using a temporary variable. */ + if (!DECL_P (parmse.expr)) + parmse.expr = gfc_evaluate_now_loc (input_location, + parmse.expr, &se->pre); + + if (fsym && fsym->attr.value) + tmp = parmse.expr; + else + tmp = build_fold_indirect_ref_loc (input_location, + parmse.expr); + parm_rank = e->rank; switch (parm_kind) { @@ -7137,7 +7146,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr, /* Assign a derived type constructor to a variable. */ -static tree +tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init) { gfc_constructor *c; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index e2a1fea..3198c55 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -666,6 +666,9 @@ tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespe /* Generate code to call realloc(). */ tree gfc_call_realloc (stmtblock_t *, tree, tree); +/* Assign a derived type constructor to a variable. */ +tree gfc_trans_structure_assign (tree, gfc_expr *, bool); + /* Generate code for an assignment, includes scalarization. */ tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool); diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 new file mode 100644 index 0000000..0753e33 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 @@ -0,0 +1,55 @@ +! { dg-do run } +! { dg-options "-Wreturn-type" } +! +! Check that pr58586 is fixed now. +! Based on a contribution by Vladimir Fuka +! Contibuted by Andre Vehreschild + +program test_pr58586 + implicit none + + type :: a + end type + + type :: c + type(a), allocatable :: a + end type + + type :: b + integer, allocatable :: a + end type + + type :: t + integer, allocatable :: comp + end type + type :: u + type(t), allocatable :: comp + end type + + + ! These two are merely to check, if compilation works + call add(b()) + call add(b(null())) + + ! This needs to execute, to see whether the segfault at runtime is resolved + call add_c(c_init()) + + call sub(u()) +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + type(c) function c_init() ! { dg-warning "not set" } + end function + + subroutine sub(d) + type(u), value :: d + end subroutine +end program test_pr58586 + diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 new file mode 100644 index 0000000..e4c796e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 @@ -0,0 +1,104 @@ +! { dg-do run } +! { dg-options "-Wreturn-type" } +! +! Check that pr58586 is fixed now. +! Based on a contribution by Vladimir Fuka +! Contibuted by Andre Vehreschild + +module test_pr58586_mod + implicit none + + type :: a + end type + + type :: c + type(a), allocatable :: a + end type + + type :: d + contains + procedure :: init => d_init + end type + + type, extends(d) :: e + contains + procedure :: init => e_init + end type + + type :: b + integer, allocatable :: a + end type + + type t + integer :: i = 5 + end type + +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + subroutine add_class_c (d) + class(c), value :: d + end subroutine + + subroutine add_t (d) + type(t), value :: d + end subroutine + + type(c) function c_init() ! { dg-warning "not set" } + end function + + class(c) function c_init2() ! { dg-warning "not set" } + allocatable :: c_init2 + end function + + type(c) function d_init(this) ! { dg-warning "not set" } + class(d) :: this + end function + + type(c) function e_init(this) + class(e) :: this + allocate (e_init%a) + end function + + type(t) function t_init() ! { dg-warning "not set" } + allocatable :: t_init + end function + + type(t) function static_t_init() ! { dg-warning "not set" } + end function +end module test_pr58586_mod + +program test_pr58586 + use test_pr58586_mod + + class(d), allocatable :: od + class(e), allocatable :: oe + type(t), allocatable :: temp + + ! These two are merely to check, if compilation works + call add(b()) + call add(b(null())) + + ! This needs to execute, to see whether the segfault at runtime is resolved + call add_c(c_init()) + call add_class_c(c_init2()) + + call add_t(static_t_init()) + temp = t_init() ! <-- This derefs a null-pointer currently + if (allocated (temp)) call abort() + + allocate(od) + call add_c(od%init()) + deallocate(od) + allocate(oe) + call add_c(oe%init()) + deallocate(oe) +end program + ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Patch, Fortran, PR58586, v3] ICE with derived type with allocatable component passed by value 2015-05-08 10:54 ` Andre Vehreschild @ 2015-05-08 13:21 ` Mikael Morin 2015-05-08 13:31 ` Andre Vehreschild 0 siblings, 1 reply; 19+ messages in thread From: Mikael Morin @ 2015-05-08 13:21 UTC (permalink / raw) To: Andre Vehreschild; +Cc: GCC-Patches-ML, GCC-Fortran-ML Le 08/05/2015 12:54, Andre Vehreschild a écrit : > Hi Mikael, > > thanks for the review. I still have some questions/remarks before commiting: > >>> @@ -5898,8 +5900,21 @@ gfc_generate_function_code (gfc_namespace * ns) >>> >>> if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node) >>> { >>> + bool artificial_result_decl = false; >>> tree result = get_proc_result (sym); >>> >>> + /* Make sure that a function returning an object with >>> + alloc/pointer_components always has a result, where at least >>> + the allocatable/pointer components are set to zero. */ >>> + if (result == NULL_TREE && sym->attr.function >>> + && sym->ts.type == BT_DERIVED >>> + && (sym->ts.u.derived->attr.alloc_comp >>> + || sym->ts.u.derived->attr.pointer_comp)) >>> + { >>> + artificial_result_decl = true; >>> + result = gfc_get_fake_result_decl (sym, 0); >>> + } >> >> I expect the "fake" result decl to be needed in more cases. >> For example, if type is BT_CLASS. >> Here is a variant of alloc_comp_class_4.f03:c_init for such a case. >> >> class(c) function c_init2() >> allocatable :: c_init2 >> end function >> >> or even without class: >> >> type(t) function t_init() >> allocatable :: t_init >> end function >> >> for some any type t. >> >> So, remove the check for alloc_comp/pointer_comp and permit BT_CLASS. >> One minor thing, check sym->result's type and attribute instead of sym's >> here. It should not make a difference, but I think it's more correct. > > I am d'accord with checking sym->result, but I am not happy with removing the > checks for alloc_comp|pointer_comp. When I got you right there, you propose the > if to be like this: > > if (result == NULL_TREE && sym->attr.function > && (sym->result->ts.type == BT_DERIVED > || sym->result->ts.type == BT_CLASS)) > > Removing the attribute checks means to initialize every derived/class type > result, which may change the semantics of the code more than intented. Look for > example at this code > > type t > integer :: i = 5 > end type > > type(t) function static_t_init() > end function > > When one compiles this code with -Wreturn-type, then the warning of an > uninitialized return value is issued at the function declaration. Nevertheless > the result of static_t_init is validly initialized and i is 5. This may > confuse users. > > I therefore came to the very ugly solution to make this: > > if (result == NULL_TREE && sym->attr.function > && ((sym->result->ts.type == BT_DERIVED > && (sym->results->attr.allocatable > || sym->result->ts.u.derived->attr.alloc_comp > || sym->result->ts.u.derived->attr.pointer_comp)) > || (sym->result->ts.type == BT_CLASS > && (CLASS_DATA (sym->result)->attr.allocatable > || CLASS_DATA (sym->result)->attr.alloc_comp > || CLASS_DATA (sym->result)->attr.pointer_comp)))) > > (I am not yet sure, whether the pointer attribute needs to be added to.) With > the code above the result of static_t_init is not initialized with all the > consequences. > > So what do you propose to do here? To be honest, I don't know this part of the code very well. I'll think about it some more. > Btw, I think I found an additional bug during testing: > type(t) function t_init() > allocatable :: t_init > end function > > when called by: > type(t), allocatable :: temp > temp = t_init() > > a segfault occurs, because the result of t_init() is NULL, which is > dereferenced by the caller in this pseudo-code: > > if (temp != 0B) goto L.12; > temp = (struct t *) __builtin_malloc (4); > L.12:; > *temp = *t_init (); <-- This obviously is problematic. > >> The rest looks good. >> The patch is OK with the suggested changes above. Thanks. >> I don't think the test functions above work well enough to be >> incorporated in a testcase for now. > > ?? I don't get you there? What do you mean? Do you think the > alloc_comp_class_3/4.* are not correctly testing the issue? Any idea of how to > test this better? I mean the pr is about this artificial constructs. I merely > struck it in search of a pr about allocatable components. I was talking about the bug you found with t_init above. :-) the compiler is not ready to accept that function in a testcase. The alloc_omp_class_3/4 are fine. Mikael ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Patch, Fortran, PR58586, v3] ICE with derived type with allocatable component passed by value 2015-05-08 13:21 ` Mikael Morin @ 2015-05-08 13:31 ` Andre Vehreschild 2015-05-08 14:11 ` Andre Vehreschild 0 siblings, 1 reply; 19+ messages in thread From: Andre Vehreschild @ 2015-05-08 13:31 UTC (permalink / raw) To: Mikael Morin; +Cc: GCC-Patches-ML, GCC-Fortran-ML Hi Mikael, > > ?? I don't get you there? What do you mean? Do you think the > > alloc_comp_class_3/4.* are not correctly testing the issue? Any idea of how > > to test this better? I mean the pr is about this artificial constructs. I > > merely struck it in search of a pr about allocatable components. > > I was talking about the bug you found with t_init above. :-) > the compiler is not ready to accept that function in a testcase. > The alloc_omp_class_3/4 are fine. Oh, sorry, I misunderstood you there. Now let's see, where that one is hiding. - Andre -- Andre Vehreschild * Email: vehre ad gmx dot de ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Patch, Fortran, PR58586, v3] ICE with derived type with allocatable component passed by value 2015-05-08 13:31 ` Andre Vehreschild @ 2015-05-08 14:11 ` Andre Vehreschild 2015-05-19 14:02 ` [Patch, Fortran, PR58586, v4] " Andre Vehreschild 0 siblings, 1 reply; 19+ messages in thread From: Andre Vehreschild @ 2015-05-08 14:11 UTC (permalink / raw) To: Mikael Morin; +Cc: GCC-Patches-ML, GCC-Fortran-ML [-- Attachment #1: Type: text/plain, Size: 996 bytes --] Hi, so attached is a quick and dirty solution for the allocatable return value problem. I personally don't like it. It is making a special case from the assign a function result to a variable. May be you have a better idea how to do this in gfortran style. - Andre On Fri, 8 May 2015 15:31:46 +0200 Andre Vehreschild <vehre@gmx.de> wrote: > Hi Mikael, > > > > ?? I don't get you there? What do you mean? Do you think the > > > alloc_comp_class_3/4.* are not correctly testing the issue? Any idea of > > > how to test this better? I mean the pr is about this artificial > > > constructs. I merely struck it in search of a pr about allocatable > > > components. > > > > I was talking about the bug you found with t_init above. :-) > > the compiler is not ready to accept that function in a testcase. > > The alloc_omp_class_3/4 are fine. > > Oh, sorry, I misunderstood you there. Now let's see, where that one is hiding. > > - Andre -- Andre Vehreschild * Email: vehre ad gmx dot de [-- Attachment #2: alloc_func_result.patch --] [-- Type: text/x-patch, Size: 1633 bytes --] diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 402d9b9..87e2cde 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -9043,6 +9043,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, stmtblock_t body; bool l_is_temp; bool scalar_to_array; + bool alloc_to_alloc; tree string_length; int n; @@ -9156,6 +9157,18 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, else gfc_conv_expr (&lse, expr1); + alloc_to_alloc = expr1->expr_type == EXPR_VARIABLE + && expr1->symtree->n.sym->ts.type == BT_DERIVED + && expr1->symtree->n.sym->attr.allocatable + && expr2->expr_type == EXPR_FUNCTION + && expr2->ts.type == BT_DERIVED + && expr2->value.function.esym->attr.allocatable; + if (alloc_to_alloc) + { + rse.expr = gfc_build_addr_expr (NULL_TREE, rse.expr); + lse.expr = gfc_build_addr_expr (NULL_TREE, lse.expr);; + } + /* Assignments of scalar derived types with allocatable components to arrays must be done with a deep copy and the rhs temporary must have its components deallocated afterwards. */ @@ -9208,7 +9221,8 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, if (lss == gfc_ss_terminator) { /* F2003: Add the code for reallocation on assignment. */ - if (flag_realloc_lhs && is_scalar_reallocatable_lhs (expr1)) + if (flag_realloc_lhs && !alloc_to_alloc + && is_scalar_reallocatable_lhs (expr1)) alloc_scalar_allocatable_for_assignment (&block, string_length, expr1, expr2); ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Patch, Fortran, PR58586, v4] ICE with derived type with allocatable component passed by value 2015-05-08 14:11 ` Andre Vehreschild @ 2015-05-19 14:02 ` Andre Vehreschild 2015-07-03 9:29 ` [Ping, Patch, Fortran, PR58586, v5] " Andre Vehreschild 0 siblings, 1 reply; 19+ messages in thread From: Andre Vehreschild @ 2015-05-19 14:02 UTC (permalink / raw) To: GCC-Patches-ML, GCC-Fortran-ML [-- Attachment #1: Type: text/plain, Size: 1411 bytes --] Hi, attached is the most recent version of the patch for 58586. It adapts to recent trunk and addresses the caveats so far, i.e. the testcases in the comments now compile and run again w/o errors. Bootstraps and regtests fine on x86_64-linux-gnu/f21. Comments? - Andre On Fri, 8 May 2015 16:11:11 +0200 Andre Vehreschild <vehre@gmx.de> wrote: > Hi, > > so attached is a quick and dirty solution for the allocatable return value > problem. I personally don't like it. It is making a special case from the > assign a function result to a variable. May be you have a better idea how to > do this in gfortran style. > > - Andre > > > On Fri, 8 May 2015 15:31:46 +0200 > Andre Vehreschild <vehre@gmx.de> wrote: > > > Hi Mikael, > > > > > > ?? I don't get you there? What do you mean? Do you think the > > > > alloc_comp_class_3/4.* are not correctly testing the issue? Any idea of > > > > how to test this better? I mean the pr is about this artificial > > > > constructs. I merely struck it in search of a pr about allocatable > > > > components. > > > > > > I was talking about the bug you found with t_init above. :-) > > > the compiler is not ready to accept that function in a testcase. > > > The alloc_omp_class_3/4 are fine. > > > > Oh, sorry, I misunderstood you there. Now let's see, where that one is > > hiding. > > > > - Andre > > -- Andre Vehreschild * Email: vehre ad gmx dot de [-- Attachment #2: pr58586_4.clog --] [-- Type: text/plain, Size: 1062 bytes --] gcc/testsuite/ChangeLog: 2015-05-19 Andre Vehreschild <vehre@gmx.de> * gfortran.dg/alloc_comp_class_3.f03: New test. * gfortran.dg/alloc_comp_class_4.f03: New test. gcc/fortran/ChangeLog: 2015-05-19 Andre Vehreschild <vehre@gmx.de> PR fortran/58586 * resolve.c (resolve_symbol): Non-private functions in modules with allocatable or pointer components are marked referenced now. Furthermore is the default init especially for those components now done in gfc_conf_procedure_call preventing duplicate code. * trans-decl.c (gfc_generate_function_code): Generate a fake result decl for functions returning an object with allocatable components and initialize them. * trans-expr.c (gfc_conv_procedure_call): For value typed trees use the tree without indirect ref. And for non-decl trees add a temporary variable to prevent evaluating the tree multiple times (prevent multiple function evaluations). * trans.h: Made gfc_trans_structure_assign () protoype available, which is now needed by trans-decl.c:gfc_generate_ function_code(), too. [-- Attachment #3: pr58586_4.patch --] [-- Type: text/x-patch, Size: 10216 bytes --] diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index fc11d23..e1b5762 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -14094,10 +14094,15 @@ resolve_symbol (gfc_symbol *sym) if ((!a->save && !a->dummy && !a->pointer && !a->in_common && !a->use_assoc - && (a->referenced || a->result) - && !(a->function && sym != sym->result)) + && !a->result && !a->function) || (a->dummy && a->intent == INTENT_OUT && !a->pointer)) apply_default_init (sym); + else if (a->function && sym->result && a->access != ACCESS_PRIVATE + && (sym->ts.u.derived->attr.alloc_comp + || sym->ts.u.derived->attr.pointer_comp)) + /* Mark the result symbol to be referenced, when it has allocatable + components. */ + sym->result->attr.referenced = 1; } if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 4c18920..f9a91c6 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -5896,9 +5896,33 @@ gfc_generate_function_code (gfc_namespace * ns) tmp = gfc_trans_code (ns->code); gfc_add_expr_to_block (&body, tmp); - if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node) + if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node + || (sym->result && sym->result != sym + && sym->result->ts.type == BT_DERIVED + && sym->result->ts.u.derived->attr.alloc_comp)) { + bool artificial_result_decl = false; tree result = get_proc_result (sym); + gfc_symbol *rsym = sym == sym->result ? sym : sym->result; + + /* Make sure that a function returning an object with + alloc/pointer_components always has a result, where at least + the allocatable/pointer components are set to zero. */ + if (result == NULL_TREE && sym->attr.function + && ((sym->result->ts.type == BT_DERIVED + && (sym->attr.allocatable + || sym->attr.pointer + || sym->result->ts.u.derived->attr.alloc_comp + || sym->result->ts.u.derived->attr.pointer_comp)) + || (sym->result->ts.type == BT_CLASS + && (CLASS_DATA (sym)->attr.allocatable + || CLASS_DATA (sym)->attr.class_pointer + || CLASS_DATA (sym->result)->attr.alloc_comp + || CLASS_DATA (sym->result)->attr.pointer_comp)))) + { + artificial_result_decl = true; + result = gfc_get_fake_result_decl (sym, 0); + } if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer) { @@ -5918,16 +5942,30 @@ gfc_generate_function_code (gfc_namespace * ns) null_pointer_node)); } else if (sym->ts.type == BT_DERIVED - && sym->ts.u.derived->attr.alloc_comp && !sym->attr.allocatable) { - rank = sym->as ? sym->as->rank : 0; - tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); - gfc_add_expr_to_block (&init, tmp); + gfc_expr *init_exp; + /* Arrays are not initialized using the default initializer of + their elements. Therefore only check if a default + initializer is available when the result is scalar. */ + init_exp = rsym->as ? NULL : gfc_default_initializer (&rsym->ts); + if (init_exp) + { + tmp = gfc_trans_structure_assign (result, init_exp, 0); + gfc_free_expr (init_exp); + gfc_add_expr_to_block (&init, tmp); + } + else if (rsym->ts.u.derived->attr.alloc_comp) + { + rank = rsym->as ? rsym->as->rank : 0; + tmp = gfc_nullify_alloc_comp (rsym->ts.u.derived, result, + rank); + gfc_prepend_expr_to_block (&body, tmp); + } } } - if (result == NULL_TREE) + if (result == NULL_TREE || artificial_result_decl) { /* TODO: move to the appropriate place in resolve.c. */ if (warn_return_type && sym == sym->result) @@ -5937,7 +5975,7 @@ gfc_generate_function_code (gfc_namespace * ns) if (warn_return_type) TREE_NO_WARNING(sym->backend_decl) = 1; } - else + if (result != NULL_TREE) gfc_add_expr_to_block (&body, gfc_generate_return ()); } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 710bdcf..048d16e 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1472,7 +1472,6 @@ realloc_lhs_warning (bt type, bool array, locus *where) } -static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init); static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *, gfc_expr *); @@ -5329,12 +5328,22 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (e && (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS) && e->ts.u.derived->attr.alloc_comp && !(e->symtree && e->symtree->n.sym->attr.pointer) - && e->expr_type != EXPR_VARIABLE && !e->rank - && e->expr_type != EXPR_STRUCTURE) + && e->expr_type != EXPR_VARIABLE && !e->rank) { int parm_rank; - tmp = build_fold_indirect_ref_loc (input_location, - parmse.expr); + /* It is known the e returns a structure type with at least one + allocatable component. When e is a function, ensure that the + function is called once only by using a temporary variable. */ + if (!DECL_P (parmse.expr)) + parmse.expr = gfc_evaluate_now_loc (input_location, + parmse.expr, &se->pre); + + if (fsym && fsym->attr.value) + tmp = parmse.expr; + else + tmp = build_fold_indirect_ref_loc (input_location, + parmse.expr); + parm_rank = e->rank; switch (parm_kind) { @@ -7137,7 +7146,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr, /* Assign a derived type constructor to a variable. */ -static tree +tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init) { gfc_constructor *c; @@ -7450,7 +7459,7 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr) if (expr->ts.type == BT_CHARACTER && expr->expr_type != EXPR_FUNCTION) gfc_conv_string_parameter (se); - else + else se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); return; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 570b5b8..f5d4d20 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -669,6 +669,9 @@ tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespe /* Generate code to call realloc(). */ tree gfc_call_realloc (stmtblock_t *, tree, tree); +/* Assign a derived type constructor to a variable. */ +tree gfc_trans_structure_assign (tree, gfc_expr *, bool); + /* Generate code for an assignment, includes scalarization. */ tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool); diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 new file mode 100644 index 0000000..0753e33 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 @@ -0,0 +1,55 @@ +! { dg-do run } +! { dg-options "-Wreturn-type" } +! +! Check that pr58586 is fixed now. +! Based on a contribution by Vladimir Fuka +! Contibuted by Andre Vehreschild + +program test_pr58586 + implicit none + + type :: a + end type + + type :: c + type(a), allocatable :: a + end type + + type :: b + integer, allocatable :: a + end type + + type :: t + integer, allocatable :: comp + end type + type :: u + type(t), allocatable :: comp + end type + + + ! These two are merely to check, if compilation works + call add(b()) + call add(b(null())) + + ! This needs to execute, to see whether the segfault at runtime is resolved + call add_c(c_init()) + + call sub(u()) +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + type(c) function c_init() ! { dg-warning "not set" } + end function + + subroutine sub(d) + type(u), value :: d + end subroutine +end program test_pr58586 + diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 new file mode 100644 index 0000000..e4c796e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 @@ -0,0 +1,104 @@ +! { dg-do run } +! { dg-options "-Wreturn-type" } +! +! Check that pr58586 is fixed now. +! Based on a contribution by Vladimir Fuka +! Contibuted by Andre Vehreschild + +module test_pr58586_mod + implicit none + + type :: a + end type + + type :: c + type(a), allocatable :: a + end type + + type :: d + contains + procedure :: init => d_init + end type + + type, extends(d) :: e + contains + procedure :: init => e_init + end type + + type :: b + integer, allocatable :: a + end type + + type t + integer :: i = 5 + end type + +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + subroutine add_class_c (d) + class(c), value :: d + end subroutine + + subroutine add_t (d) + type(t), value :: d + end subroutine + + type(c) function c_init() ! { dg-warning "not set" } + end function + + class(c) function c_init2() ! { dg-warning "not set" } + allocatable :: c_init2 + end function + + type(c) function d_init(this) ! { dg-warning "not set" } + class(d) :: this + end function + + type(c) function e_init(this) + class(e) :: this + allocate (e_init%a) + end function + + type(t) function t_init() ! { dg-warning "not set" } + allocatable :: t_init + end function + + type(t) function static_t_init() ! { dg-warning "not set" } + end function +end module test_pr58586_mod + +program test_pr58586 + use test_pr58586_mod + + class(d), allocatable :: od + class(e), allocatable :: oe + type(t), allocatable :: temp + + ! These two are merely to check, if compilation works + call add(b()) + call add(b(null())) + + ! This needs to execute, to see whether the segfault at runtime is resolved + call add_c(c_init()) + call add_class_c(c_init2()) + + call add_t(static_t_init()) + temp = t_init() ! <-- This derefs a null-pointer currently + if (allocated (temp)) call abort() + + allocate(od) + call add_c(od%init()) + deallocate(od) + allocate(oe) + call add_c(oe%init()) + deallocate(oe) +end program + ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Ping, Patch, Fortran, PR58586, v5] ICE with derived type with allocatable component passed by value 2015-05-19 14:02 ` [Patch, Fortran, PR58586, v4] " Andre Vehreschild @ 2015-07-03 9:29 ` Andre Vehreschild 2015-07-04 16:25 ` Steve Kargl 0 siblings, 1 reply; 19+ messages in thread From: Andre Vehreschild @ 2015-07-03 9:29 UTC (permalink / raw) To: GCC-Patches-ML, GCC-Fortran-ML [-- Attachment #1: Type: text/plain, Size: 984 bytes --] Ping! Version increment only to reflect rebasing on current trunk. Bootstraps and regtests fine on x86_64-linux-gnu/f21. I am tempted to follow Paul's method of setting a deadline for objections. Else I will commit the patch next Friday (just kidding). I am more interested in a review. The patch now lives in my code base for several months and is used to compile a rather sophisticated fortran code without issues. So I expect no big trouble in trunk given that the patch addresses a rather seldomly (;-)) used construct. Ok for trunk? Regards, Andre On Tue, 19 May 2015 16:01:37 +0200 Andre Vehreschild <vehre@gmx.de> wrote: > Hi, > > attached is the most recent version of the patch for 58586. It adapts to > recent trunk and addresses the caveats so far, i.e. the testcases in the > comments now compile and run again w/o errors. > > Bootstraps and regtests fine on x86_64-linux-gnu/f21. > > Comments? > > - Andre -- Andre Vehreschild * Email: vehre ad gmx dot de [-- Attachment #2: pr58586_5.clog --] [-- Type: application/octet-stream, Size: 1062 bytes --] gcc/testsuite/ChangeLog: 2015-07-03 Andre Vehreschild <vehre@gmx.de> * gfortran.dg/alloc_comp_class_3.f03: New test. * gfortran.dg/alloc_comp_class_4.f03: New test. gcc/fortran/ChangeLog: 2015-07-03 Andre Vehreschild <vehre@gmx.de> PR fortran/58586 * resolve.c (resolve_symbol): Non-private functions in modules with allocatable or pointer components are marked referenced now. Furthermore is the default init especially for those components now done in gfc_conf_procedure_call preventing duplicate code. * trans-decl.c (gfc_generate_function_code): Generate a fake result decl for functions returning an object with allocatable components and initialize them. * trans-expr.c (gfc_conv_procedure_call): For value typed trees use the tree without indirect ref. And for non-decl trees add a temporary variable to prevent evaluating the tree multiple times (prevent multiple function evaluations). * trans.h: Made gfc_trans_structure_assign () protoype available, which is now needed by trans-decl.c:gfc_generate_ function_code(), too. [-- Attachment #3: pr58586_5.patch --] [-- Type: text/x-patch, Size: 9954 bytes --] diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index efafabc..d16bf13 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -14083,10 +14083,15 @@ resolve_symbol (gfc_symbol *sym) if ((!a->save && !a->dummy && !a->pointer && !a->in_common && !a->use_assoc - && (a->referenced || a->result) - && !(a->function && sym != sym->result)) + && !a->result && !a->function) || (a->dummy && a->intent == INTENT_OUT && !a->pointer)) apply_default_init (sym); + else if (a->function && sym->result && a->access != ACCESS_PRIVATE + && (sym->ts.u.derived->attr.alloc_comp + || sym->ts.u.derived->attr.pointer_comp)) + /* Mark the result symbol to be referenced, when it has allocatable + components. */ + sym->result->attr.referenced = 1; } if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index b4f75ba..aec2018 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -5885,9 +5885,33 @@ gfc_generate_function_code (gfc_namespace * ns) tmp = gfc_trans_code (ns->code); gfc_add_expr_to_block (&body, tmp); - if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node) + if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node + || (sym->result && sym->result != sym + && sym->result->ts.type == BT_DERIVED + && sym->result->ts.u.derived->attr.alloc_comp)) { + bool artificial_result_decl = false; tree result = get_proc_result (sym); + gfc_symbol *rsym = sym == sym->result ? sym : sym->result; + + /* Make sure that a function returning an object with + alloc/pointer_components always has a result, where at least + the allocatable/pointer components are set to zero. */ + if (result == NULL_TREE && sym->attr.function + && ((sym->result->ts.type == BT_DERIVED + && (sym->attr.allocatable + || sym->attr.pointer + || sym->result->ts.u.derived->attr.alloc_comp + || sym->result->ts.u.derived->attr.pointer_comp)) + || (sym->result->ts.type == BT_CLASS + && (CLASS_DATA (sym)->attr.allocatable + || CLASS_DATA (sym)->attr.class_pointer + || CLASS_DATA (sym->result)->attr.alloc_comp + || CLASS_DATA (sym->result)->attr.pointer_comp)))) + { + artificial_result_decl = true; + result = gfc_get_fake_result_decl (sym, 0); + } if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer) { @@ -5907,16 +5931,30 @@ gfc_generate_function_code (gfc_namespace * ns) null_pointer_node)); } else if (sym->ts.type == BT_DERIVED - && sym->ts.u.derived->attr.alloc_comp && !sym->attr.allocatable) { - rank = sym->as ? sym->as->rank : 0; - tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); - gfc_add_expr_to_block (&init, tmp); + gfc_expr *init_exp; + /* Arrays are not initialized using the default initializer of + their elements. Therefore only check if a default + initializer is available when the result is scalar. */ + init_exp = rsym->as ? NULL : gfc_default_initializer (&rsym->ts); + if (init_exp) + { + tmp = gfc_trans_structure_assign (result, init_exp, 0); + gfc_free_expr (init_exp); + gfc_add_expr_to_block (&init, tmp); + } + else if (rsym->ts.u.derived->attr.alloc_comp) + { + rank = rsym->as ? rsym->as->rank : 0; + tmp = gfc_nullify_alloc_comp (rsym->ts.u.derived, result, + rank); + gfc_prepend_expr_to_block (&body, tmp); + } } } - if (result == NULL_TREE) + if (result == NULL_TREE || artificial_result_decl) { /* TODO: move to the appropriate place in resolve.c. */ if (warn_return_type && sym == sym->result) @@ -5926,7 +5964,7 @@ gfc_generate_function_code (gfc_namespace * ns) if (warn_return_type) TREE_NO_WARNING(sym->backend_decl) = 1; } - else + if (result != NULL_TREE) gfc_add_expr_to_block (&body, gfc_generate_return ()); } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 7747a67..195f7a4 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1465,7 +1465,6 @@ realloc_lhs_warning (bt type, bool array, locus *where) } -static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init); static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *, gfc_expr *); @@ -5340,8 +5339,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && e->expr_type != EXPR_VARIABLE && !e->rank) { int parm_rank; - tmp = build_fold_indirect_ref_loc (input_location, - parmse.expr); + /* It is known the e returns a structure type with at least one + allocatable component. When e is a function, ensure that the + function is called once only by using a temporary variable. */ + if (!DECL_P (parmse.expr)) + parmse.expr = gfc_evaluate_now_loc (input_location, + parmse.expr, &se->pre); + + if (fsym && fsym->attr.value) + tmp = parmse.expr; + else + tmp = build_fold_indirect_ref_loc (input_location, + parmse.expr); + parm_rank = e->rank; switch (parm_kind) { @@ -7158,7 +7168,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr, /* Assign a derived type constructor to a variable. */ -static tree +tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init) { gfc_constructor *c; @@ -7471,7 +7481,7 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr) if (expr->ts.type == BT_CHARACTER && expr->expr_type != EXPR_FUNCTION) gfc_conv_string_parameter (se); - else + else se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); return; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index e618088..f7cf5f0 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -669,6 +669,9 @@ tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespe /* Generate code to call realloc(). */ tree gfc_call_realloc (stmtblock_t *, tree, tree); +/* Assign a derived type constructor to a variable. */ +tree gfc_trans_structure_assign (tree, gfc_expr *, bool); + /* Generate code for an assignment, includes scalarization. */ tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool); diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 new file mode 100644 index 0000000..0753e33 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 @@ -0,0 +1,55 @@ +! { dg-do run } +! { dg-options "-Wreturn-type" } +! +! Check that pr58586 is fixed now. +! Based on a contribution by Vladimir Fuka +! Contibuted by Andre Vehreschild + +program test_pr58586 + implicit none + + type :: a + end type + + type :: c + type(a), allocatable :: a + end type + + type :: b + integer, allocatable :: a + end type + + type :: t + integer, allocatable :: comp + end type + type :: u + type(t), allocatable :: comp + end type + + + ! These two are merely to check, if compilation works + call add(b()) + call add(b(null())) + + ! This needs to execute, to see whether the segfault at runtime is resolved + call add_c(c_init()) + + call sub(u()) +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + type(c) function c_init() ! { dg-warning "not set" } + end function + + subroutine sub(d) + type(u), value :: d + end subroutine +end program test_pr58586 + diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 new file mode 100644 index 0000000..e4c796e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 @@ -0,0 +1,104 @@ +! { dg-do run } +! { dg-options "-Wreturn-type" } +! +! Check that pr58586 is fixed now. +! Based on a contribution by Vladimir Fuka +! Contibuted by Andre Vehreschild + +module test_pr58586_mod + implicit none + + type :: a + end type + + type :: c + type(a), allocatable :: a + end type + + type :: d + contains + procedure :: init => d_init + end type + + type, extends(d) :: e + contains + procedure :: init => e_init + end type + + type :: b + integer, allocatable :: a + end type + + type t + integer :: i = 5 + end type + +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + subroutine add_class_c (d) + class(c), value :: d + end subroutine + + subroutine add_t (d) + type(t), value :: d + end subroutine + + type(c) function c_init() ! { dg-warning "not set" } + end function + + class(c) function c_init2() ! { dg-warning "not set" } + allocatable :: c_init2 + end function + + type(c) function d_init(this) ! { dg-warning "not set" } + class(d) :: this + end function + + type(c) function e_init(this) + class(e) :: this + allocate (e_init%a) + end function + + type(t) function t_init() ! { dg-warning "not set" } + allocatable :: t_init + end function + + type(t) function static_t_init() ! { dg-warning "not set" } + end function +end module test_pr58586_mod + +program test_pr58586 + use test_pr58586_mod + + class(d), allocatable :: od + class(e), allocatable :: oe + type(t), allocatable :: temp + + ! These two are merely to check, if compilation works + call add(b()) + call add(b(null())) + + ! This needs to execute, to see whether the segfault at runtime is resolved + call add_c(c_init()) + call add_class_c(c_init2()) + + call add_t(static_t_init()) + temp = t_init() ! <-- This derefs a null-pointer currently + if (allocated (temp)) call abort() + + allocate(od) + call add_c(od%init()) + deallocate(od) + allocate(oe) + call add_c(oe%init()) + deallocate(oe) +end program + ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Ping, Patch, Fortran, PR58586, v5] ICE with derived type with allocatable component passed by value 2015-07-03 9:29 ` [Ping, Patch, Fortran, PR58586, v5] " Andre Vehreschild @ 2015-07-04 16:25 ` Steve Kargl 2015-07-04 19:20 ` Andre Vehreschild 0 siblings, 1 reply; 19+ messages in thread From: Steve Kargl @ 2015-07-04 16:25 UTC (permalink / raw) To: Andre Vehreschild; +Cc: GCC-Patches-ML, GCC-Fortran-ML On Fri, Jul 03, 2015 at 11:29:00AM +0200, Andre Vehreschild wrote: > Ping! > (Un)fortnuately you're working on an area of Fortran that I don't know and in parts of the tree that takes me a long time to decipher (aka, trans-*.c files). I applied your patch and see several failures. I'll note that I did not start from a clean obj/. So, there is the possibility that some *.o file needed to get rebuilt but didn't. Anyhow, laptop-kargl:kargl[300] gfc -o z alloc_comp_class_4.f03 && ./z Program received signal SIGSEGV: Segmentation fault - invalid memory reference. Backtrace for this error: #0 0x2808B9A6 #1 0x2808AB19 #2 0xBFBFF003 #3 0x8048DEA #4 0x8049097 #5 0x8048779 Segmentation fault (core dumped) Hmmm, Ok, I just looked at the source for alloc_comp_class_4.f03 and found line 94. temp = t_init() ! <-- This derefs a null-pointer currently Not sure what to make of this. -- Steve ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Ping, Patch, Fortran, PR58586, v5] ICE with derived type with allocatable component passed by value 2015-07-04 16:25 ` Steve Kargl @ 2015-07-04 19:20 ` Andre Vehreschild 2015-07-05 16:15 ` Steve Kargl 0 siblings, 1 reply; 19+ messages in thread From: Andre Vehreschild @ 2015-07-04 19:20 UTC (permalink / raw) To: Steve Kargl; +Cc: GCC-Patches-ML, GCC-Fortran-ML Hi Steve, Thanks for looking at the code. The error you experience is known to me. The bug is present in gfortran and only exposed by this patch. Unfortunately is the pr58586 not addressing this specific error. It may be in the bugtracker under a different number already. Furthermore did I not want to extend the patch for 58586 any further, because I have learned that the more complicated a patch gets the longer review takes. For making the testcase run fine we also simply can comment the line. Regards, Andre Am 4. Juli 2015 18:24:59 MESZ, schrieb Steve Kargl <sgk@troutmask.apl.washington.edu>: >On Fri, Jul 03, 2015 at 11:29:00AM +0200, Andre Vehreschild wrote: >> Ping! >> > >(Un)fortnuately you're working on an area of Fortran >that I don't know and in parts of the tree that takes >me a long time to decipher (aka, trans-*.c files). > >I applied your patch and see several failures. I'll >note that I did not start from a clean obj/. So, there >is the possibility that some *.o file needed to get >rebuilt but didn't. Anyhow, > >laptop-kargl:kargl[300] gfc -o z alloc_comp_class_4.f03 && ./z > >Program received signal SIGSEGV: Segmentation fault - invalid memory >reference. > >Backtrace for this error: >#0 0x2808B9A6 >#1 0x2808AB19 >#2 0xBFBFF003 >#3 0x8048DEA >#4 0x8049097 >#5 0x8048779 >Segmentation fault (core dumped) > >Hmmm, Ok, I just looked at the source for alloc_comp_class_4.f03 >and found line 94. > > temp = t_init() ! <-- This derefs a null-pointer currently > >Not sure what to make of this. -- Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen Mail: vehre@gmx.de * Tel.: +49 241 9291018 ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Ping, Patch, Fortran, PR58586, v5] ICE with derived type with allocatable component passed by value 2015-07-04 19:20 ` Andre Vehreschild @ 2015-07-05 16:15 ` Steve Kargl 2015-07-05 17:48 ` Paul Richard Thomas 0 siblings, 1 reply; 19+ messages in thread From: Steve Kargl @ 2015-07-05 16:15 UTC (permalink / raw) To: Andre Vehreschild; +Cc: GCC-Patches-ML, GCC-Fortran-ML On Sat, Jul 04, 2015 at 09:20:39PM +0200, Andre Vehreschild wrote: > > Thanks for looking at the code. The error you experience is known > to me. The bug is present in gfortran and only exposed by this patch. > Unfortunately is the pr58586 not addressing this specific error. It > may be in the bugtracker under a different number already. Furthermore > did I not want to extend the patch for 58586 any further, because I > have learned that the more complicated a patch gets the longer review > takes. For making the testcase run fine we also simply can comment the line. > I can appreciate the problem of fixing one bug may expose another, and I agree that holding up a patch for 58586 due to a latent bug seems unreasonable. I reviewed the email history and it appears that you've addressed Mikael's concerns. My only comment would be to comment out the problematic statement in alloc_comp_class_4.f03, and open a new bug report to record the issue. Ok to commit with my suggested change. -- Steve ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Ping, Patch, Fortran, PR58586, v5] ICE with derived type with allocatable component passed by value 2015-07-05 16:15 ` Steve Kargl @ 2015-07-05 17:48 ` Paul Richard Thomas 2015-07-05 18:14 ` Steve Kargl 2015-07-06 10:32 ` [commited, " Andre Vehreschild 0 siblings, 2 replies; 19+ messages in thread From: Paul Richard Thomas @ 2015-07-05 17:48 UTC (permalink / raw) To: Steve Kargl; +Cc: Andre Vehreschild, GCC-Patches-ML, GCC-Fortran-ML Dear Andre, I agree with Steve's recommendation that you comment out the line and open a PR for the problem. The patch looks fine to me and applied cleanly, apart from trailing CRs in the testcases. OK by me too. Cheers Paul PS I felt safe in setting a deadline for the submodule patch because: (i) It was obvious that nobody would review it because of its size; and (ii) It is safely ring-fenced by the need for very specific procedure attributes and declarations. I would not dream of doing the same for other patches more integrated in parts of the compiler that are frequented by commonly used code. For example, the patch to encompass the use of private entities with submodules will be just such a patch.... when I figure out how to do it! I can sympathize with you though; you have often had to wait an excessively long time for reviews. On 5 July 2015 at 18:14, Steve Kargl <sgk@troutmask.apl.washington.edu> wrote: > On Sat, Jul 04, 2015 at 09:20:39PM +0200, Andre Vehreschild wrote: >> >> Thanks for looking at the code. The error you experience is known >> to me. The bug is present in gfortran and only exposed by this patch. >> Unfortunately is the pr58586 not addressing this specific error. It >> may be in the bugtracker under a different number already. Furthermore >> did I not want to extend the patch for 58586 any further, because I >> have learned that the more complicated a patch gets the longer review >> takes. For making the testcase run fine we also simply can comment the line. >> > > I can appreciate the problem of fixing one bug may expose another, > and I agree that holding up a patch for 58586 due to a latent bug > seems unreasonable. I reviewed the email history and it appears > that you've addressed Mikael's concerns. My only comment would > be to comment out the problematic statement in alloc_comp_class_4.f03, > and open a new bug report to record the issue. Ok to commit with > my suggested change. > > -- > Steve -- Outside of a dog, a book is a man's best friend. Inside of a dog it's too dark to read. Groucho Marx ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [Ping, Patch, Fortran, PR58586, v5] ICE with derived type with allocatable component passed by value 2015-07-05 17:48 ` Paul Richard Thomas @ 2015-07-05 18:14 ` Steve Kargl 2015-07-06 10:32 ` [commited, " Andre Vehreschild 1 sibling, 0 replies; 19+ messages in thread From: Steve Kargl @ 2015-07-05 18:14 UTC (permalink / raw) To: Paul Richard Thomas; +Cc: Andre Vehreschild, GCC-Patches-ML, GCC-Fortran-ML On Sun, Jul 05, 2015 at 07:48:13PM +0200, Paul Richard Thomas wrote: > Dear Andre, > > I agree with Steve's recommendation that you comment out the line and > open a PR for the problem. > > The patch looks fine to me and applied cleanly, apart from trailing > CRs in the testcases. > > OK by me too. > > Cheers > > Paul > > PS I felt safe in setting a deadline for the submodule patch because: > (i) It was obvious that nobody would review it because of its size; > and (ii) It is safely ring-fenced by the need for very specific > procedure attributes and declarations. I would not dream of doing the > same for other patches more integrated in parts of the compiler that > are frequented by commonly used code. For example, the patch to > encompass the use of private entities with submodules will be just > such a patch.... when I figure out how to do it! I can sympathize with > you though; you have often had to wait an excessively long time for > reviews. > Fortunately (or unfortunately depends how one looks at the situation) Andre is working in an area that I feel very uncomfortable reviewing. I haven't ventured into OOP Fortran, and I'm still recovering from my last encounter with allocate/deallocate code. I also agree that waiting 6+ weeks for approval is a bit long time. Unfortunately, it seems evident that we're all too busy with Real Life(tm) at the moment. PS: Are you going to announce your submodule milestone on c.l.f? -- Steve ^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [commited, Patch, Fortran, PR58586, v5] ICE with derived type with allocatable component passed by value 2015-07-05 17:48 ` Paul Richard Thomas 2015-07-05 18:14 ` Steve Kargl @ 2015-07-06 10:32 ` Andre Vehreschild 1 sibling, 0 replies; 19+ messages in thread From: Andre Vehreschild @ 2015-07-06 10:32 UTC (permalink / raw) To: Paul Richard Thomas; +Cc: Steve Kargl, GCC-Patches-ML, GCC-Fortran-ML [-- Attachment #1: Type: text/plain, Size: 2581 bytes --] Hi Steve, hi Paul, hi all, Steve and Paul, thank you very much for the reviews. Committed with the requested changes as r225447 and r225448. The last commit adds the Changelog entry in the testsuite I forgot. Sorry for that. For the open issue in the testcase I have opened the pr: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=66775 Regards, Andre On Sun, 5 Jul 2015 19:48:13 +0200 Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote: > Dear Andre, > > I agree with Steve's recommendation that you comment out the line and > open a PR for the problem. > > The patch looks fine to me and applied cleanly, apart from trailing > CRs in the testcases. > > OK by me too. > > Cheers > > Paul > > PS I felt safe in setting a deadline for the submodule patch because: > (i) It was obvious that nobody would review it because of its size; > and (ii) It is safely ring-fenced by the need for very specific > procedure attributes and declarations. I would not dream of doing the > same for other patches more integrated in parts of the compiler that > are frequented by commonly used code. For example, the patch to > encompass the use of private entities with submodules will be just > such a patch.... when I figure out how to do it! I can sympathize with > you though; you have often had to wait an excessively long time for > reviews. > > > On 5 July 2015 at 18:14, Steve Kargl <sgk@troutmask.apl.washington.edu> wrote: > > On Sat, Jul 04, 2015 at 09:20:39PM +0200, Andre Vehreschild wrote: > >> > >> Thanks for looking at the code. The error you experience is known > >> to me. The bug is present in gfortran and only exposed by this patch. > >> Unfortunately is the pr58586 not addressing this specific error. It > >> may be in the bugtracker under a different number already. Furthermore > >> did I not want to extend the patch for 58586 any further, because I > >> have learned that the more complicated a patch gets the longer review > >> takes. For making the testcase run fine we also simply can comment the > >> line. > >> > > > > I can appreciate the problem of fixing one bug may expose another, > > and I agree that holding up a patch for 58586 due to a latent bug > > seems unreasonable. I reviewed the email history and it appears > > that you've addressed Mikael's concerns. My only comment would > > be to comment out the problematic statement in alloc_comp_class_4.f03, > > and open a new bug report to record the issue. Ok to commit with > > my suggested change. > > > > -- > > Steve > > > -- Andre Vehreschild * Email: vehre ad gmx dot de [-- Attachment #2: submit.diff --] [-- Type: text/x-patch, Size: 11376 bytes --] Index: gcc/fortran/ChangeLog =================================================================== --- gcc/fortran/ChangeLog (Revision 225446) +++ gcc/fortran/ChangeLog (Arbeitskopie) @@ -1,3 +1,22 @@ +2015-07-06 Andre Vehreschild <vehre@gmx.de> + + PR fortran/58586 + * resolve.c (resolve_symbol): Non-private functions in modules + with allocatable or pointer components are marked referenced + now. Furthermore is the default init especially for those + components now done in gfc_conf_procedure_call preventing + duplicate code. + * trans-decl.c (gfc_generate_function_code): Generate a fake + result decl for functions returning an object with allocatable + components and initialize them. + * trans-expr.c (gfc_conv_procedure_call): For value typed trees + use the tree without indirect ref. And for non-decl trees + add a temporary variable to prevent evaluating the tree + multiple times (prevent multiple function evaluations). + * trans.h: Made gfc_trans_structure_assign () protoype + available, which is now needed by trans-decl.c:gfc_generate_ + function_code(), too. + 2015-07-04 Steven G. Kargl <kargl@gcc.gnu.org> PR fortran/66725 Index: gcc/fortran/trans-decl.c =================================================================== --- gcc/fortran/trans-decl.c (Revision 225446) +++ gcc/fortran/trans-decl.c (Arbeitskopie) @@ -5885,10 +5885,34 @@ tmp = gfc_trans_code (ns->code); gfc_add_expr_to_block (&body, tmp); - if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node) + if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node + || (sym->result && sym->result != sym + && sym->result->ts.type == BT_DERIVED + && sym->result->ts.u.derived->attr.alloc_comp)) { + bool artificial_result_decl = false; tree result = get_proc_result (sym); + gfc_symbol *rsym = sym == sym->result ? sym : sym->result; + /* Make sure that a function returning an object with + alloc/pointer_components always has a result, where at least + the allocatable/pointer components are set to zero. */ + if (result == NULL_TREE && sym->attr.function + && ((sym->result->ts.type == BT_DERIVED + && (sym->attr.allocatable + || sym->attr.pointer + || sym->result->ts.u.derived->attr.alloc_comp + || sym->result->ts.u.derived->attr.pointer_comp)) + || (sym->result->ts.type == BT_CLASS + && (CLASS_DATA (sym)->attr.allocatable + || CLASS_DATA (sym)->attr.class_pointer + || CLASS_DATA (sym->result)->attr.alloc_comp + || CLASS_DATA (sym->result)->attr.pointer_comp)))) + { + artificial_result_decl = true; + result = gfc_get_fake_result_decl (sym, 0); + } + if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer) { if (sym->attr.allocatable && sym->attr.dimension == 0 @@ -5907,16 +5931,30 @@ null_pointer_node)); } else if (sym->ts.type == BT_DERIVED - && sym->ts.u.derived->attr.alloc_comp && !sym->attr.allocatable) { - rank = sym->as ? sym->as->rank : 0; - tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank); - gfc_add_expr_to_block (&init, tmp); + gfc_expr *init_exp; + /* Arrays are not initialized using the default initializer of + their elements. Therefore only check if a default + initializer is available when the result is scalar. */ + init_exp = rsym->as ? NULL : gfc_default_initializer (&rsym->ts); + if (init_exp) + { + tmp = gfc_trans_structure_assign (result, init_exp, 0); + gfc_free_expr (init_exp); + gfc_add_expr_to_block (&init, tmp); + } + else if (rsym->ts.u.derived->attr.alloc_comp) + { + rank = rsym->as ? rsym->as->rank : 0; + tmp = gfc_nullify_alloc_comp (rsym->ts.u.derived, result, + rank); + gfc_prepend_expr_to_block (&body, tmp); + } } } - if (result == NULL_TREE) + if (result == NULL_TREE || artificial_result_decl) { /* TODO: move to the appropriate place in resolve.c. */ if (warn_return_type && sym == sym->result) @@ -5926,7 +5964,7 @@ if (warn_return_type) TREE_NO_WARNING(sym->backend_decl) = 1; } - else + if (result != NULL_TREE) gfc_add_expr_to_block (&body, gfc_generate_return ()); } Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (Revision 225446) +++ gcc/fortran/resolve.c (Arbeitskopie) @@ -14083,10 +14083,15 @@ if ((!a->save && !a->dummy && !a->pointer && !a->in_common && !a->use_assoc - && (a->referenced || a->result) - && !(a->function && sym != sym->result)) + && !a->result && !a->function) || (a->dummy && a->intent == INTENT_OUT && !a->pointer)) apply_default_init (sym); + else if (a->function && sym->result && a->access != ACCESS_PRIVATE + && (sym->ts.u.derived->attr.alloc_comp + || sym->ts.u.derived->attr.pointer_comp)) + /* Mark the result symbol to be referenced, when it has allocatable + components. */ + sym->result->attr.referenced = 1; } if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns Index: gcc/fortran/trans-expr.c =================================================================== --- gcc/fortran/trans-expr.c (Revision 225446) +++ gcc/fortran/trans-expr.c (Arbeitskopie) @@ -1465,7 +1465,6 @@ } -static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init); static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *, gfc_expr *); @@ -5340,8 +5339,19 @@ && e->expr_type != EXPR_VARIABLE && !e->rank) { int parm_rank; - tmp = build_fold_indirect_ref_loc (input_location, - parmse.expr); + /* It is known the e returns a structure type with at least one + allocatable component. When e is a function, ensure that the + function is called once only by using a temporary variable. */ + if (!DECL_P (parmse.expr)) + parmse.expr = gfc_evaluate_now_loc (input_location, + parmse.expr, &se->pre); + + if (fsym && fsym->attr.value) + tmp = parmse.expr; + else + tmp = build_fold_indirect_ref_loc (input_location, + parmse.expr); + parm_rank = e->rank; switch (parm_kind) { @@ -7158,7 +7168,7 @@ /* Assign a derived type constructor to a variable. */ -static tree +tree gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init) { gfc_constructor *c; @@ -7471,7 +7481,7 @@ if (expr->ts.type == BT_CHARACTER && expr->expr_type != EXPR_FUNCTION) gfc_conv_string_parameter (se); - else + else se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); return; Index: gcc/fortran/trans.h =================================================================== --- gcc/fortran/trans.h (Revision 225446) +++ gcc/fortran/trans.h (Arbeitskopie) @@ -669,6 +669,9 @@ /* Generate code to call realloc(). */ tree gfc_call_realloc (stmtblock_t *, tree, tree); +/* Assign a derived type constructor to a variable. */ +tree gfc_trans_structure_assign (tree, gfc_expr *, bool); + /* Generate code for an assignment, includes scalarization. */ tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool); Index: gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 =================================================================== --- gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 (Revision 0) +++ gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 (Revision 225447) @@ -0,0 +1,55 @@ +! { dg-do run } +! { dg-options "-Wreturn-type" } +! +! Check that pr58586 is fixed now. +! Based on a contribution by Vladimir Fuka +! Contibuted by Andre Vehreschild + +program test_pr58586 + implicit none + + type :: a + end type + + type :: c + type(a), allocatable :: a + end type + + type :: b + integer, allocatable :: a + end type + + type :: t + integer, allocatable :: comp + end type + type :: u + type(t), allocatable :: comp + end type + + + ! These two are merely to check, if compilation works + call add(b()) + call add(b(null())) + + ! This needs to execute, to see whether the segfault at runtime is resolved + call add_c(c_init()) + + call sub(u()) +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + type(c) function c_init() ! { dg-warning "not set" } + end function + + subroutine sub(d) + type(u), value :: d + end subroutine +end program test_pr58586 + Index: gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 =================================================================== --- gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 (Revision 0) +++ gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 (Revision 225447) @@ -0,0 +1,105 @@ +! { dg-do run } +! { dg-options "-Wreturn-type" } +! +! Check that pr58586 is fixed now. +! Based on a contribution by Vladimir Fuka +! Contibuted by Andre Vehreschild + +module test_pr58586_mod + implicit none + + type :: a + end type + + type :: c + type(a), allocatable :: a + end type + + type :: d + contains + procedure :: init => d_init + end type + + type, extends(d) :: e + contains + procedure :: init => e_init + end type + + type :: b + integer, allocatable :: a + end type + + type t + integer :: i = 5 + end type + +contains + + subroutine add (d) + type(b), value :: d + end subroutine + + subroutine add_c (d) + type(c), value :: d + end subroutine + + subroutine add_class_c (d) + class(c), value :: d + end subroutine + + subroutine add_t (d) + type(t), value :: d + end subroutine + + type(c) function c_init() ! { dg-warning "not set" } + end function + + class(c) function c_init2() ! { dg-warning "not set" } + allocatable :: c_init2 + end function + + type(c) function d_init(this) ! { dg-warning "not set" } + class(d) :: this + end function + + type(c) function e_init(this) + class(e) :: this + allocate (e_init%a) + end function + + type(t) function t_init() ! { dg-warning "not set" } + allocatable :: t_init + end function + + type(t) function static_t_init() ! { dg-warning "not set" } + end function +end module test_pr58586_mod + +program test_pr58586 + use test_pr58586_mod + + class(d), allocatable :: od + class(e), allocatable :: oe + type(t), allocatable :: temp + + ! These two are merely to check, if compilation works + call add(b()) + call add(b(null())) + + ! This needs to execute, to see whether the segfault at runtime is resolved + call add_c(c_init()) + call add_class_c(c_init2()) + + call add_t(static_t_init()) + ! temp = t_init() ! <-- This derefs a null-pointer currently + ! Filed as pr66775 + if (allocated (temp)) call abort() + + allocate(od) + call add_c(od%init()) + deallocate(od) + allocate(oe) + call add_c(oe%init()) + deallocate(oe) +end program + Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (Revision 225446) +++ gcc/testsuite/ChangeLog (Arbeitskopie) @@ -1,3 +1,9 @@ +2015-07-06 Andre Vehreschild <vehre@gmx.de> + + PR fortran/58586 + * gfortran.dg/alloc_comp_class_3.f03: New test. + * gfortran.dg/alloc_comp_class_4.f03: New test. + 2015-07-06 Eric Botcazou <ebotcazou@adacore.com> * gcc.c-torture/execute/pr66757.c: New test. ^ permalink raw reply [flat|nested] 19+ messages in thread
end of thread, other threads:[~2015-07-06 10:32 UTC | newest] Thread overview: 19+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2015-04-15 18:03 [Patch, Fortran, PR58586, v1] ICE with derived type with allocatable component passed by value Andre Vehreschild 2015-04-19 10:01 ` Mikael Morin 2015-04-23 18:01 ` [Patch, Fortran, PR58586, v2] " Andre Vehreschild 2015-04-24 8:37 ` Andre Vehreschild 2015-04-26 10:23 ` Mikael Morin 2015-05-05 9:00 ` [Patch, Fortran, PR58586, v3] " Andre Vehreschild 2015-05-07 10:15 ` Mikael Morin 2015-05-08 10:54 ` Andre Vehreschild 2015-05-08 13:21 ` Mikael Morin 2015-05-08 13:31 ` Andre Vehreschild 2015-05-08 14:11 ` Andre Vehreschild 2015-05-19 14:02 ` [Patch, Fortran, PR58586, v4] " Andre Vehreschild 2015-07-03 9:29 ` [Ping, Patch, Fortran, PR58586, v5] " Andre Vehreschild 2015-07-04 16:25 ` Steve Kargl 2015-07-04 19:20 ` Andre Vehreschild 2015-07-05 16:15 ` Steve Kargl 2015-07-05 17:48 ` Paul Richard Thomas 2015-07-05 18:14 ` Steve Kargl 2015-07-06 10:32 ` [commited, " 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).