gcc/testsuite/gfortran.dg/pdt_36.f03

   1 ! { dg-do run }
   2 !
   3 ! Tests the fixes for PR82943.
   4 !
   5 ! This test focuses on calling the type bound procedures in a program.
   6 !
   7 ! Contributed by Alexander Westbrooks  <ctechnodev@gmail.com>
   8 !
   9 module testmod
  10
  11    public :: foo
  12
  13    type, public :: tough_lvl_0(a, b)
  14        integer, kind :: a = 1
  15        integer, len :: b
  16    contains
  17        procedure :: foo
  18    end type
  19
  20    type, public, EXTENDS(tough_lvl_0) :: tough_lvl_1 (c)
  21        integer, len :: c
  22    contains
  23        procedure :: bar
  24    end type
  25
  26    type, public, EXTENDS(tough_lvl_1) :: tough_lvl_2 (d)
  27        integer, len :: d
  28    contains
  29        procedure :: foobar
  30    end type
  31
  32 contains
  33    subroutine foo(this)
  34        class(tough_lvl_0(1,*)), intent(inout) :: this
  35    end subroutine
  36
  37    subroutine bar(this)
  38        class(tough_lvl_1(1,*,*)), intent(inout) :: this
  39    end subroutine
  40
  41    subroutine foobar(this)
  42        class(tough_lvl_2(1,*,*,*)), intent(inout) :: this
  43    end subroutine
  44
  45 end module
  46
  47 PROGRAM testprogram
  48    USE testmod
  49
  50    TYPE(tough_lvl_0(1,5))     :: test_pdt_0
  51    TYPE(tough_lvl_1(1,5,6))   :: test_pdt_1
  52    TYPE(tough_lvl_2(1,5,6,7)) :: test_pdt_2
  53
  54    CALL test_pdt_0%foo()
  55
  56    CALL test_pdt_1%foo()
  57    CALL test_pdt_1%bar()
  58
  59    CALL test_pdt_2%foo()
  60    CALL test_pdt_2%bar()
  61    CALL test_pdt_2%foobar()
  62
  63
  64 END PROGRAM testprogram
  65