gcc/testsuite/gfortran.dg/interface_16.f90

   1 ! { dg-do compile }
   2 ! This tests the fix for PR32634, in which the generic interface
   3 ! in foo_pr_mod was given the original rather than the local name.
   4 ! This meant that the original name had to be used in the calll
   5 ! in foo_sub.
   6 !
   7 ! Contributed by Salvatore Filippone <salvatore.filippone@uniroma2.it>
   8
   9 module foo_base_mod
  10   type foo_dmt
  11     real(kind(1.d0)), allocatable  :: rv(:)
  12     integer, allocatable :: iv1(:), iv2(:)
  13   end type foo_dmt
  14   type foo_zmt
  15     complex(kind(1.d0)), allocatable  :: rv(:)
  16     integer, allocatable  :: iv1(:), iv2(:)
  17   end type foo_zmt
  18   type foo_cdt
  19      integer, allocatable :: md(:)
  20      integer, allocatable :: hi(:), ei(:)
  21   end type foo_cdt
  22 end module foo_base_mod
  23
  24 module bar_prt
  25   use foo_base_mod, only : foo_dmt, foo_zmt, foo_cdt
  26   type bar_dbprt
  27     type(foo_dmt), allocatable :: av(:)
  28     real(kind(1.d0)), allocatable      :: d(:)
  29     type(foo_cdt)                :: cd
  30   end type bar_dbprt
  31   type bar_dprt
  32     type(bar_dbprt), allocatable  :: bpv(:)
  33   end type bar_dprt
  34   type bar_zbprt
  35     type(foo_zmt), allocatable :: av(:)
  36     complex(kind(1.d0)), allocatable   :: d(:)
  37     type(foo_cdt)                :: cd
  38   end type bar_zbprt
  39   type bar_zprt
  40     type(bar_zbprt), allocatable  :: bpv(:)
  41   end type bar_zprt
  42 end module bar_prt
  43
  44 module bar_pr_mod
  45   use bar_prt
  46   interface bar_pwrk
  47     subroutine bar_dppwrk(pr,x,y,cd,info,trans,work)
  48       use foo_base_mod
  49       use bar_prt
  50       type(foo_cdt),intent(in)    :: cd
  51       type(bar_dprt), intent(in)  :: pr
  52       real(kind(0.d0)),intent(inout)    :: x(:), y(:)
  53       integer, intent(out)              :: info
  54       character(len=1), optional        :: trans
  55       real(kind(0.d0)),intent(inout), optional, target :: work(:)
  56     end subroutine bar_dppwrk
  57     subroutine bar_zppwrk(pr,x,y,cd,info,trans,work)
  58       use foo_base_mod
  59       use bar_prt
  60       type(foo_cdt),intent(in)    :: cd
  61       type(bar_zprt), intent(in)  :: pr
  62       complex(kind(0.d0)),intent(inout) :: x(:), y(:)
  63       integer, intent(out)              :: info
  64       character(len=1), optional        :: trans
  65       complex(kind(0.d0)),intent(inout), optional, target :: work(:)
  66     end subroutine bar_zppwrk
  67   end interface
  68 end module bar_pr_mod
  69
  70 module foo_pr_mod
  71   use bar_prt, &
  72        & foo_dbprt  => bar_dbprt,&
  73        & foo_zbprt  => bar_zbprt,&
  74        & foo_dprt   => bar_dprt,&
  75        & foo_zprt   => bar_zprt
  76   use bar_pr_mod, &
  77        & foo_pwrk  => bar_pwrk
  78 end module foo_pr_mod
  79
  80 Subroutine foo_sub(a,pr,b,x,eps,cd,info)
  81   use foo_base_mod
  82   use foo_pr_mod
  83   Implicit None
  84 !!$  parameters
  85   Type(foo_dmt), Intent(in)  :: a
  86   Type(foo_dprt), Intent(in)   :: pr
  87   Type(foo_cdt), Intent(in)    :: cd
  88   Real(Kind(1.d0)), Intent(in)       :: b(:)
  89   Real(Kind(1.d0)), Intent(inout)    :: x(:)
  90   Real(Kind(1.d0)), Intent(in)       :: eps
  91   integer, intent(out)               :: info
  92 !!$   Local data
  93   Real(Kind(1.d0)), allocatable, target   :: aux(:),wwrk(:,:)
  94   Real(Kind(1.d0)), allocatable   :: p(:), f(:)
  95   info = 0
  96   Call foo_pwrk(pr,p,f,cd,info,work=aux)  ! This worked if bar_pwrk was called!
  97   return
  98 End Subroutine foo_sub
  99
 100 ! { dg-final { cleanup-modules "foo_base_mod foo_pr_mod bar_pr_mod bar_prt" } }
 101