gcc/testsuite/gfortran.dg/class_dummy_7.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR46991 - enable class assumed size arrays
   4 !
   5 ! Reported by Tobias Burnus  <burnus@gcc.gnu.org>
   6 ! from http://j3-fortran.org/pipermail/j3/2010-December/004084.html
   7 ! submitted by Robert Corbett.
   8 !
   9        MODULE TYPES
  10          PRIVATE
  11          PUBLIC REC, REC2
  12
  13          TYPE REC
  14            INTEGER A
  15          END TYPE
  16
  17          TYPE, EXTENDS(REC) :: REC2
  18            INTEGER B
  19          END TYPE
  20        END
  21
  22        SUBROUTINE SUB1(A, N)
  23          USE TYPES
  24          CLASS(REC), INTENT(IN) :: A(*)
  25          INTERFACE
  26            SUBROUTINE SUB2(A, N, IARRAY)
  27              USE TYPES
  28              TYPE(REC) A(*)
  29              INTEGER :: N, IARRAY(N)
  30            END
  31          END INTERFACE
  32
  33          CALL SUB2(A, N,[1,2,2,3,3,4,4,5,5,6])
  34          select type (B => A(1:N))
  35              type is (REC2)
  36                  call SUB2(B%REC,N,[1,2,3,4,5,6,7,8,9,10])
  37          end select
  38
  39        END
  40
  41        SUBROUTINE SUB2(A, N, IARRAY)
  42          USE TYPES
  43          TYPE(REC) A(*)
  44          INTEGER :: N, IARRAY(N)
  45          if (any (A(:N)%A .ne. IARRAY(:N))) stop 1
  46        END
  47
  48        PROGRAM MAIN
  49          USE TYPES
  50          CLASS(REC), ALLOCATABLE :: A(:)
  51          INTERFACE
  52            SUBROUTINE SUB1(A, N)
  53              USE TYPES
  54              CLASS(REC), INTENT(IN) :: A(*)
  55            END SUBROUTINE
  56          END INTERFACE
  57
  58          A = [ (REC2(I, I+1), I = 1, 10) ]
  59          CALL SUB1(A, 10)
  60        END