From 75cdd535b1a47abdfc60a2950367fd4de7fae8ab Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Thu, 18 Oct 2018 10:37:39 +0000 Subject: [PATCH] re PR fortran/58618 (Wrong code with character substring and ASSOCIATE) 2018-10-18 Paul Thomas PR fortran/58618 * trans-stmt.c (trans_associate_var): All strings that return as pointer types can be assigned directly to the associate name so remove 'attr' and the condition that uses it. 2018-10-18 Paul Thomas PR fortran/58618 * gfortran.dg/associate_45.f90 : New test. From-SVN: r265264 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/trans-stmt.c | 7 ++-- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/associate_45.f90 | 38 ++++++++++++++++++++++ 4 files changed, 52 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/associate_45.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5ca39af187a..13e35812bad 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2018-10-18 Paul Thomas + + PR fortran/58618 + * trans-stmt.c (trans_associate_var): All strings that return + as pointer types can be assigned directly to the associate + name so remove 'attr' and the condition that uses it. + 2018-10-18 Paul Thomas PR fortran/58618 diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index c778df06329..00fdf19d730 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1656,7 +1656,6 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) bool need_len_assign; bool whole_array = true; gfc_ref *ref; - symbol_attribute attr; gcc_assert (sym->assoc); e = sym->assoc->target; @@ -1916,9 +1915,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) } } - attr = gfc_expr_attr (e); if (sym->ts.type == BT_CHARACTER && e->ts.type == BT_CHARACTER - && (attr.allocatable || attr.pointer || attr.dummy) && POINTER_TYPE_P (TREE_TYPE (se.expr))) { /* These are pointer types already. */ @@ -1926,8 +1923,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) } else { - tmp = TREE_TYPE (sym->backend_decl); - tmp = gfc_build_addr_expr (tmp, se.expr); + tmp = TREE_TYPE (sym->backend_decl); + tmp = gfc_build_addr_expr (tmp, se.expr); } gfc_add_modify (&se.pre, sym->backend_decl, tmp); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 57cbb79bba2..6f7d3b9e883 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-10-18 Paul Thomas + + PR fortran/58618 + * gfortran.dg/associate_45.f90 : New test. + 2018-10-18 Paul Thomas PR fortran/58618 diff --git a/gcc/testsuite/gfortran.dg/associate_45.f90 b/gcc/testsuite/gfortran.dg/associate_45.f90 new file mode 100644 index 00000000000..c3b9c86dc5c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_45.f90 @@ -0,0 +1,38 @@ +! { dg-do run } +! +! Test the fix for PR58618 by checking that substring associate targets +! work correctly. +! +! Contributed by Vladimir Fuka +! + character(5) :: s(2) = ['abcde','fghij'] + character (6), pointer :: ptr => NULL() + character (6), target :: tgt = 'lmnopq' + + associate (x=>s(2)(3:4)) + if (x .ne. 'hi') stop 1 + x = 'uv' + end associate + if (any (s .ne. ['abcde','fguvj'])) stop 2 + +! Unity based substrings are cast differently. */ + associate (x=>s(1)(1:4)) + if (x .ne. 'abcd') stop 3 + x(2:3) = 'wx' + end associate + if (any (s .ne. ['awxde','fguvj'])) stop 4 + +! Make sure that possible misidentifications do not occur. + ptr => tgt + associate (x=>ptr) + if (x .ne. 'lmnopq') stop 5 + x(2:3) = 'wx' + end associate + if (tgt .ne. 'lwxopq') stop 6 + + associate (x=>ptr(5:6)) + if (x .ne. 'pq') stop 7 + x = 'wx' + end associate + if (tgt .ne. 'lwxowx') stop 8 + end -- 2.30.2