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,6 +355,12 @@ 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, @@ -432,6 +438,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,48 @@ -! 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. 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 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