From ce392471c0d9cb3ef88d05fcbcff59de8ea0c1e1 Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Tue, 10 Sep 2024 14:08:55 -0700 Subject: [PATCH] [flang] Silence spurious error on non-CUDA use of CUDA module (#107444) When a module file has been compiled with CUDA enabled, don't emit spurious errors about non-interoperable types when that module is read by a USE statement in a later non-CUDA compilation. --- flang/include/flang/Semantics/type.h | 3 --- flang/lib/Evaluate/type.cpp | 4 ++-- flang/lib/Semantics/check-declarations.cpp | 21 +++++++++++++-------- flang/lib/Semantics/expression.cpp | 4 ++-- flang/lib/Semantics/type.cpp | 9 --------- flang/test/Semantics/Inputs/modfile66.cuf | 4 ++++ flang/test/Semantics/modfile66.f90 | 3 +++ 7 files changed, 24 insertions(+), 24 deletions(-) create mode 100644 flang/test/Semantics/Inputs/modfile66.cuf create mode 100644 flang/test/Semantics/modfile66.f90 diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h index 04f8b11e992a..e2d47d38f927 100644 --- a/flang/include/flang/Semantics/type.h +++ b/flang/include/flang/Semantics/type.h @@ -459,8 +459,5 @@ inline const DerivedTypeSpec *DeclTypeSpec::AsDerived() const { return const_cast(this)->AsDerived(); } -std::optional IsInteroperableIntrinsicType( - const DeclTypeSpec &, const common::LanguageFeatureControl &); - } // namespace Fortran::semantics #endif // FORTRAN_SEMANTICS_TYPE_H_ diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp index 5ecc3701b4f2..a1df40667471 100644 --- a/flang/lib/Evaluate/type.cpp +++ b/flang/lib/Evaluate/type.cpp @@ -820,8 +820,8 @@ std::optional IsInteroperableIntrinsicType(const DynamicType &type, return true; case TypeCategory::Real: case TypeCategory::Complex: - return (features && features->IsEnabled(common::LanguageFeature::CUDA)) || - type.kind() >= 4; // no short or half floats + return type.kind() >= 4 /* not a short or half float */ || !features || + features->IsEnabled(common::LanguageFeature::CUDA); case TypeCategory::Logical: return type.kind() == 1; // C_BOOL case TypeCategory::Character: diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 734c34276b13..c896ee7d2938 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -3003,17 +3003,17 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType( } else { msgs.Annex(std::move(bad)); } - } else if (!IsInteroperableIntrinsicType( - *type, context_.languageFeatures()) + } else if (auto dyType{evaluate::DynamicType::From(*type)}; dyType && + !evaluate::IsInteroperableIntrinsicType( + *dyType, &context_.languageFeatures()) .value_or(false)) { - auto maybeDyType{evaluate::DynamicType::From(*type)}; if (type->category() == DeclTypeSpec::Logical) { if (context_.ShouldWarn(common::UsageWarning::LogicalVsCBool)) { msgs.Say(component.name(), "A LOGICAL component of an interoperable type should have the interoperable KIND=C_BOOL"_port_en_US); } - } else if (type->category() == DeclTypeSpec::Character && - maybeDyType && maybeDyType->kind() == 1) { + } else if (type->category() == DeclTypeSpec::Character && dyType && + dyType->kind() == 1) { if (context_.ShouldWarn(common::UsageWarning::BindCCharLength)) { msgs.Say(component.name(), "A CHARACTER component of an interoperable type should have length 1"_port_en_US); @@ -3106,10 +3106,15 @@ parser::Messages CheckHelper::WhyNotInteroperableObject(const Symbol &symbol) { type->category() == DeclTypeSpec::Character && type->characterTypeSpec().length().isDeferred()) { // ok; F'2023 18.3.7 p2(6) - } else if (derived || - IsInteroperableIntrinsicType(*type, context_.languageFeatures()) - .value_or(false)) { + } else if (derived) { // type has been checked + } else if (auto dyType{evaluate::DynamicType::From(*type)}; dyType && + evaluate::IsInteroperableIntrinsicType(*dyType, + InModuleFile() ? nullptr : &context_.languageFeatures()) + .value_or(false)) { // F'2023 18.3.7 p2(4,5) + // N.B. Language features are not passed to IsInteroperableIntrinsicType + // when processing a module file, since the module file might have been + // compiled with CUDA while the client is not. } else if (type->category() == DeclTypeSpec::Logical) { if (context_.ShouldWarn(common::UsageWarning::LogicalVsCBool) && !InModuleFile()) { diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 3684839c187e..0eabe532cfe0 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -1956,7 +1956,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::ArrayConstructor &array) { // Check if implicit conversion of expr to the symbol type is legal (if needed), // and make it explicit if requested. -static MaybeExpr implicitConvertTo(const semantics::Symbol &sym, +static MaybeExpr ImplicitConvertTo(const semantics::Symbol &sym, Expr &&expr, bool keepConvertImplicit) { if (!keepConvertImplicit) { return ConvertToType(sym, std::move(expr)); @@ -2196,7 +2196,7 @@ MaybeExpr ExpressionAnalyzer::Analyze( // convert would cause a segfault. Lowering will deal with // conditionally converting and preserving the lower bounds in this // case. - if (MaybeExpr converted{implicitConvertTo( + if (MaybeExpr converted{ImplicitConvertTo( *symbol, std::move(*value), IsAllocatable(*symbol))}) { if (auto componentShape{GetShape(GetFoldingContext(), *symbol)}) { if (auto valueShape{GetShape(GetFoldingContext(), *converted)}) { diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp index cfaee0b8ba6d..aa6e8973ebd3 100644 --- a/flang/lib/Semantics/type.cpp +++ b/flang/lib/Semantics/type.cpp @@ -893,13 +893,4 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DeclTypeSpec &x) { return o << x.AsFortran(); } -std::optional IsInteroperableIntrinsicType( - const DeclTypeSpec &type, const common::LanguageFeatureControl &features) { - if (auto dyType{evaluate::DynamicType::From(type)}) { - return IsInteroperableIntrinsicType(*dyType, &features); - } else { - return std::nullopt; - } -} - } // namespace Fortran::semantics diff --git a/flang/test/Semantics/Inputs/modfile66.cuf b/flang/test/Semantics/Inputs/modfile66.cuf new file mode 100644 index 000000000000..be400da74914 --- /dev/null +++ b/flang/test/Semantics/Inputs/modfile66.cuf @@ -0,0 +1,4 @@ +module usereal2 + !REAL(2) is interoperable under CUDA + real(2), bind(c) :: x +end diff --git a/flang/test/Semantics/modfile66.f90 b/flang/test/Semantics/modfile66.f90 new file mode 100644 index 000000000000..51b4d8375d50 --- /dev/null +++ b/flang/test/Semantics/modfile66.f90 @@ -0,0 +1,3 @@ +! RUN: %flang_fc1 -fsyntax-only %S/Inputs/modfile66.cuf && %flang_fc1 -fsyntax-only %s +use usereal2 ! valid since x is not used +end