From adbfb3f8e04049409f9adcbc746fe43cc25f8a45 Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Sat, 17 Jan 2015 11:07:57 +0000 Subject: [PATCH] re PR fortran/60334 (Segmentation fault on character pointer assignments) 2015-01-17 Andre Vehreschild PR fortran/60334 * trans-decl.c (gfc_get_symbol_decl):Use a ref on the string length when the symbol is declared to be a result. * trans-expr.c (gfc_conv_procedure_call): Strip deref on the string length when functions are nested and the string length is a reference already. 2015-01-17 Andre Vehreschild PR fortran/60334 * gfortran.dg/deferred_type_param_6.f90: Add tests for this PR. From-SVN: r219798 --- gcc/fortran/ChangeLog | 9 ++++++ gcc/fortran/trans-decl.c | 28 +++++++++++++++---- gcc/fortran/trans-expr.c | 16 ++++++++--- gcc/testsuite/ChangeLog | 7 ++++- .../gfortran.dg/deferred_type_param_6.f90 | 21 +++++++++++++- 5 files changed, 70 insertions(+), 11 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c97de7fca14..eb02d88d8d1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2015-01-17 Andre Vehreschild + + PR fortran/60334 + * trans-decl.c (gfc_get_symbol_decl):Use a ref on the string + length when the symbol is declared to be a result. + * trans-expr.c (gfc_conv_procedure_call): Strip deref on the + string length when functions are nested and the string length + is a reference already. + 2015-01-16 Janus Weil PR fortran/45290 diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index cad9b5be3ba..a73620fe1bb 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1370,12 +1370,30 @@ gfc_get_symbol_decl (gfc_symbol * sym) (sym->ts.u.cl->passed_length == sym->ts.u.cl->backend_decl)) sym->ts.u.cl->backend_decl = NULL_TREE; - if (sym->ts.deferred && fun_or_res - && sym->ts.u.cl->passed_length == NULL - && sym->ts.u.cl->backend_decl) + if (sym->ts.deferred && byref) { - sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl; - sym->ts.u.cl->backend_decl = NULL_TREE; + /* The string length of a deferred char array is stored in the + parameter at sym->ts.u.cl->backend_decl as a reference and + marked as a result. Exempt this variable from generating a + temporary for it. */ + if (sym->attr.result) + { + /* We need to insert a indirect ref for param decls. */ + if (sym->ts.u.cl->backend_decl + && TREE_CODE (sym->ts.u.cl->backend_decl) == PARM_DECL) + sym->ts.u.cl->backend_decl = + build_fold_indirect_ref (sym->ts.u.cl->backend_decl); + } + /* For all other parameters make sure, that they are copied so + that the value and any modifications are local to the routine + by generating a temporary variable. */ + else if (sym->attr.function + && sym->ts.u.cl->passed_length == NULL + && sym->ts.u.cl->backend_decl) + { + sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl; + sym->ts.u.cl->backend_decl = NULL_TREE; + } } if (sym->ts.u.cl->backend_decl == NULL_TREE) diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 5ebf3abb273..420d6ad59ee 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5010,10 +5010,18 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, so that the value can be returned. */ if (parmse.string_length && fsym && fsym->ts.deferred) { - tmp = parmse.string_length; - if (TREE_CODE (tmp) != VAR_DECL) - tmp = gfc_evaluate_now (parmse.string_length, &se->pre); - parmse.string_length = gfc_build_addr_expr (NULL_TREE, tmp); + if (INDIRECT_REF_P (parmse.string_length)) + /* In chains of functions/procedure calls the string_length already + is a pointer to the variable holding the length. Therefore + remove the deref on call. */ + parmse.string_length = TREE_OPERAND (parmse.string_length, 0); + else + { + tmp = parmse.string_length; + if (TREE_CODE (tmp) != VAR_DECL) + tmp = gfc_evaluate_now (parmse.string_length, &se->pre); + parmse.string_length = gfc_build_addr_expr (NULL_TREE, tmp); + } } /* Character strings are passed as two parameters, a length and a diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3d424ce53dd..dcebc53fad3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2015-01-17 Andre Vehreschild + + PR fortran/60334 + * gfortran.dg/deferred_type_param_6.f90: Add tests for this PR. + 2015-01-16 Bernd Schmidt PR rtl-optimization/52773 @@ -834,7 +839,7 @@ * g++.dg/tsan/atomic_free.C: Likewise. * g++.dg/tsan/atomic_free2.C: Likewise. * g++.dg/tsan/cond_race.C: Likewise. - * g++.dg/tsan/tsan_barrier.h: Copied from c-c++-common/tsan. + * g++.dg/tsan/tsan_barrier.h: Copied from c-c++-common/tsan. 2015-01-08 Hans-Peter Nilsson diff --git a/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90 b/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90 index eb0077840f4..a2fabe87acf 100644 --- a/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90 +++ b/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90 @@ -2,15 +2,23 @@ ! ! PR fortran/51055 ! PR fortran/49110 -! +! PR fortran/60334 subroutine test() implicit none integer :: i = 5 character(len=:), allocatable :: s1 + character(len=:), pointer :: s2 + character(len=5), target :: fifeC = 'FIVEC' call sub(s1, i) if (len(s1) /= 5) call abort() if (s1 /= "ZZZZZ") call abort() + s2 => subfunc() + if (len(s2) /= 5) call abort() + if (s2 /= "FIVEC") call abort() + s1 = addPrefix(subfunc()) + if (len(s1) /= 7) call abort() + if (s1 /= "..FIVEC") call abort() contains subroutine sub(str,j) character(len=:), allocatable :: str @@ -19,6 +27,17 @@ contains if (len(str) /= 5) call abort() if (str /= "ZZZZZ") call abort() end subroutine sub + function subfunc() result(res) + character(len=:), pointer :: res + res => fifec + if (len(res) /= 5) call abort() + if (res /= "FIVEC") call abort() + end function subfunc + function addPrefix(str) result(res) + character(len=:), pointer :: str + character(len=:), allocatable :: res + res = ".." // str + end function addPrefix end subroutine test program a -- 2.30.2