This patch is verging on 'obvious' since there was no attempt being
made to detect dimensions where the array reference of the selector is
an element. In fact, I made an attempt when the bug was first reported
to do this, Not realizing that the elements were coming through as
DIMEN_UNKNOWN, the attempt failed. This is now catered for.
Bootstrapped and regtested on FC27/x86_64. OK for all active branches?
Paul
2018-05-19 Paul Thomas <[email protected]>
PR fortran/82275
* match.c (gfc_match_type_spec): Go through the array ref and
decrement 'rank' for every dimension that is an element.
2018-05-19 Paul Thomas <[email protected]>
PR fortran/82923
* gfortran.dg/select_type_42.f90: New test.
Index: gcc/fortran/match.c
===================================================================
*** gcc/fortran/match.c (revision 260317)
--- gcc/fortran/match.c (working copy)
*************** gfc_match_type_spec (gfc_typespec *ts)
*** 2118,2124 ****
or list item in a type-list of an OpenMP reduction clause. Need to
differentiate REAL([KIND]=scalar-int-initialization-expr) from
REAL(A,[KIND]) and REAL(KIND,A). Logically, when this code was
! written the use of LOGICAL as a type-spec or intrinsic subprogram
was overlooked. */
m = gfc_match (" %n", name);
--- 2118,2124 ----
or list item in a type-list of an OpenMP reduction clause. Need to
differentiate REAL([KIND]=scalar-int-initialization-expr) from
REAL(A,[KIND]) and REAL(KIND,A). Logically, when this code was
! written the use of LOGICAL as a type-spec or intrinsic subprogram
was overlooked. */
m = gfc_match (" %n", name);
*************** copy_ts_from_selector_to_associate (gfc_
*** 5935,5940 ****
--- 5935,5941 ----
{
gfc_ref *ref;
gfc_symbol *assoc_sym;
+ int rank = 0;
assoc_sym = associate->symtree->n.sym;
*************** copy_ts_from_selector_to_associate (gfc_
*** 5971,5984 ****
selector->rank = ref->u.ar.dimen;
else
selector->rank = 0;
}
! if (selector->rank)
{
! assoc_sym->attr.dimension = 1;
! assoc_sym->as = gfc_get_array_spec ();
! assoc_sym->as->rank = selector->rank;
! assoc_sym->as->type = AS_DEFERRED;
}
else
assoc_sym->as = NULL;
--- 5972,5999 ----
selector->rank = ref->u.ar.dimen;
else
selector->rank = 0;
+
+ rank = selector->rank;
}
! if (rank)
{
! for (int i = 0; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
! if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT
! || (ref->u.ar.dimen_type[i] == DIMEN_UNKNOWN
! && ref->u.ar.end[i] == NULL
! && ref->u.ar.stride[i] == NULL))
! rank--;
!
! if (rank)
! {
! assoc_sym->attr.dimension = 1;
! assoc_sym->as = gfc_get_array_spec ();
! assoc_sym->as->rank = rank;
! assoc_sym->as->type = AS_DEFERRED;
! }
! else
! assoc_sym->as = NULL;
}
else
assoc_sym->as = NULL;
Index: gcc/testsuite/gfortran.dg/select_type_42.f90
===================================================================
*** gcc/testsuite/gfortran.dg/select_type_42.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/select_type_42.f90 (working copy)
***************
*** 0 ****
--- 1,26 ----
+ ! { dg-do run }
+ !
+ ! Tests the fix for PR82275.
+ ! Associating a name with a reduced-dimension section of a
+ ! multidimensional array precluded subsequent use of the name
+ ! with the appropriately reduced dimensionality and instead
+ ! required use of the (invalid) full set of original dimensions.
+ !
+ ! Contributed by Damian Rouson <[email protected]>
+ !
+ type component
+ integer :: i
+ end type
+ type container
+ class(component), allocatable :: component_array(:,:)
+ end type
+ type(container) bag
+ type(component) section_copy
+ allocate(bag%component_array, source = reshape ([component(10), component (100)], [1,2]))
+ select type(associate_name=>bag%component_array(1,:))
+ type is (component)
+ section_copy = associate_name(2) ! gfortran rejected valid
+ ! section_copy = associate_name(1,1)! gfortran accepted invalid
+ end select
+ if (section_copy%i .ne. 100) stop 1
+ end
