1! RUN: %S/test_errors.sh %s %t %f18
2module m
3!C778 The same binding-attr shall not appear more than once in a given
4!binding-attr-list.
5!
6!R749 type-bound-procedure-stmt
7!  PROCEDURE [ [ ,binding-attr-list] :: ]type-bound-proc-decl-list
8!  or PROCEDURE (interface-name),binding-attr-list::binding-name-list
9!
10!
11!  binding-attr values are:
12!    PUBLIC, PRIVATE, DEFERRED, NON_OVERRIDABLE, NOPASS, PASS [ (arg-name) ]
13!
14  type, abstract :: boundProcType
15   contains
16    !WARNING: Attribute 'PUBLIC' cannot be used more than once
17    procedure(subPublic), public, deferred, public :: publicBinding
18    !WARNING: Attribute 'PRIVATE' cannot be used more than once
19    procedure(subPrivate), private, deferred, private :: privateBinding
20    !WARNING: Attribute 'DEFERRED' cannot be used more than once
21    procedure(subDeferred), deferred, public, deferred :: deferredBinding
22    !WARNING: Attribute 'NON_OVERRIDABLE' cannot be used more than once
23    procedure, non_overridable, public, non_overridable :: subNon_overridable;
24    !WARNING: Attribute 'NOPASS' cannot be used more than once
25    procedure(subNopass), nopass, deferred, nopass :: nopassBinding
26    !WARNING: Attribute 'PASS' cannot be used more than once
27    procedure(subPass), pass, deferred, pass :: passBinding
28    !ERROR: Attributes 'PASS' and 'NOPASS' conflict with each other
29    procedure(subPassNopass), pass, deferred, nopass :: passNopassBinding
30  end type boundProcType
31
32contains
33    subroutine subPublic(x)
34      class(boundProcType), intent(in) :: x
35    end subroutine subPublic
36
37    subroutine subPrivate(x)
38      class(boundProcType), intent(in) :: x
39    end subroutine subPrivate
40
41    subroutine subDeferred(x)
42      class(boundProcType), intent(in) :: x
43    end subroutine subDeferred
44
45    subroutine subNon_overridable(x)
46      class(boundProcType), intent(in) :: x
47    end subroutine subNon_overridable
48
49    subroutine subNopass(x)
50      class(boundProcType), intent(in) :: x
51    end subroutine subNopass
52
53    subroutine subPass(x)
54      class(boundProcType), intent(in) :: x
55    end subroutine subPass
56
57    subroutine subPassNopass(x)
58      class(boundProcType), intent(in) :: x
59    end subroutine subPassNopass
60
61end module m
62