gcc/testsuite/gfortran.dg/constructor_2.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/39427
   4 !
   5 module foo_module
   6   interface foo
   7     procedure constructor
   8   end interface
   9
  10   type foo
  11     integer :: bar
  12   end type
  13 contains
  14   type(foo) function constructor()
  15     constructor%bar = 1
  16   end function
  17
  18   subroutine test_foo()
  19     type(foo) :: f
  20     f = foo()
  21     if (f%bar /= 1) STOP 1
  22     f = foo(2)
  23     if (f%bar /= 2) STOP 2
  24   end subroutine test_foo
  25 end module foo_module
  26
  27
  28 ! Same as foo_module but order
  29 ! of INTERFACE and TYPE reversed
  30 module bar_module
  31   type bar
  32     integer :: bar
  33   end type
  34
  35   interface bar
  36     procedure constructor
  37   end interface
  38 contains
  39   type(bar) function constructor()
  40     constructor%bar = 3
  41   end function
  42
  43   subroutine test_bar()
  44     type(bar) :: f
  45     f = bar()
  46     if (f%bar /= 3) STOP 3
  47     f = bar(4)
  48     if (f%bar /= 4) STOP 4
  49   end subroutine test_bar
  50 end module bar_module
  51
  52 program main
  53   use foo_module
  54   use bar_module
  55   implicit none
  56
  57   type(foo) :: f
  58   type(bar) :: b
  59
  60   call test_foo()
  61   f = foo()
  62   if (f%bar /= 1) STOP 5
  63   f = foo(2)
  64   if (f%bar /= 2) STOP 6
  65
  66   call test_bar()
  67   b = bar()
  68   if (b%bar /= 3) STOP 7
  69   b = bar(4)
  70   if (b%bar /= 4) STOP 8
  71 end program main
  72