gcc/testsuite/gfortran.dg/function_types_2.f90

   1 ! { dg-do compile }
   2 ! Tests the fix for PR34431 in which function TYPEs that were
   3 ! USE associated would cause an error.
   4 !
   5 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
   6 !
   7 module m1
   8   integer :: hh
   9   type t
  10     real :: r
  11   end type t
  12 end module m1
  13
  14 module m2
  15   type t
  16     integer :: k
  17   end type t
  18 end module m2
  19
  20 module m3
  21 contains
  22   type(t) function func()
  23     use m2
  24     func%k = 77
  25   end function func
  26 end module m3
  27
  28 type(t) function a()
  29   use m1, only: hh
  30   type t2
  31     integer :: j
  32   end type t2
  33   type t
  34     logical :: b
  35   end type t
  36
  37   a%b = .true.
  38 end function a
  39
  40 type(t) function b()
  41   use m1, only: hh
  42   use m2
  43   use m3
  44   b = func ()
  45   b%k = 5
  46 end function b
  47
  48 type(t) function c()
  49   use m1, only: hh
  50   type t2
  51     integer :: j
  52   end type t2
  53   type t
  54     logical :: b
  55   end type t
  56
  57   c%b = .true.
  58 end function c
  59
  60 program main
  61   type t
  62     integer :: m
  63   end type t
  64 contains
  65   type(t) function a1()
  66     use m1, only: hh
  67     type t2
  68       integer :: j
  69     end type t2
  70     type t
  71       logical :: b
  72     end type t
  73
  74     a1%b = .true.
  75   end function a1
  76
  77   type(t) function b1()
  78     use m1, only: hh
  79     use m2, only: t
  80 ! NAG f95 believes that the host-associated type(t)
  81 ! should be used:
  82 !   b1%m = 5
  83 ! However, I (Tobias Burnus) believe that the use-associated one should
  84 ! be used:
  85     b1%k = 5
  86   end function b1
  87
  88   type(t) function c1()
  89     use m1, only: hh
  90     type t2
  91       integer :: j
  92     end type t2
  93     type t
  94       logical :: b
  95     end type t
  96
  97     c1%b = .true.
  98   end function c1
  99
 100   type(t) function d1()
 101     d1%m = 55
 102   end function d1
 103 end program main
 104 ! { dg-final { cleanup-modules "m1 m2 m3" } }