gcc/testsuite/gfortran.dg/class_allocate_11.f03

   1 ! { dg-do run }
   2 ! PR48705 - ALLOCATE with class function expression for SOURCE failed.
   3 ! This is the original test in the PR.
   4 !
   5 ! Reported by Tobias Burnus  <burnus@gcc.gnu.org>
   6 !
   7 module generic_deferred
   8   implicit none
   9   type, abstract :: addable
  10   contains
  11     private
  12     procedure(add), deferred :: a
  13     generic, public :: operator(+) => a
  14   end type addable
  15   abstract interface
  16     function add(x, y) result(res)
  17       import :: addable
  18       class(addable), intent(in) :: x, y
  19       class(addable), allocatable :: res
  20     end function add
  21   end interface
  22   type, extends(addable) :: vec
  23     integer :: i(2)
  24   contains
  25     procedure :: a => a_vec
  26   end type
  27 contains
  28   function a_vec(x, y) result(res)
  29     class(vec), intent(in) :: x
  30     class(addable), intent(in) :: y
  31     class(addable), allocatable :: res
  32     integer :: ii(2)
  33     select type(y)
  34     class is (vec)
  35       ii = y%i
  36     end select
  37     allocate(vec :: res)
  38     select type(res)
  39     type is (vec)
  40        res%i = x%i + ii
  41     end select
  42   end function
  43 end module generic_deferred
  44 program prog
  45   use generic_deferred
  46   implicit none
  47   type(vec) :: x, y
  48   class(addable), allocatable :: z
  49 !  x = vec( (/1,2/) );   y = vec( (/2,-2/) )
  50   x%i = (/1,2/); y%i = (/2,-2/)
  51   allocate(z, source= x + y)
  52   select type(z)
  53   type is(vec)
  54      if (z%i(1) /= 3 .or. z%i(2) /= 0) then
  55         write(*,*) 'FAIL'
  56      else
  57         write(*,*) 'OK'
  58      end if
  59   end select
  60 end program prog