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