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 @@ -83,7 +83,7 @@ const SourceName &, const Symbol &, const Procedure &, std::size_t); bool CheckDefinedAssignment(const Symbol &, const Procedure &); bool CheckDefinedAssignmentArg(const Symbol &, const DummyArgument &, int); - void CheckSpecificsAreDistinguishable(const Symbol &, const GenericDetails &); + void CheckSpecifics(const Symbol &, const GenericDetails &); void CheckEquivalenceSet(const EquivalenceSet &); void CheckBlockData(const Scope &); void CheckGenericOps(const Scope &); @@ -1346,7 +1346,7 @@ void CheckHelper::CheckGeneric( const Symbol &symbol, const GenericDetails &details) { - CheckSpecificsAreDistinguishable(symbol, details); + CheckSpecifics(symbol, details); common::visit(common::visitors{ [&](const GenericKind::DefinedIo &io) { CheckDefinedIoProc(symbol, details, io); @@ -1369,7 +1369,7 @@ } // Check that the specifics of this generic are distinguishable from each other -void CheckHelper::CheckSpecificsAreDistinguishable( +void CheckHelper::CheckSpecifics( const Symbol &generic, const GenericDetails &details) { GenericKind kind{details.kind()}; DistinguishabilityHelper helper{context_}; @@ -1381,6 +1381,23 @@ msg->Attach( specific.name(), "Definition of '%s'"_en_US, specific.name()); } + continue; + } + if (specific.attrs().test(Attr::INTRINSIC)) { + if (auto *msg{messages_.Say(specific.name(), + "Specific procedure '%s' of generic interface '%s' may not be INTRINSIC"_err_en_US, + specific.name(), generic.name())}) { + msg->Attach(generic.name(), "Definition of '%s'"_en_US, generic.name()); + } + continue; + } + if (IsStmtFunction(specific)) { + if (auto *msg{messages_.Say(specific.name(), + "Specific procedure '%s' of generic interface '%s' may not be a statement function"_err_en_US, + specific.name(), generic.name())}) { + msg->Attach(generic.name(), "Definition of '%s'"_en_US, generic.name()); + } + continue; } if (const Procedure *procedure{Characterize(specific)}) { if (procedure->HasExplicitInterface()) { diff --git a/flang/test/Semantics/generic06.f90 b/flang/test/Semantics/generic06.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/generic06.f90 @@ -0,0 +1,20 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +module m + !ERROR: Specific procedure 'sin' of generic interface 'yintercept' may not be INTRINSIC + intrinsic sin + interface yIntercept + procedure sin + end interface + !ERROR: Specific procedure 'cos' of generic interface 'xintercept' may not be INTRINSIC + intrinsic cos + generic :: xIntercept => cos +end module + +subroutine foo + interface slope + procedure tan + end interface + !ERROR: Specific procedure 'tan' of generic interface 'slope' may not be a statement function + tan(x) = sin(x) / cos(x) +end subroutine +