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