gcc/testsuite/gfortran.dg/func_derived_1.f90

   1 ! { dg-do run }
   2 ! { dg-options "-std=legacy" }
   3 !
   4 ! PR 17244
   5 ! verifies that functions returning derived type work
   6 module m
   7   type t
   8      integer i
   9      real x
  10      character*5 c
  11      integer arr(5,5)
  12   end type t
  13 end module m
  14
  15 use m
  16 type(t) :: r
  17 integer arr(5,5), vect(25), vect2(25)
  18 do i=1,25
  19    vect = 0
  20    vect(i) = i
  21    arr = reshape (vect, shape(arr))
  22    r = f(i,real(i),"HALLO",arr)
  23
  24    if (r%i .ne. i) STOP 1
  25    if (r%x .ne. real(i)) STOP 2
  26    if (r%c .ne. "HALLO") STOP 3
  27    vect2 = reshape (r%arr, shape(vect2))
  28    if (any(vect2.ne.vect)) STOP 4
  29 end do
  30 contains
  31
  32 function f(i,x,c,arr)
  33   type(t) :: f
  34   character*5 c
  35   integer arr(5,5)
  36
  37   f = t(i,x,c,arr)
  38 end function f
  39
  40 end