mirrors/llvm-project
0
0
Fork 0
mirror of https://github.com/llvm/llvm-project.git synced 2025-04-16 14:46:36 +00:00
Code Issues Projects Releases Wiki Activity

[flang] Soften interoperability error when standard allows (#115092)

Browse Source 
The standard doesn't require that an interoperable procedure's dummy
arguments have interoperable derived types in some cases. Although
nearly all extant Fortran compilers emit errors, some don't, and things
should work; so reduce the current fatal error message to an optional
portability warning.

Fixes https://github.com/llvm/llvm-project/issues/115010.
This commit is contained in:
Peter Klausler 2024-11-14 14:56:44 -08:00 committed by GitHub
parent aa68dd5783
commit b3026bab91
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
3 changed files with 29 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
flang/include/flang/Evaluate/tools.h
View File

@ -1103,8 +1103,7 @@ extern template semantics::UnorderedSymbolSet CollectCudaSymbols(
bool HasVectorSubscript(const Expr<SomeType> &);
// Utilities for attaching the location of the declaration of a symbol
// of interest to a message, if both pointers are non-null. Handles
// the case of USE association gracefully.
// of interest to a message. Handles the case of USE association gracefully.
parser::Message *AttachDeclaration(parser::Message &, const Symbol &);
parser::Message *AttachDeclaration(parser::Message *, const Symbol &);
template <typename MESSAGES, typename... A>

23
flang/lib/Semantics/check-declarations.cpp
View File

@ -147,7 +147,8 @@ private:
void CheckProcedureAssemblyName(const Symbol &symbol);
void CheckExplicitSave(const Symbol &);
parser::Messages WhyNotInteroperableDerivedType(const Symbol &);
parser::Messages WhyNotInteroperableObject(const Symbol &);
parser::Messages WhyNotInteroperableObject(
const Symbol &, bool allowNonInteroperableType = false);
parser::Messages WhyNotInteroperableFunctionResult(const Symbol &);
parser::Messages WhyNotInteroperableProcedure(const Symbol &, bool isError);
void CheckBindC(const Symbol &);
@ -3001,7 +3002,8 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
return msgs;
}
parser::Messages CheckHelper::WhyNotInteroperableObject(const Symbol &symbol) {
parser::Messages CheckHelper::WhyNotInteroperableObject(
const Symbol &symbol, bool allowNonInteroperableType) {
parser::Messages msgs;
if (examinedByWhyNotInteroperable_.find(symbol) !=
examinedByWhyNotInteroperable_.end()) {
@ -3037,8 +3039,13 @@ parser::Messages CheckHelper::WhyNotInteroperableObject(const Symbol &symbol) {
if (const auto *type{symbol.GetType()}) {
const auto *derived{type->AsDerived()};
if (derived && !derived->typeSymbol().attrs().test(Attr::BIND_C)) {
if (!context_.IsEnabled(
common::LanguageFeature::NonBindCInteroperability)) {
if (allowNonInteroperableType) { // portability warning only
evaluate::AttachDeclaration(
context_.Warn(common::UsageWarning::Portability, symbol.name(),
"The derived type of this interoperable object should be BIND(C)"_port_en_US),
derived->typeSymbol());
} else if (!context_.IsEnabled(
common::LanguageFeature::NonBindCInteroperability)) {
msgs.Say(symbol.name(),
"The derived type of an interoperable object must be BIND(C)"_err_en_US)
.Attach(derived->typeSymbol().name(), "Non-BIND(C) type"_en_US);
@ -3178,7 +3185,13 @@ parser::Messages CheckHelper::WhyNotInteroperableProcedure(
"A dummy procedure of an interoperable procedure should be BIND(C)"_warn_en_US);
}
} else if (dummy->has<ObjectEntityDetails>()) {
dummyMsgs = WhyNotInteroperableObject(*dummy);
// Emit only optional portability warnings for non-interoperable
// types when the dummy argument is not VALUE and will be implemented
// on the C side by either a cdesc_t * or a void *. F'2023 18.3.7 (5)
bool allowNonInteroperableType{!dummy->attrs().test(Attr::VALUE) &&
(IsDescriptor(*dummy) || IsAssumedType(*dummy))};
dummyMsgs =
WhyNotInteroperableObject(*dummy, allowNonInteroperableType);
} else {
CheckBindC(*dummy);
}

10
flang/test/Semantics/bind-c17.f90 Normal file
View File

@ -0,0 +1,10 @@
! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror
module m
type a ! not BIND(C)
end type
contains
subroutine sub(x) bind(c)
!PORTABILITY: The derived type of this interoperable object should be BIND(C)
type(a), pointer, intent(in) :: x
end
end