1! { dg-do compile }
2! { dg-options "-std=legacy" }
3!
4! This tests various error messages for PROCEDURE declarations.
5! Contributed by Janus Weil <jaydub66@gmail.com>
6
7module m
8
9  abstract interface
10    subroutine sub()
11    end subroutine
12    subroutine sub2() bind(c)
13    end subroutine
14  end interface
15
16  procedure(), public, private :: a  ! { dg-error "was already specified" }
17  procedure(sub),bind(C) :: a2  ! { dg-error "requires an interface with BIND.C." }
18  procedure(sub2), public, bind(c, name="myEF") :: e, f  ! { dg-error "Multiple identifiers provided with single NAME= specifier" }
19  procedure(sub2), bind(C, name=""), pointer :: g  ! { dg-error "may not have POINTER attribute" }
20
21  public:: h
22  procedure(),public:: h  ! { dg-error "was already specified" }
23
24contains
25
26  subroutine abc
27    procedure() :: abc2
28  entry abc2(x)  ! { dg-error "PROCEDURE attribute conflicts with ENTRY attribute" }
29    real x
30  end subroutine
31
32end module m
33
34program prog
35
36  interface z
37    subroutine z1()
38    end subroutine
39    subroutine z2(a)
40      integer :: a
41    end subroutine
42  end interface
43
44  procedure(z) :: bar   ! { dg-error "may not be generic" }
45
46  procedure(), allocatable:: b  ! { dg-error "PROCEDURE attribute conflicts with ALLOCATABLE attribute" }
47  procedure(), save:: c  ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" }
48
49  procedure(dcos) :: my1
50  procedure(amax0) :: my2  ! { dg-error "not allowed in PROCEDURE statement" }
51
52  real f, x
53  f(x) = sin(x**2)
54  external oo
55
56  procedure(f) :: q  ! { dg-error "may not be a statement function" }
57  procedure(oo) :: p  ! { dg-error "must be explicit" }
58
59  procedure ( ) :: r
60  procedure ( up ) :: s  ! { dg-error "must be explicit" }
61
62  procedure(t) :: t  ! { dg-error "may not be used as its own interface" }
63
64  call s
65
66contains
67
68  subroutine foo(a,c)  ! { dg-error "PROCEDURE attribute conflicts with INTENT attribute" }
69    abstract interface
70      subroutine b() bind(C)
71      end subroutine b
72    end interface
73    procedure(b), bind(c,name="hjj") :: a  ! { dg-error "may not have BIND.C. attribute with NAME" }
74    procedure(b),intent(in):: c
75  end subroutine foo
76
77end program
78