re PR fortran/58618 (Wrong code with character substring and ASSOCIATE)

2018-10-18  Paul Thomas  <pault@gcc.gnu.org>

	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  <pault@gcc.gnu.org>

	PR fortran/58618
	* gfortran.dg/associate_45.f90 : New test.

From-SVN: r265264

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5ca39af187a9dc25dd3d930e59664bb694e032ff..13e35812bad59f59c95d0d7c0a9b858f5b0115a6 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2018-10-18  Paul Thomas  <pault@gcc.gnu.org>
+
+       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  <pault@gcc.gnu.org>
 
        PR fortran/58618

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index c778df06329b3ee42aa892d3cbdfcbe9768dde3a..00fdf19d730ae34b850f546d6760a6383af61a5b 100644 (file)
--- 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 57cbb79bba25e48268bc358f45d8d140c78f997c..6f7d3b9e8838fe3725d5852dfbe555907f0e9f31 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-10-18  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/58618
+       * gfortran.dg/associate_45.f90 : New test.
+
 2018-10-18  Paul Thomas  <pault@gcc.gnu.org>
 
        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 (file)
index 0000000..c3b9c86
--- /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  <vladimir.fuka@gmail.com>
+!
+    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