From: Paul Thomas <pault@gcc.gnu.org>
Date: Sun, 9 Feb 2014 20:50:21 +0000 (+0000)
Subject: re PR fortran/57522 ([F03] ASSOCIATE construct creates array descriptor with incorrec... 
X-Git-Tag: releases/gcc-4.9.0~990
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=68b1c5e1f21c973090165c34e59122567b1c03df;p=thirdparty%2Fgcc.git

re PR fortran/57522 ([F03] ASSOCIATE construct creates array descriptor with incorrect stride for derived type array component)

2014-02-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/57522
	* resolve.c (resolve_assoc_var): Set the subref_array_pointer
	attribute for the 'associate-name' if necessary.
	* trans-stmt.c (trans_associate_var): If the 'associate-name'
	is a subref_array_pointer, assign the element size of the
	associate variable to 'span'.

2014-02-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/57522
	* gfortran.dg/associated_target_5.f03 : New test

From-SVN: r207646
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ab2171a811ab..89b34abff0f5 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2014-02-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/57522
+	* resolve.c (resolve_assoc_var): Set the subref_array_pointer
+	attribute for the 'associate-name' if necessary.
+	* trans-stmt.c (trans_associate_var): If the 'associate-name'
+	is a subref_array_pointer, assign the element size of the
+	associate variable to 'span'.
+
 2014-02-09  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/59026
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 02621656583a..69ec7bf4c18f 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7820,6 +7820,8 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 
       sym->attr.target = tsym->attr.target
 			 || gfc_expr_attr (target).pointer;
+      if (is_subref_array (target))
+	sym->attr.subref_array_pointer = 1;
     }
 
   /* Get type if this was not already set.  Note that it can be
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 50e9a1a2abf2..19e29a74bcea 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1192,6 +1192,17 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 					      dim, gfc_index_one_node);
 	}
 
+      /* If this is a subreference array pointer associate name use the
+	 associate variable element size for the value of 'span'.  */
+      if (sym->attr.subref_array_pointer)
+	{
+	  gcc_assert (e->expr_type == EXPR_VARIABLE);
+	  tmp = e->symtree->n.sym->backend_decl;
+	  tmp = gfc_get_element_type (TREE_TYPE (tmp));
+	  tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp));
+	  gfc_add_modify (&se.pre, GFC_DECL_SPAN(desc), tmp);
+	}
+
       /* Done, register stuff as init / cleanup code.  */
       gfc_add_init_cleanup (block, gfc_finish_block (&se.pre),
 			    gfc_finish_block (&se.post));
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d70b76235cfa..7295b9fd9533 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2014-02-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/57522
+	* gfortran.dg/associated_target_5.f03 : New test
+
 2014-02-09  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/59026
diff --git a/gcc/testsuite/gfortran.dg/associated_target_5.f03 b/gcc/testsuite/gfortran.dg/associated_target_5.f03
new file mode 100644
index 000000000000..5c29b6014bf7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_target_5.f03
@@ -0,0 +1,40 @@
+! { dg-do run }
+! Test the fix for PR57522, in which the associate name had a
+! 'span' of an INTEGER rather than that of 'mytype'.
+!
+! Contributed by A Briolat  <alan.briolat@gmail.com>
+!
+program test_associate
+  type mytype
+    integer :: a = 1, b = 2
+  end type
+  type(mytype) :: t(4), u(2,2)
+  integer :: c(4)
+  t%a = [0, 1, 2, 3]
+  t%b = [4, 5, 6, 7]
+  associate (a => t%a)
+! Test 'a' is OK on lhs and/or rhs of assignments
+    c = a - 1
+    if (any (c .ne. [-1,0,1,2])) call abort
+    a = a + 1
+    if (any (a .ne. [1,2,3,4])) call abort
+    a = t%b
+    if (any (a .ne. t%b)) call abort
+! Test 'a' is OK as an actual argument
+    c = foo(a)
+    if (any (c .ne. t%b + 10)) call abort
+  end associate
+! Make sure that the fix works for multi-dimensional arrays...
+  associate (a => u%a)
+    if (any (a .ne. reshape ([1,1,1,1],[2,2]))) call abort
+  end associate
+! ...and sections
+  associate (a => t(2:3)%b)
+    if (any (a .ne. [5,6])) call abort
+  end associate
+contains
+  function foo(arg) result(res)
+    integer :: arg(4), res(4)
+    res = arg + 10
+  end function
+end program