diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 31e246cf0ab03..7de29fc120851 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -472,6 +472,10 @@ void CheckHelper::Check(const Symbol &symbol) { messages_.Say( "A function result may not also be a named constant"_err_en_US); } + if (!IsProcedurePointer(symbol) && IsProcedure(symbol)) { + messages_.Say( + "A function result may not be a procedure unless it is a procedure pointer"_err_en_US); + } } if (IsAutomatic(symbol)) { if (const Symbol * common{FindCommonBlockContaining(symbol)}) { diff --git a/flang/test/Semantics/func-proc-result.f90 b/flang/test/Semantics/func-proc-result.f90 new file mode 100644 index 0000000000000..5bf8ac9c4ddea --- /dev/null +++ b/flang/test/Semantics/func-proc-result.f90 @@ -0,0 +1,18 @@ +!RUN: %python %S/test_errors.py %s %flang_fc1 + +function good() result(pptr) + procedure(), pointer :: pptr + external whatever + pptr => whatever +end + +function bad1() result(res1) + !ERROR: A function result may not be a procedure unless it is a procedure pointer + procedure() res1 +end + +!ERROR: Procedure 'res2' is referenced before being sufficiently defined in a context where it must be so +function bad2() result(res2) + !ERROR: EXTERNAL attribute not allowed on 'res2' + external res2 +end