gcc/testsuite/gfortran.dg/proc_ptr_50.f90

   1 ! { dg-do compile }
   2 !
   3 ! Test the fix for PR86242, in which the procedure pointer in 'tester'
   4 ! was being copied as if it were an allocatable class component.
   5 !
   6 ! Contributed by <cfd@mnet-mail.de>
   7 !
   8 module test
   9
  10    implicit none
  11
  12    private
  13    public :: tester
  14
  15    type :: wrapper
  16       integer(4) :: n
  17    end type wrapper
  18
  19    type :: output
  20       real(8) :: dummy
  21    end type output
  22
  23    type :: tester
  24       class(wrapper),  allocatable :: wrap
  25       procedure(proc1), pointer :: ptr => null()
  26    end type tester
  27
  28    abstract interface
  29       function proc1(self) result(uc)
  30          import :: tester, output
  31          class(tester), intent(in) :: self
  32          class(output), allocatable :: uc
  33       end function proc1
  34    end interface
  35
  36 end module test
  37
  38 ! Comment #2 from Janus Weil  <janus@gcc.gnu.org>
  39 module test1
  40
  41    implicit none
  42
  43    type :: output
  44    end type
  45
  46    type :: tester
  47       integer,  allocatable :: wrap
  48       procedure(proc1), pointer, nopass :: ptr
  49    end type
  50
  51    interface                              ! Originally abstract
  52       function proc1() result(uc)
  53          import :: output
  54          class(output), allocatable :: uc ! Works if a pointer
  55       end function
  56    end interface
  57
  58 ! PR82969 from Gerhard Steinmetz  <gscfq@t-online.de>
  59    type t
  60       real, allocatable :: x(:)
  61       procedure(f), nopass, pointer :: g
  62    end type
  63 contains
  64    function f() result(z)
  65       class(t), allocatable :: z
  66    end
  67
  68 end module test1