gcc/testsuite/gfortran.dg/pr104429.f90

   1 ! { dg-do run }
   2 !
   3 ! Contributed by Gerhard Steinmetz  <gscfq@t-online.de>
   4 !
   5 module m
   6    type t
   7       real :: r
   8    contains
   9       procedure :: op
  10       procedure :: assign
  11       generic :: operator(*) => op
  12       generic :: assignment(=) => assign
  13    end type
  14 contains
  15    function op (x, y)
  16       class(t), allocatable :: op
  17       class(t), intent(in) :: x
  18       real, intent(in) :: y
  19       allocate (op, source = t (x%r * y))
  20    end
  21    subroutine assign (z, x)
  22       type(t), intent(in) :: x
  23       class(t), intent(out) :: z
  24       z%r = x%r
  25    end
  26 end
  27 program p
  28    use m
  29    class(t), allocatable :: x
  30    real :: y = 2
  31    allocate (x, source = t (2.0))
  32    x = x * y
  33    if (int (x%r) .ne. 4) stop 1
  34    if (allocated (x)) deallocate (x)
  35 end