I am a tiny bit skeptical that this is a regression but I will check.
However, it has clearly been there from the early days of OOP without
being picked up.
The fix is to ensure that the temporary has the correct type of array spec.
Regtested on x86_64/FC31 - OK for trunk and 8-/9- branches ?
Cheers
Paul
2020-02-29 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/92976
* match.c (select_type_set_tmp): If the selector array spec has
explicit bounds, make the temporary's bounds deferred.
2020-02-29 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/92976
* gfortran.dg/select_type_48.f90 : New test.
Index: gcc/fortran/match.c
===================================================================
*** gcc/fortran/match.c (revision 279842)
--- gcc/fortran/match.c (working copy)
*************** select_type_set_tmp (gfc_typespec *ts)
*** 6294,6301 ****
= CLASS_DATA (selector)->attr.dimension;
sym->attr.codimension
= CLASS_DATA (selector)->attr.codimension;
! sym->as
! = gfc_copy_array_spec (CLASS_DATA (selector)->as);
}
}
--- 6294,6307 ----
= CLASS_DATA (selector)->attr.dimension;
sym->attr.codimension
= CLASS_DATA (selector)->attr.codimension;
! if (CLASS_DATA (selector)->as->type != AS_EXPLICIT)
! sym->as = gfc_copy_array_spec (CLASS_DATA (selector)->as);
! else
! {
! sym->as = gfc_get_array_spec();
! sym->as->rank = CLASS_DATA (selector)->as->rank;
! sym->as->type = AS_DEFERRED;
! }
}
}
Index: gcc/testsuite/gfortran.dg/select_type_48.f90
===================================================================
*** gcc/testsuite/gfortran.dg/select_type_48.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/select_type_48.f90 (working copy)
***************
*** 0 ****
--- 1,31 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR92976, in which the TYPE IS statement caused an ICE
+ ! because of the explicit bounds of 'x'.
+ !
+ ! Contributed by Gerhard Steinmetz <gs...@t-online.de>
+ !
+ program p
+ type t
+ integer :: i
+ end type
+ class(t), allocatable :: c(:)
+ allocate (c, source = [t(1111),t(2222),t(3333)])
+ call s(c)
+ if (sum (c%i) .ne. 3333) stop 1
+ contains
+ subroutine s(x)
+ class(t) :: x(2)
+ select type (x)
+ ! ICE as compiler attempted to assign descriptor to an array
+ type is (t)
+ x%i = 0
+ ! Make sure that bounds are correctly translated.
+ call counter (x)
+ end select
+ end
+ subroutine counter (arg)
+ type(t) :: arg(:)
+ if (size (arg, 1) .ne. 2) stop 2
+ end
+ end
