gcc/testsuite/gfortran.dg/typebound_assignment_6.f03

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/56136
   4 ! ICE on defined assignment with class arrays.
   5 !
   6 ! Original testcase by Alipasha <alipash.celeris@gmail.com>
   7
   8       MODULE A_TEST_M
   9         TYPE :: A_TYPE
  10           INTEGER :: I
  11           CONTAINS
  12           GENERIC :: ASSIGNMENT (=) => ASGN_A
  13           PROCEDURE, PRIVATE :: ASGN_A
  14         END TYPE
  15
  16         CONTAINS
  17
  18         ELEMENTAL SUBROUTINE ASGN_A (A, B)
  19           CLASS (A_TYPE), INTENT (INOUT) :: A
  20           CLASS (A_TYPE), INTENT (IN) :: B
  21           A%I = B%I
  22         END SUBROUTINE
  23       END MODULE A_TEST_M
  24
  25       PROGRAM ASGN_REALLOC_TEST
  26         USE A_TEST_M
  27         TYPE (A_TYPE), ALLOCATABLE :: A(:)
  28         INTEGER :: I, J
  29
  30         ALLOCATE (A(100))
  31         A = (/ (A_TYPE(I), I=1,SIZE(A)) /)
  32         A(1:50) = A(51:100)
  33         IF (ANY(A%I /= (/ ((50+I, I=1,SIZE(A)/2), J=1,2) /))) STOP 1
  34         A(::2) = A(1:50)        ! pack/unpack
  35         IF (ANY(A( ::2)%I /= (/ (50+I, I=1,SIZE(A)/2) /))) STOP 2
  36         IF (ANY(A(2::2)%I /= (/ ((50+2*I, I=1,SIZE(A)/4), J=1,2) /))) STOP 3
  37       END PROGRAM
  38