Hi Janne,
Please find attached a revised version of the patch that fixes all the
issues that I know of.
Regtests on FC27/x86_64 - OK for trunk?
I have also attached a test of all the failing cases in PR83975.
However, I believe that they are all included in other associate*.f*.
Cheers
Paul
2018-02-19 Paul Thomas <[email protected]>
PR fortran/83344
* resolve.c (resolve_assoc_var): Rearrange the logic for the
determination of the character length of associate names. If
the associate name is missing a length expression or the length
expression is not a constant and the target is not a variable,
make the associate name allocatable and deferred length.
* trans-decl.c (gfc_get_symbol_decl): Null the character length
backend_decl for deferred length associate names that are not
variables. Set 'length' to gfc_index_zero_node for character
associate names, whose character length is a PARM_DECL.
2018-02-19 Paul Thomas <[email protected]>
PR fortran/83344
* gfortran.dg/associate_22.f90: Enable commented out test.
* gfortran.dg/associate_36.f90: New test.
On 18 February 2018 at 21:01, Paul Richard Thomas
<[email protected]> wrote:
> Hi Janne and Thomas,
>
> 1) The patch is attached now - sorry!
>
> 2) The commented out part of associate_22.f90 is not yet fixed. I am
> working on it.
>
> 3) I will take a look at PR83975 tomorrow night.
>
> Paul
>
>
> On 18 February 2018 at 16:08, Janne Blomqvist <[email protected]>
> wrote:
>> On Sun, Feb 18, 2018 at 5:48 PM, Paul Richard Thomas
>> <[email protected]> wrote:
>>> Bootstraps and regtests on FC27/x86_64 - OK for trunk?
>>
>> Hi,
>>
>> thanks for looking into this!
>>
>> 1. The patch itself is missing...
>>
>> 2. Could you uncomment the commented out part of associate_22.f90 and
>> check that the tree-original dump is sensible.
>>
>> 3. Same for the testcases posted to PR 83975. I suspect (err, hope)
>> that this patch would fix those as well. If so, please add that PR to
>> the ChangeLog entries as well.
>>
>>>
>>> Paul
>>>
>>> 2018-02-18 Paul Thomas <[email protected]>
>>>
>>> PR fortran/83344
>>> * resolve.c (resolve_assoc_var): Character associate names that
>>> have no length expression that have variable targets and are
>>> not deferred length have assumed length.
>>> * trans-decl.c (gfc_get_symbol_decl): Set 'length' to
>>> gfc_index_zero_node for character associate names, whose string
>>> length is a PARM_DECL.
>>>
>>> 2018-02-18 Paul Thomas <[email protected]>
>>>
>>> PR fortran/83344
>>> * gfortran.dg/associate_36.f90: New test.
>>
>>
>>
>> --
>> Janne Blomqvist
>
>
>
> --
> "If you can't explain it simply, you don't understand it well enough"
> - Albert Einstein
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 257787)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_assoc_var (gfc_symbol* sym, bool
*** 8635,8664 ****
if (sym->ts.type == BT_CHARACTER && !sym->attr.select_type_temporary)
{
if (!sym->ts.u.cl)
! {
! if (target->expr_type != EXPR_CONSTANT
! && !target->ts.u.cl->length)
! {
! sym->ts.u.cl = gfc_get_charlen();
! sym->ts.deferred = 1;
! /* This is reset in trans-stmt.c after the assignment
! of the target expression to the associate name. */
! sym->attr.allocatable = 1;
! }
! else
! sym->ts.u.cl = target->ts.u.cl;
}
!
! if (!sym->ts.u.cl->length && !sym->ts.deferred)
{
! if (target->expr_type == EXPR_CONSTANT)
! sym->ts.u.cl->length =
! gfc_get_int_expr (gfc_charlen_int_kind, NULL,
! target->value.character.length);
! else
! gfc_error ("Not Implemented: Associate target with type character"
! " and non-constant length at %L", &target->where);
}
}
--- 8635,8660 ----
if (sym->ts.type == BT_CHARACTER && !sym->attr.select_type_temporary)
{
if (!sym->ts.u.cl)
! sym->ts.u.cl = target->ts.u.cl;
! if (!sym->ts.u.cl->length
! && !sym->ts.deferred
! && target->expr_type == EXPR_CONSTANT)
! {
! sym->ts.u.cl->length =
! gfc_get_int_expr (gfc_charlen_int_kind, NULL,
! target->value.character.length);
}
! else if ((!sym->ts.u.cl->length
! || sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
! && target->expr_type != EXPR_VARIABLE)
{
! sym->ts.u.cl = gfc_get_charlen();
! sym->ts.deferred = 1;
!
! /* This is reset in trans-stmt.c after the assignment
! of the target expression to the associate name. */
! sym->attr.allocatable = 1;
}
}
Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c (revision 257787)
--- gcc/fortran/trans-decl.c (working copy)
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 1707,1718 ****
&& sym->assoc && sym->assoc->target
&& ((sym->assoc->target->expr_type == EXPR_VARIABLE
&& sym->assoc->target->symtree->n.sym->ts.type != BT_CHARACTER)
! || sym->assoc->target->expr_type == EXPR_FUNCTION))
sym->ts.u.cl->backend_decl = NULL_TREE;
if (sym->attr.associate_var
&& sym->ts.u.cl->backend_decl
! && VAR_P (sym->ts.u.cl->backend_decl))
length = gfc_index_zero_node;
else
length = gfc_create_string_length (sym);
--- 1707,1719 ----
&& sym->assoc && sym->assoc->target
&& ((sym->assoc->target->expr_type == EXPR_VARIABLE
&& sym->assoc->target->symtree->n.sym->ts.type != BT_CHARACTER)
! || sym->assoc->target->expr_type != EXPR_VARIABLE))
sym->ts.u.cl->backend_decl = NULL_TREE;
if (sym->attr.associate_var
&& sym->ts.u.cl->backend_decl
! && (VAR_P (sym->ts.u.cl->backend_decl)
! || TREE_CODE (sym->ts.u.cl->backend_decl) == PARM_DECL))
length = gfc_index_zero_node;
else
length = gfc_create_string_length (sym);
Index: gcc/testsuite/gfortran.dg/associate_22.f90
===================================================================
*** gcc/testsuite/gfortran.dg/associate_22.f90 (revision 257787)
--- gcc/testsuite/gfortran.dg/associate_22.f90 (working copy)
*************** program foo
*** 24,34 ****
end associate
! This failed.
! ! This still doesn't work correctly, see PR 83344
! ! a = trim(s) // 'abc'
! ! associate(w => trim(s) // 'abc')
! ! if (trim(w) /= trim(a)) STOP 4
! ! end associate
! This failed.
associate(x => trim('abc'))
--- 24,33 ----
end associate
! This failed.
! a = trim(s) // 'abc'
! associate(w => trim(s) // 'abc')
! if (trim(w) /= trim(a)) STOP 4
! end associate
! This failed.
associate(x => trim('abc'))
Index: gcc/testsuite/gfortran.dg/associate_36.f90
===================================================================
*** gcc/testsuite/gfortran.dg/associate_36.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/associate_36.f90 (working copy)
***************
*** 0 ****
--- 1,28 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR83344.
+ !
+ ! Contributed by <Janne Blomqvist <[email protected]>
+ !
+ program foo
+ implicit none
+ character(len=1) a
+ character(len=2) b
+ character(len=3) c
+ a = 'a'
+ call bah(a, len (a))
+ b = 'bb'
+ call bah(b, len (b))
+ c = 'ccc'
+ call bah(c, len (c))
+ contains
+ subroutine bah(x, clen)
+ implicit none
+ integer :: clen
+ character(len=*), intent(in) :: x
+ associate(y => x)
+ if (len(y) .ne. clen) stop 1
+ if (y .ne. x) stop 2
+ end associate
+ end subroutine bah
+ end program foo
! { dg-do run }
!
! Checks that all the tests in PR83975 now work.
!
! Contributed by G Steinmetz <[email protected]>
!
character(10) :: chr = "abcdefghij"
call s1(chr)
call s2(chr)
call s3(chr)
call s4(chr)
call s5(chr)
contains
subroutine s1(x)
character(*) :: x
associate (y => x)
if (y .ne. "abcdefghij") stop 1
y = "xyz end"
end associate
end
subroutine s2(x)
character(*) :: x
associate (y => [x])
if (y(1) .ne. "xyz end") stop 2
end associate
end
subroutine s3(x)
character(*) :: x
associate (y => [x, x])
if (any (y .ne. ["xyz end","xyz end"])) stop 3
end associate
end
subroutine s4(x)
character(*) :: x
associate (y => x)
y = "abc end"
if (y .ne. "abc end") stop 4
end associate
end
subroutine s5(x)
character(*) :: x
associate (y => x//x)
if (y .ne. "abc endabc end") stop 5
end associate
end
end
