gcc/testsuite/gfortran.dg/submodule_4.f90

   1 ! { dg-do compile }
   2 !
   3 ! Tests comparisons of MODULE PROCEDURE characteristics and
   4 ! the characteristics of their dummies. Also tests the error
   5 ! arising from redefining dummies and results in MODULE
   6 ! procedures.
   7 !
   8 ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
   9 !
  10  module foo_interface
  11    implicit none
  12    type foo
  13      character(len=16) :: greeting = "Hello, world!   "
  14      character(len=16), private :: byebye = "adieu, world!   "
  15    end type foo
  16
  17    interface
  18      module function array1(this) result (that)
  19        type(foo), intent(in), dimension(:) :: this
  20        type(foo), allocatable, dimension(:) :: that
  21      end function
  22      character(16) module function array2(this, that)
  23        type(foo), intent(in), dimension(:) :: this
  24        type(foo), allocatable, dimension(:) :: that
  25      end function
  26      module subroutine array3(this, that)
  27        type(foo), intent(in), dimension(:) :: this
  28        type(foo), intent(inOUT), allocatable, dimension(:) :: that
  29      end subroutine
  30      module subroutine array4(this, that)
  31        type(foo), intent(in), dimension(:) :: this
  32        type(foo), intent(inOUT), allocatable, dimension(:) :: that
  33      end subroutine
  34      integer module function scalar1 (arg)
  35         real, intent(in) :: arg
  36      end function
  37      module function scalar2 (arg) result(res)
  38         real, intent(in) :: arg
  39         real :: res
  40      end function
  41       module function scalar3 (arg) result(res)
  42         real, intent(in) :: arg
  43         real :: res
  44      end function
  45       module function scalar4 (arg) result(res)
  46         real, intent(in) :: arg
  47         complex :: res
  48      end function
  49       module function scalar5 (arg) result(res)
  50         real, intent(in) :: arg
  51         real, allocatable :: res
  52      end function
  53       module function scalar6 (arg) result(res)
  54         real, intent(in) :: arg
  55         real, allocatable :: res
  56      end function
  57       module function scalar7 (arg) result(res)
  58         real, intent(in) :: arg
  59         real, allocatable :: res
  60      end function
  61    end interface
  62  end module
  63
  64 !
  65   SUBMODULE (foo_interface) foo_interface_son
  66 !
  67   contains
  68
  69      module function array1 (this) result(that) ! { dg-error "Rank mismatch in function result" }
  70        type(foo), intent(in), dimension(:) :: this
  71        type(foo), allocatable :: that
  72      end function
  73
  74      character(16) module function array2(this) ! { dg-error "Mismatch in number of MODULE PROCEDURE formal arguments" }
  75        type(foo), intent(in), dimension(:) :: this
  76        type(foo), allocatable, dimension(:) :: that
  77        allocate (that(2), source = this(1))
  78        that%greeting = that%byebye
  79        array2 = trim (that(size (that))%greeting(1:5))//", people!"
  80      end function
  81
  82      module subroutine array3(thiss, that) ! { dg-error "Mismatch in MODULE PROCEDURE formal argument names" }
  83        type(foo), intent(in), dimension(:) :: thiss
  84        type(foo), intent(inOUT), allocatable, dimension(:) :: that
  85        allocate (that(size(thiss)), source = thiss)
  86        that%greeting = that%byebye
  87      end subroutine
  88
  89      module subroutine array4(this, that, the_other) ! { dg-error "Mismatch in number of MODULE PROCEDURE formal arguments" }
  90        type(foo), intent(in), dimension(:) :: this
  91        type(foo), intent(inOUT), allocatable, dimension(:) :: that, the_other
  92        integer :: i
  93        allocate (that(size(this)), source = this)
  94        that%greeting = that%byebye
  95        do i = 1, size (that)
  96          that(i)%greeting = trim (that(i)%greeting(1:5))//", people!"
  97        end do
  98      end subroutine
  99
 100      recursive module function scalar1 (arg) ! { dg-error "Mismatch in RECURSIVE" }
 101         real, intent(in) :: arg
 102      end function
 103
 104      pure module function scalar2 (arg) result(res) ! { dg-error "Mismatch in PURE" }
 105         real, intent(in) :: arg
 106         real :: res
 107      end function
 108
 109      module procedure scalar7
 110        real, intent(in) :: arg ! { dg-error "redefinition of the declaration" }
 111        real, allocatable :: res ! { dg-error "redefinition of the declaration" }
 112      end function ! { dg-error "Expecting END PROCEDURE statement" }
 113      end procedure ! This prevents a cascade of errors.
 114   end SUBMODULE foo_interface_son
 115
 116 !
 117   SUBMODULE (foo_interface) foo_interface_daughter
 118 !
 119   contains
 120
 121       module function scalar3 (arg) result(res) ! { dg-error "Type mismatch in argument" }
 122         integer, intent(in) :: arg
 123         real :: res
 124      end function
 125
 126       module function scalar4 (arg) result(res) ! { dg-error "Type mismatch in function result" }
 127         real, intent(in) :: arg
 128         real :: res
 129      end function
 130
 131       module function scalar5 (arg) result(res) ! { dg-error "ALLOCATABLE attribute mismatch in function result " }
 132         real, intent(in) :: arg
 133         real :: res
 134      end function
 135
 136       module function scalar6 (arg) result(res) ! { dg-error "Rank mismatch in argument" }
 137         real, intent(in), dimension(2) :: arg
 138         real, allocatable :: res
 139      end function
 140   end SUBMODULE foo_interface_daughter