Dear All,

I am aware that we are in stage 4 but this wrong-code-on-valid PR is
confined to a corner of a corner and so I am certain that it can be
safely applied - OK, Richie?

This patch follows the same route as has been used for pointer array
assignment to components of derived type arrays by rolling out the
auxilliary 'span' variable for the associate-name to give it the
correct extent.  Once the array descriptor reform has been completed,
this fix should be removed. All such code can be found by grepping on
'subref_array', so the excision will be swift and painless :-)

Note that this is not needed for SELECT_TYPE since it is inaccessible
there: "component to the right of an array reference may not have
ALLOCATABLE or POINTER attribute"  && "class component must be
ALLOCATABLE or POINTER" = false for any selector that I have been able
to construct.

Bootstraps and regtests on FC17/x86_64 - OK for trunk and 4.8?

Cheers

Paul

2014-02-08  Paul Thomas  <pa...@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-08  Paul Thomas  <pa...@gcc.gnu.org>

    PR fortran/57522
    * gfortran.dg/associated_target_5.f03 : New test
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c       (revision 207612)
--- gcc/fortran/resolve.c       (working copy)
*************** resolve_assoc_var (gfc_symbol* sym, bool
*** 8269,8274 ****
--- 8269,8276 ----
  
        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
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c    (revision 207612)
--- gcc/fortran/trans-stmt.c    (working copy)
*************** trans_associate_var (gfc_symbol *sym, gf
*** 1190,1195 ****
--- 1190,1206 ----
                                              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));
Index: gcc/testsuite/gfortran.dg/associated_target_5.f03
===================================================================
*** gcc/testsuite/gfortran.dg/associated_target_5.f03   (revision 0)
--- gcc/testsuite/gfortran.dg/associated_target_5.f03   (working copy)
***************
*** 0 ****
--- 1,32 ----
+ ! { 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.brio...@gmail.com>
+ !
+ program test_associate
+   type mytype
+     integer :: a, b
+   end type
+   type(mytype) :: t(4)
+   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
+ contains
+   function foo(arg) result(res)
+     integer :: arg(4), res(4)
+     res = arg + 10
+   end function
+ end program

Reply via email to