Hi Paul, thanks for the reviewed and the valued comments.
Just for completeness I have attached the patch with the changes requested.
Bootstraps and regtests ok on x86_64-linux-gnu.
Regards,
Andre
On Mon, 12 Jan 2015 22:07:29 +0100
Paul Richard Thomas <paul.richard.tho...@gmail.com> wrote:
> Hi Andre,
>
> + 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);
>
> This is OK but I would use instead:
> + if (POINTER_TYPE_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 = build_fold_indirect_ref
> (parmse.string_length);
>
> If you look in ~/gcc/fold-const.c:15751, you will see that
> TREE_OPERAND (parmse.string_length, 0) but that it is preceded by
> cleaning up of NOOPS and, in any case, its usage will preserve the
> standard API.... just in case the internals change :-)
>
> of course, using TREE_OPERAND (xxx, 0) in the various fortran class
> functions makes such an assumption ;-)
>
> Apart from that, the patch is fine.
>
> I'll have a session of doing some commits later this week and will do
> this patch at that time.
>
> Cheers
>
> Paul
>
> On 11 January 2015 at 16:21, Andre Vehreschild <ve...@gmx.de> wrote:
> > Hi Paul,
> >
> > thanks for the review. I do not have commits rights.
> >
> > Unfortunately is the patch not ok. I figured today, that it needs an
> > extension when function calls that return deferred char len arrays are
> > nested. In this special case the string length would have been lost. The
> > attached extended version fixes this issue.
> >
> > Sorry for the duplicate work.
> >
> > Bootstraps and regtests ok on x86_64-linux-gnu.
> >
> > Regards,
> > Andre
> >
> > On Sun, 11 Jan 2015 16:11:10 +0100
> > Paul Richard Thomas <paul.richard.tho...@gmail.com> wrote:
> >
> >> Dear Andre,
> >>
> >> This is OK for trunk. I have not been keeping track of whether or not
> >> you have commit rights yet. If not, I will get to it sometime this
> >> week.
> >>
> >> Thanks for the patch.
> >>
> >> Paul
> >>
> >> On 10 January 2015 at 15:59, Andre Vehreschild <ve...@gmx.de> wrote:
> >> > Hi all,
> >> >
> >> > attached patch fixes the bug reported in pr 60334. The issue here was
> >> > that the function's result being (a pointer to) a deferred length char
> >> > array. The string length for the result value was wrapped in a local
> >> > variable, whose value was never written back to the string length of the
> >> > result. This lead the calling routine to take the length of the result
> >> > to be random leading to a crash.
> >> >
> >> > This patch addresses the issue by preventing the instantiation of the
> >> > local var and instead using a reference to the parameter. This not only
> >> > saves one value on the stack, but also because for small functions the
> >> > compiler will hold all parameters in registers for a significant level
> >> > of optimization, all the overhead of memory access (I hope :-).
> >> >
> >> > Bootstraps and regtests ok on x86_64-linux-gnu.
> >> >
> >> > - Andre
> >> > --
> >> > Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
> >> > Tel.: +49 241 9291018 * Email: ve...@gmx.de
> >>
> >>
> >>
> >
> >
> > --
> > Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
> > Tel.: +49 241 9291018 * Email: ve...@gmx.de
>
>
>
--
Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
Tel.: +49 241 9291018 * Email: ve...@gmx.de
pr60334_3.clog
Description: Binary data
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 1e74125..86873f7 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1333,12 +1333,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 6bd3b03..196d119 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5058,10 +5058,19 @@ 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 (POINTER_TYPE_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 = build_fold_indirect_ref (
+ parmse.string_length);
+ 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/gfortran.dg/deferred_type_param_6.f90 b/gcc/testsuite/gfortran.dg/deferred_type_param_6.f90
index eb00778..a2fabe8 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
