From: Paul Thomas <pault@gcc.gnu.org>
Date: Thu, 18 Oct 2018 10:37:39 +0000 (+0000)
Subject: re PR fortran/58618 (Wrong code with character substring and ASSOCIATE)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=75cdd535b1a47abdfc60a2950367fd4de7fae8ab;p=gcc.git

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 5ca39af187a..13e35812bad 100644
--- 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 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  <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
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  <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