mirror of
https://github.com/autc04/Retro68.git
synced 2024-06-28 11:30:19 +00:00
141 lines
4.9 KiB
Plaintext
141 lines
4.9 KiB
Plaintext
! { dg-do compile }
|
|
!
|
|
! Tests comparisons of MODULE PROCEDURE characteristics and
|
|
! the characteristics of their dummies. Also tests the error
|
|
! arising from redefining dummies and results in MODULE
|
|
! procedures.
|
|
!
|
|
! Contributed by Paul Thomas <pault@gcc.gnu.org>
|
|
!
|
|
module foo_interface
|
|
implicit none
|
|
type foo
|
|
character(len=16) :: greeting = "Hello, world! "
|
|
character(len=16), private :: byebye = "adieu, world! "
|
|
end type foo
|
|
|
|
interface
|
|
module function array1(this) result (that)
|
|
type(foo), intent(in), dimension(:) :: this
|
|
type(foo), allocatable, dimension(:) :: that
|
|
end function
|
|
character(16) module function array2(this, that)
|
|
type(foo), intent(in), dimension(:) :: this
|
|
type(foo), allocatable, dimension(:) :: that
|
|
end function
|
|
module subroutine array3(this, that)
|
|
type(foo), intent(in), dimension(:) :: this
|
|
type(foo), intent(inOUT), allocatable, dimension(:) :: that
|
|
end subroutine
|
|
module subroutine array4(this, that)
|
|
type(foo), intent(in), dimension(:) :: this
|
|
type(foo), intent(inOUT), allocatable, dimension(:) :: that
|
|
end subroutine
|
|
integer module function scalar1 (arg)
|
|
real, intent(in) :: arg
|
|
end function
|
|
module function scalar2 (arg) result(res)
|
|
real, intent(in) :: arg
|
|
real :: res
|
|
end function
|
|
module function scalar3 (arg) result(res)
|
|
real, intent(in) :: arg
|
|
real :: res
|
|
end function
|
|
module function scalar4 (arg) result(res)
|
|
real, intent(in) :: arg
|
|
complex :: res
|
|
end function
|
|
module function scalar5 (arg) result(res)
|
|
real, intent(in) :: arg
|
|
real, allocatable :: res
|
|
end function
|
|
module function scalar6 (arg) result(res)
|
|
real, intent(in) :: arg
|
|
real, allocatable :: res
|
|
end function
|
|
module function scalar7 (arg) result(res)
|
|
real, intent(in) :: arg
|
|
real, allocatable :: res
|
|
end function
|
|
end interface
|
|
end module
|
|
|
|
!
|
|
SUBMODULE (foo_interface) foo_interface_son
|
|
!
|
|
contains
|
|
|
|
module function array1 (this) result(that) ! { dg-error "Rank mismatch in function result" }
|
|
type(foo), intent(in), dimension(:) :: this
|
|
type(foo), allocatable :: that
|
|
end function
|
|
|
|
character(16) module function array2(this) ! { dg-error "Mismatch in number of MODULE PROCEDURE formal arguments" }
|
|
type(foo), intent(in), dimension(:) :: this
|
|
type(foo), allocatable, dimension(:) :: that
|
|
allocate (that(2), source = this(1))
|
|
that%greeting = that%byebye
|
|
array2 = trim (that(size (that))%greeting(1:5))//", people!"
|
|
end function
|
|
|
|
module subroutine array3(thiss, that) ! { dg-error "Mismatch in MODULE PROCEDURE formal argument names" }
|
|
type(foo), intent(in), dimension(:) :: thiss
|
|
type(foo), intent(inOUT), allocatable, dimension(:) :: that
|
|
allocate (that(size(thiss)), source = thiss)
|
|
that%greeting = that%byebye
|
|
end subroutine
|
|
|
|
module subroutine array4(this, that, the_other) ! { dg-error "Mismatch in number of MODULE PROCEDURE formal arguments" }
|
|
type(foo), intent(in), dimension(:) :: this
|
|
type(foo), intent(inOUT), allocatable, dimension(:) :: that, the_other
|
|
integer :: i
|
|
allocate (that(size(this)), source = this)
|
|
that%greeting = that%byebye
|
|
do i = 1, size (that)
|
|
that(i)%greeting = trim (that(i)%greeting(1:5))//", people!"
|
|
end do
|
|
end subroutine
|
|
|
|
recursive module function scalar1 (arg) ! { dg-error "Mismatch in RECURSIVE" }
|
|
real, intent(in) :: arg
|
|
end function
|
|
|
|
pure module function scalar2 (arg) result(res) ! { dg-error "Mismatch in PURE" }
|
|
real, intent(in) :: arg
|
|
real :: res
|
|
end function
|
|
|
|
module procedure scalar7
|
|
real, intent(in) :: arg ! { dg-error "redefinition of the declaration" }
|
|
real, allocatable :: res ! { dg-error "redefinition of the declaration" }
|
|
end function ! { dg-error "Expecting END PROCEDURE statement" }
|
|
end procedure ! This prevents a cascade of errors.
|
|
end SUBMODULE foo_interface_son
|
|
|
|
!
|
|
SUBMODULE (foo_interface) foo_interface_daughter
|
|
!
|
|
contains
|
|
|
|
module function scalar3 (arg) result(res) ! { dg-error "Type mismatch in argument" }
|
|
integer, intent(in) :: arg
|
|
real :: res
|
|
end function
|
|
|
|
module function scalar4 (arg) result(res) ! { dg-error "Type mismatch in function result" }
|
|
real, intent(in) :: arg
|
|
real :: res
|
|
end function
|
|
|
|
module function scalar5 (arg) result(res) ! { dg-error "ALLOCATABLE attribute mismatch in function result " }
|
|
real, intent(in) :: arg
|
|
real :: res
|
|
end function
|
|
|
|
module function scalar6 (arg) result(res) ! { dg-error "Rank mismatch in argument" }
|
|
real, intent(in), dimension(2) :: arg
|
|
real, allocatable :: res
|
|
end function
|
|
end SUBMODULE foo_interface_daughter
|