1! { dg-do compile }
2!
3! Checks that PRIVATE/PUBLIC not allowed in submodules. Also, IMPORT
4! is not allowed in a module procedure interface body.
5!
6! Contributed by Paul Thomas  <pault@gcc.gnu.org>
7!
8module foo_interface
9  implicit none
10  type foo
11    character(len=16), private :: byebye = "adieu, world!   "
12  end type foo
13
14! This interface is required to trigger the output of an .smod file.
15! See http://j3-fortran.org/doc/meeting/207/15-209.txt
16  interface
17    integer module function trigger_smod ()
18    end function
19  end interface
20
21end module
22
23module foo_interface_brother
24  use foo_interface
25  implicit none
26  interface
27     module subroutine array3(this, that)
28       import ! { dg-error "not permitted in a module procedure interface body" }
29       type(foo), intent(in), dimension(:) :: this
30       type(foo), intent(inOUT), allocatable, dimension(:) :: that
31     end subroutine
32  end interface
33end module
34
35SUBMODULE (foo_interface) foo_interface_son
36  private ! { dg-error "PRIVATE statement" }
37  public ! { dg-error "PUBLIC statement" }
38  integer, public :: i ! { dg-error "PUBLIC attribute" }
39  integer, private :: j ! { dg-error "PRIVATE attribute" }
40  type :: bar
41    private ! { dg-error "PRIVATE statement" }
42    public ! { dg-error "PUBLIC statement" }
43    integer, private :: i ! { dg-error "PRIVATE attribute" }
44    integer, public :: j ! { dg-error "PUBLIC attribute" }
45  end type bar
46contains
47!
48end submodule foo_interface_son
49
50SUBMODULE (foo_interface) foo_interface_daughter
51!
52contains
53  subroutine foobar (arg)
54    type(foo) :: arg
55    arg%byebye = "hello, world!   " ! Access to private component is OK
56  end subroutine
57end SUBMODULE foo_interface_daughter
58
59end
60