1! { dg-do compile }
2!
3! Fix PR55763
4! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
5!
6module mpi_f08_f
7  implicit none
8  abstract interface
9    subroutine user_function( inoutvec )
10      class(*), dimension(:), intent(inout) :: inoutvec
11    end subroutine user_function
12  end interface
13end module
14
15module mod_test1
16  use mpi_f08_f
17  implicit none
18contains
19  subroutine my_function( invec )   ! { dg-error "no IMPLICIT type" }
20    class(*), dimension(:), intent(inout) :: inoutvec    ! { dg-error "not a DUMMY" }
21
22    select type (inoutvec)
23    type is (integer)
24         inoutvec = 2*inoutvec
25    end select
26  end subroutine my_function
27end module
28
29module mod_test2
30  use mpi_f08_f
31  implicit none
32contains
33  subroutine my_function( inoutvec )  ! Used to produce a BOGUS ERROR
34    class(*), dimension(:), intent(inout) :: inoutvec
35
36    select type (inoutvec)
37    type is (integer)
38         inoutvec = 2*inoutvec
39    end select
40  end subroutine my_function
41end module
42