gcc/testsuite/gfortran.dg/associate_14.f90

   1 ! { dg-do compile }
   2 ! Tests the fix for PR55984.
   3 !
   4 ! Contributed by Sylwester Arabas  <slayoo@staszic.waw.pl>
   5 !
   6 module bcd_m
   7   type, abstract :: bcd_t
   8     contains
   9     procedure(bcd_fill_halos), deferred :: fill_halos
  10   end type
  11   abstract interface
  12     subroutine bcd_fill_halos(this)
  13       import :: bcd_t
  14       class(bcd_t ) :: this
  15     end subroutine
  16   end interface
  17 end module
  18
  19 module solver_m
  20   use bcd_m
  21   type, abstract :: solver_t
  22     integer :: n, hlo
  23     class(bcd_t), pointer :: bcx, bcy
  24     contains
  25     procedure(solver_advop), deferred :: advop
  26   end type
  27   abstract interface
  28     subroutine solver_advop(this)
  29       import solver_t
  30       class(solver_t) :: this
  31     end subroutine
  32   end interface
  33   contains
  34 end module
  35
  36 module solver_mpdata_m
  37   use solver_m
  38   type :: mpdata_t
  39     class(bcd_t), pointer :: bcx, bcy
  40     contains
  41     procedure :: advop => mpdata_advop
  42   end type
  43   contains
  44   subroutine mpdata_advop(this)
  45     class(mpdata_t) :: this
  46     associate ( bcx => this%bcx, bcy => this%bcy )
  47       call bcx%fill_halos()
  48     end associate
  49   end subroutine
  50 end module
  51
  52   use solver_mpdata_m
  53   class(mpdata_t), allocatable :: that
  54   call mpdata_advop (that)
  55 end
  56