From 8c32e08987e340d28650788c8817f4aecd01b65a Mon Sep 17 00:00:00 2001 From: pault Date: Mon, 20 Nov 2017 19:09:34 +0000 Subject: [PATCH] 2017-11-20 Paul Thomas PR fortran/79072 * trans-expr.c (trans_class_vptr_len_assignment): Set from_len if the temporary is unlimited polymorphic. * trans-stmt.c (trans_associate_var): Use the fake result decl to obtain the 'len' field from an explicit function result when in that function scope. 2017-11-20 Paul Thomas PR fortran/79072 * gfortran.dg/class_result_5.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@254966 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 9 +++++++ gcc/fortran/trans-expr.c | 2 ++ gcc/fortran/trans-stmt.c | 7 +++++ gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/class_result_5.f90 | 38 ++++++++++++++++++++++++++++ 5 files changed, 61 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/class_result_5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5dea20437e2..4ba7327be33 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2017-11-20 Paul Thomas + + PR fortran/79072 + * trans-expr.c (trans_class_vptr_len_assignment): Set from_len + if the temporary is unlimited polymorphic. + * trans-stmt.c (trans_associate_var): Use the fake result decl + to obtain the 'len' field from an explicit function result when + in that function scope. + 2017-11-19 Paul Thomas PR fortran/78990 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 92d37ec0901..2ca0ad6f6f0 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -8131,6 +8131,8 @@ trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le, { vptr_expr = NULL; se.expr = gfc_class_vptr_get (rse->expr); + if (UNLIMITED_POLY (re)) + from_len = gfc_class_len_get (rse->expr); } else if (re->expr_type != EXPR_NULL) /* Only when rhs is non-NULL use its declared type for vptr diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index a89751bfd79..6cf79816099 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1827,6 +1827,13 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) gcc_assert (!e->symtree->n.sym->ts.deferred); tmp = e->symtree->n.sym->ts.u.cl->backend_decl; } + else if (e->symtree->n.sym->attr.function + && e->symtree->n.sym == e->symtree->n.sym->result + && e->symtree->n.sym == e->symtree->n.sym->ns->proc_name) + { + tmp = gfc_get_fake_result_decl (e->symtree->n.sym, 0); + tmp = gfc_class_len_get (tmp); + } else tmp = gfc_class_len_get (gfc_get_symbol_decl (e->symtree->n.sym)); gfc_get_symbol_decl (sym); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c8f4f498852..949eb1946a3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-11-20 Paul Thomas + + PR fortran/79072 + * gfortran.dg/class_result_5.f90: New test. + 2017-11-20 Jakub Jelinek P0329R4: Designated Initialization diff --git a/gcc/testsuite/gfortran.dg/class_result_5.f90 b/gcc/testsuite/gfortran.dg/class_result_5.f90 new file mode 100644 index 00000000000..c557ed37180 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_result_5.f90 @@ -0,0 +1,38 @@ +! { dg-do run } +! +! Test the fix for PR79072. The original problem was that an ICE +! would occur in the select type construct. On fixing that, it was +! found that the string length was not being transferred in the +! pointer assignment in the main program. +! +! Contributed by Neil Carlson +! +function foo(string) + class(*), pointer :: foo + character(3), target :: string + foo => string + select type (foo) + type is (character(*)) + if (foo .ne. 'foo') call abort + foo = 'bar' + end select +end function + + interface + function foo(string) + class(*), pointer :: foo + character(3), target :: string + end function + end interface + + class(*), pointer :: res + character(3), target :: string = 'foo' + + res => foo (string) + + select type (res) + type is (character(*)) + if (res .ne. 'bar') call abort + end select + if (string .ne. 'bar') call abort +end -- 2.11.4.GIT