diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -970,6 +970,11 @@ } } } + if (details.isInterface() && !details.isDummy() && details.isFunction() && + IsAssumedLengthCharacter(details.result())) { // C721 + messages_.Say(details.result().name(), + "A function interface may not declare an assumed-length CHARACTER(*) result"_err_en_US); + } } void CheckHelper::CheckDerivedType( @@ -1297,6 +1302,12 @@ } else if (!proc.functionResult.has_value()) { msg = "%s procedure '%s' must be a function"_err_en_US; } else if (proc.functionResult->IsAssumedLengthCharacter()) { + const auto *subpDetails{specific.detailsIf()}; + if (subpDetails && !subpDetails->isDummy() && subpDetails->isInterface()) { + // Error is caught by more general test for interfaces with + // assumed-length character function results + return true; + } msg = "%s function '%s' may not have assumed-length CHARACTER(*)" " result"_err_en_US; } else if (auto m{CheckNumberOfArgs(kind, proc.dummyArguments.size())}) { diff --git a/flang/test/Semantics/call01.f90 b/flang/test/Semantics/call01.f90 --- a/flang/test/Semantics/call01.f90 +++ b/flang/test/Semantics/call01.f90 @@ -126,6 +126,7 @@ interface character*(*) function f2() end function + !ERROR: A function interface may not declare an assumed-length CHARACTER(*) result character*(*) function f4() end function end interface @@ -133,8 +134,6 @@ print *, f2() !ERROR: Assumed-length character function must be defined with a length to be called print *, f3() - !ERROR: Assumed-length character function must be defined with a length to be called - print *, f4() print *, fp1() print *, fp2() end subroutine diff --git a/flang/test/Semantics/resolve67.f90 b/flang/test/Semantics/resolve67.f90 --- a/flang/test/Semantics/resolve67.f90 +++ b/flang/test/Semantics/resolve67.f90 @@ -35,7 +35,7 @@ module m3 interface operator(/) - !ERROR: OPERATOR(/) function 'divide' may not have assumed-length CHARACTER(*) result + !ERROR: A function interface may not declare an assumed-length CHARACTER(*) result character(*) function divide(x, y) character(*), intent(in) :: x, y end @@ -57,6 +57,23 @@ end interface end end interface + contains + subroutine s(alcf1, alcf2) + interface + character(*) function alcf1(x, y) + character(*), intent(in) :: x, y + end function + character(*) function alcf2(x, y) + character(*), intent(in) :: x, y + end function + end interface + interface operator(+) + !ERROR: OPERATOR(+) function 'alcf1' may not have assumed-length CHARACTER(*) result + procedure alcf1 + end interface + !ERROR: OPERATOR(-) function 'alcf2' may not have assumed-length CHARACTER(*) result + generic :: operator(-) => alcf2 + end subroutine end module m4