1! RUN: %S/test_errors.sh %s %t %flang_fc1
2! REQUIRES: shell
3! C739 If END TYPE is followed by a type-name, the type-name shall be the
4! same as that in the corresponding derived-type-stmt.
5! C1401 The program-name shall not be included in the end-program-stmt unless
6! the optional program-stmt is used. If included, it shall be identical to the
7! program-name specified in the program-stmt.
8! C1402 If the module-name is specified in the end-module-stmt, it shall be
9! identical to the module-name specified in the module-stmt.
10! C1413 If a submodule-name appears in the end-submodule-stmt, it shall be
11! identical to the one in the submodule-stmt.
12! C1414 If a function-name appears in the end-function-stmt, it shall be
13! identical to the function-name specified in the function-stmt.
14! C1502 If the end-interface-stmt includes a generic-spec, the interface-stmt
15! shall specify the same generic-spec
16! C1564 If a function-name appears in the end-function-stmt, it shall be
17! identical to the function-name specified in the function-stmt.
18! C1567 If a submodule-name appears in the end-submodule-stmt, it shall be
19! identical to the one in the submodule-stmt.
20! C1569 If the module-name is specified in the end-module-stmt, it shall be
21! identical to the module-name specified in the module-stmt
22
23block data t1
24!ERROR: BLOCK DATA subprogram name mismatch
25end block data t2
26
27function t3
28!ERROR: FUNCTION name mismatch
29end function t4
30
31subroutine t9
32!ERROR: SUBROUTINE name mismatch
33end subroutine t10
34
35program t13
36!ERROR: END PROGRAM name mismatch
37end program t14
38
39submodule (mod) t15
40!ERROR: SUBMODULE name mismatch
41end submodule t16
42
43module t5
44  interface t7
45  !ERROR: INTERFACE generic-name (t7) mismatch
46  end interface t8
47  type t17
48  !ERROR: derived type definition name mismatch
49  end type t18
50
51  abstract interface
52    subroutine subrFront()
53    !ERROR: SUBROUTINE name mismatch
54    end subroutine subrBack
55    function funcFront(x)
56      real, intent(in) :: x
57      real funcFront
58    !ERROR: FUNCTION name mismatch
59    end function funcBack
60  end interface
61
62contains
63  module procedure t11
64  !ERROR: MODULE PROCEDURE name mismatch
65  end procedure t12
66!ERROR: MODULE name mismatch
67end module mox
68