diff --git a/flang/lib/Semantics/resolve-labels.cpp b/flang/lib/Semantics/resolve-labels.cpp --- a/flang/lib/Semantics/resolve-labels.cpp +++ b/flang/lib/Semantics/resolve-labels.cpp @@ -355,12 +355,20 @@ std::get>(blockData.t)); } + // C1564 + void Post(const parser::InterfaceBody::Function &func) { + CheckOptionalName("FUNCTION", func, + std::get>(func.t)); + } + // C1564 void Post(const parser::FunctionSubprogram &functionSubprogram) { CheckOptionalName("FUNCTION", functionSubprogram, std::get>( functionSubprogram.t)); } + + // C1502 void Post(const parser::InterfaceBlock &interfaceBlock) { auto &interfaceStmt{ std::get>(interfaceBlock.t)}; @@ -381,7 +389,7 @@ context_ .Say(currentPosition_, parser::MessageFormattedText{ - "INTERFACE generic-name (%s) mismatch"_en_US, + "INTERFACE generic-name (%s) mismatch"_err_en_US, namePointer->source}) .Attach(interfaceStmt.source, "mismatched INTERFACE"_en_US); } @@ -432,6 +440,12 @@ std::get>(submodule.t)); } + // C1567 + void Post(const parser::InterfaceBody::Subroutine &sub) { + CheckOptionalName("SUBROUTINE", sub, + std::get>(sub.t)); + } + // C1567 void Post(const parser::SubroutineSubprogram &subroutineSubprogram) { CheckOptionalName("SUBROUTINE", diff --git a/flang/test/Semantics/label11.f90 b/flang/test/Semantics/label11.f90 --- a/flang/test/Semantics/label11.f90 +++ b/flang/test/Semantics/label11.f90 @@ -1,39 +1,66 @@ -! RUN: not %f18 -funparse-with-symbols %s 2>&1 | FileCheck %s -! CHECK: BLOCK DATA subprogram name mismatch -! CHECK: should be -! CHECK: FUNCTION name mismatch -! CHECK: SUBROUTINE name mismatch -! CHECK: PROGRAM name mismatch -! CHECK: SUBMODULE name mismatch -! CHECK: INTERFACE generic-name (t7) mismatch -! CHECK: mismatched INTERFACE -! CHECK: derived type definition name mismatch -! CHECK: MODULE PROCEDURE name mismatch -! CHECK: MODULE name mismatch +! RUN: %S/test_errors.sh %s %t %f18 ! C739 If END TYPE is followed by a type-name, the type-name shall be the ! same as that in the corresponding derived-type-stmt. +! C1401 The program-name shall not be included in the end-program-stmt unless +! the optional program-stmt is used. If included, it shall be identical to the +! program-name specified in the program-stmt. +! C1402 If the module-name is specified in the end-module-stmt, it shall be +! identical to the module-name specified in the module-stmt. +! C1413 If a submodule-name appears in the end-submodule-stmt, it shall be +! identical to the one in the submodule-stmt. +! C1414 If a function-name appears in the end-function-stmt, it shall be +! identical to the function-name specified in the function-stmt. +! C1502 If the end-interface-stmt includes a generic-spec, the interface-stmt +! shall specify the same generic-spec +! C1564 If a function-name appears in the end-function-stmt, it shall be +! identical to the function-name specified in the function-stmt. +! C1567 If a submodule-name appears in the end-submodule-stmt, it shall be +! identical to the one in the submodule-stmt. +! C1569 If the module-name is specified in the end-module-stmt, it shall be +! identical to the module-name specified in the module-stmt block data t1 +!ERROR: BLOCK DATA subprogram name mismatch end block data t2 function t3 +!ERROR: FUNCTION name mismatch end function t4 subroutine t9 +!ERROR: SUBROUTINE name mismatch end subroutine t10 program t13 +!ERROR: END PROGRAM name mismatch end program t14 submodule (mod) t15 +!ERROR: SUBMODULE name mismatch end submodule t16 module t5 interface t7 + !ERROR: INTERFACE generic-name (t7) mismatch end interface t8 type t17 + !ERROR: derived type definition name mismatch end type t18 + + abstract interface + subroutine subrFront() + !ERROR: SUBROUTINE name mismatch + end subroutine subrBack + function funcFront(x) + real, intent(in) :: x + real funcFront + !ERROR: FUNCTION name mismatch + end function funcBack + end interface + contains module procedure t11 + !ERROR: MODULE PROCEDURE name mismatch end procedure t12 +!ERROR: MODULE name mismatch end module mox