gcc/testsuite/gfortran.dg/typebound_assignment_6.f03

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