[flang-commits] [flang] aa68dd5 - [flang] Disable extension by default (#114875)
via flang-commits
flang-commits at lists.llvm.org
Thu Nov 14 14:56:25 PST 2024
Author: Peter Klausler
Date: 2024-11-14T14:56:22-08:00
New Revision: aa68dd57838d29f1e020fa6e5a726c2e2317bb75
URL: https://github.com/llvm/llvm-project/commit/aa68dd57838d29f1e020fa6e5a726c2e2317bb75
DIFF: https://github.com/llvm/llvm-project/commit/aa68dd57838d29f1e020fa6e5a726c2e2317bb75.diff
LOG: [flang] Disable extension by default (#114875)
f18 allows, as an extension, an assumed-rank array to be associated with
a dummy argument that is not assumed-rank. This usage is non-conforming
and supported by only one other compiler, perhaps unintentionally.
Disable the extension by default, but also make it controllable so that
we can turn it back on later if it's really needed. (If it turns out to
not appear in applications after more exposure, I'll remove it
entirely.)
Fixes https://github.com/llvm/llvm-project/issues/114080.
Added:
Modified:
flang/include/flang/Common/Fortran-features.h
flang/lib/Common/Fortran-features.cpp
flang/lib/Semantics/check-call.cpp
flang/test/Semantics/call38.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index 74edbe44fdbb1c..c6ab846cce2fc0 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -53,7 +53,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
NonBindCInteroperability, CudaManaged, CudaUnified,
PolymorphicActualAllocatableOrPointerToMonomorphicDummy, RelaxedPureDummy,
UndefinableAsynchronousOrVolatileActual, AutomaticInMainProgram, PrintCptr,
- SavedLocalInSpecExpr, PrintNamelist)
+ SavedLocalInSpecExpr, PrintNamelist, AssumedRankPassedToNonAssumedRank)
// Portability and suspicious usage warnings
ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
diff --git a/flang/lib/Common/Fortran-features.cpp b/flang/lib/Common/Fortran-features.cpp
index fff796e42552a5..f47a4f17a6ba48 100644
--- a/flang/lib/Common/Fortran-features.cpp
+++ b/flang/lib/Common/Fortran-features.cpp
@@ -30,6 +30,8 @@ LanguageFeatureControl::LanguageFeatureControl() {
disable_.set(LanguageFeature::LogicalAbbreviations);
disable_.set(LanguageFeature::XOROperator);
disable_.set(LanguageFeature::OldStyleParameter);
+ // Possibly an accidental "feature" of nvfortran.
+ disable_.set(LanguageFeature::AssumedRankPassedToNonAssumedRank);
// These warnings are enabled by default, but only because they used
// to be unconditional. TODO: prune this list
warnLanguage_.set(LanguageFeature::ExponentMatchingKindParam);
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index a161d2bdf9dbb8..597c280a6df8bc 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -135,6 +135,20 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
dummy.type.type().kind() == actualType.type().kind() &&
!dummy.attrs.test(
characteristics::DummyDataObject::Attr::DeducedFromActual)) {
+ bool actualIsAssumedRank{evaluate::IsAssumedRank(actual)};
+ if (actualIsAssumedRank &&
+ !dummy.type.attrs().test(
+ characteristics::TypeAndShape::Attr::AssumedRank)) {
+ if (!context.languageFeatures().IsEnabled(
+ common::LanguageFeature::AssumedRankPassedToNonAssumedRank)) {
+ messages.Say(
+ "Assumed-rank character array may not be associated with a dummy argument that is not assumed-rank"_err_en_US);
+ } else {
+ context.Warn(common::LanguageFeature::AssumedRankPassedToNonAssumedRank,
+ messages.at(),
+ "Assumed-rank character array should not be associated with a dummy argument that is not assumed-rank"_port_en_US);
+ }
+ }
if (dummy.type.LEN() && actualType.LEN()) {
evaluate::FoldingContext &foldingContext{context.foldingContext()};
auto dummyLength{
@@ -148,7 +162,7 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
if (auto dummySize{evaluate::ToInt64(evaluate::Fold(
foldingContext, evaluate::GetSize(dummy.type.shape())))}) {
auto dummyChars{*dummySize * *dummyLength};
- if (actualType.Rank() == 0) {
+ if (actualType.Rank() == 0 && !actualIsAssumedRank) {
evaluate::DesignatorFolder folder{
context.foldingContext(), /*getLastComponent=*/true};
if (auto actualOffset{folder.FoldDesignator(actual)}) {
@@ -602,7 +616,18 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
characteristics::DummyDataObject::Attr::DeducedFromActual)) {
if (auto dummySize{evaluate::ToInt64(evaluate::Fold(
foldingContext, evaluate::GetSize(dummy.type.shape())))}) {
- if (actualRank == 0 && !actualIsAssumedRank) {
+ if (actualIsAssumedRank) {
+ if (!context.languageFeatures().IsEnabled(
+ common::LanguageFeature::AssumedRankPassedToNonAssumedRank)) {
+ messages.Say(
+ "Assumed-rank array may not be associated with a dummy argument that is not assumed-rank"_err_en_US);
+ } else {
+ context.Warn(
+ common::LanguageFeature::AssumedRankPassedToNonAssumedRank,
+ messages.at(),
+ "Assumed-rank array should not be associated with a dummy argument that is not assumed-rank"_port_en_US);
+ }
+ } else if (actualRank == 0) {
if (evaluate::IsArrayElement(actual)) {
// Actual argument is a scalar array element
evaluate::DesignatorFolder folder{
@@ -643,7 +668,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
}
}
- } else { // actualRank > 0 || actualIsAssumedRank
+ } else {
if (auto actualSize{evaluate::ToInt64(evaluate::Fold(
foldingContext, evaluate::GetSize(actualType.shape())))};
actualSize && *actualSize < *dummySize) {
diff --git a/flang/test/Semantics/call38.f90 b/flang/test/Semantics/call38.f90
index 0e7ebcdfe9df53..34aae6b8b18357 100644
--- a/flang/test/Semantics/call38.f90
+++ b/flang/test/Semantics/call38.f90
@@ -522,3 +522,25 @@ subroutine test
call scalar('a')
end
end
+
+subroutine bug114080(arg, contigArg)
+ character(*) :: arg(..)
+ character(*), contiguous :: contigArg(..)
+ interface
+ subroutine sub1(arg1) bind(c)
+ character(1) :: arg1(2,4)
+ end subroutine
+ end interface
+ !ERROR: Assumed-rank character array may not be associated with a dummy argument that is not assumed-rank
+ call sub1(arg)
+ !ERROR: Assumed-rank character array may not be associated with a dummy argument that is not assumed-rank
+ call sub1(contigArg)
+ !ERROR: Assumed-rank character array may not be associated with a dummy argument that is not assumed-rank
+ call sub2(arg)
+ !ERROR: Assumed-rank character array may not be associated with a dummy argument that is not assumed-rank
+ call sub2(contigArg)
+ contains
+ subroutine sub2(arg2)
+ character(*) :: arg2(10)
+ end subroutine sub2
+end subroutine
More information about the flang-commits
mailing list