gcc/testsuite/gfortran.dg/func_result_6.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/47775
   4 !
   5 ! Contributed by Fran Martinez Fadrique
   6 !
   7 ! Before, a temporary was missing for generic procedured (cf. test())
   8 ! as the allocatable attribute was ignored for the check whether a
   9 ! temporary is required
  10 !
  11 module m
  12 type t
  13 contains
  14   procedure, NOPASS :: foo => foo
  15   generic :: gen => foo
  16 end type t
  17 contains
  18   function foo(i)
  19     integer, allocatable :: foo(:)
  20     integer :: i
  21     allocate(foo(2))
  22     foo(1) = i
  23     foo(2) = i + 10
  24   end function foo
  25 end module m
  26
  27 use m
  28 type(t) :: x
  29 integer, pointer :: ptr1, ptr2
  30 integer, target              :: bar1(2)
  31 integer, target, allocatable :: bar2(:)
  32
  33 allocate(bar2(2))
  34 ptr1 => bar1(2)
  35 ptr2 => bar2(2)
  36
  37 bar1 = x%gen(1)
  38 if (ptr1 /= 11) call abort()
  39 bar1 = x%foo(2)
  40 if (ptr1 /= 12) call abort()
  41 bar2 = x%gen(3)
  42 if (ptr2 /= 13) call abort()
  43 bar2 = x%foo(4)
  44 if (ptr2 /= 14) call abort()
  45 bar2(:) = x%gen(5)
  46 if (ptr2 /= 15) call abort()
  47 bar2(:) = x%foo(6)
  48 if (ptr2 /= 16) call abort()
  49
  50 call test()
  51 end
  52
  53 subroutine test
  54 interface gen
  55   procedure foo
  56 end interface gen
  57
  58 integer, target :: bar(2)
  59 integer, pointer :: ptr
  60 bar = [1,2]
  61 ptr => bar(2)
  62 if (ptr /= 2) call abort()
  63 bar = gen()
  64 if (ptr /= 77) call abort()
  65 contains
  66   function foo()
  67     integer, allocatable :: foo(:)
  68     allocate(foo(2))
  69     foo = [33, 77]
  70   end function foo
  71 end subroutine test