diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h index 5b22313754a0f..9086c837369df 100644 --- a/flang/include/flang/Support/Fortran-features.h +++ b/flang/include/flang/Support/Fortran-features.h @@ -54,7 +54,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines, PolymorphicActualAllocatableOrPointerToMonomorphicDummy, RelaxedPureDummy, UndefinableAsynchronousOrVolatileActual, AutomaticInMainProgram, PrintCptr, SavedLocalInSpecExpr, PrintNamelist, AssumedRankPassedToNonAssumedRank, - IgnoreIrrelevantAttributes, Unsigned) + IgnoreIrrelevantAttributes, Unsigned, ContiguousOkForSeqAssociation) // Portability and suspicious usage warnings ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable, diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index dfaa0e028d698..4c1a08e81b203 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -581,20 +581,38 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, "Polymorphic scalar may not be associated with a %s array"_err_en_US, dummyName); } + bool isOkBecauseContiguous{ + context.IsEnabled( + common::LanguageFeature::ContiguousOkForSeqAssociation) && + actualLastSymbol && + evaluate::IsContiguous(*actualLastSymbol, foldingContext)}; if (actualIsArrayElement && actualLastSymbol && - !evaluate::IsContiguous(*actualLastSymbol, foldingContext) && !dummy.ignoreTKR.test(common::IgnoreTKR::Contiguous)) { if (IsPointer(*actualLastSymbol)) { - basicError = true; - messages.Say( - "Element of pointer array may not be associated with a %s array"_err_en_US, - dummyName); + if (isOkBecauseContiguous) { + context.Warn( + common::LanguageFeature::ContiguousOkForSeqAssociation, + messages.at(), + "Element of contiguous pointer array is accepted for storage sequence association"_port_en_US); + } else { + basicError = true; + messages.Say( + "Element of pointer array may not be associated with a %s array"_err_en_US, + dummyName); + } } else if (IsAssumedShape(*actualLastSymbol) && !dummy.ignoreTKR.test(common::IgnoreTKR::Contiguous)) { - basicError = true; - messages.Say( - "Element of assumed-shape array may not be associated with a %s array"_err_en_US, - dummyName); + if (isOkBecauseContiguous) { + context.Warn( + common::LanguageFeature::ContiguousOkForSeqAssociation, + messages.at(), + "Element of contiguous assumed-shape array is accepted for storage sequence association"_port_en_US); + } else { + basicError = true; + messages.Say( + "Element of assumed-shape array may not be associated with a %s array"_err_en_US, + dummyName); + } } } } diff --git a/flang/test/Semantics/call44.f90 b/flang/test/Semantics/call44.f90 new file mode 100644 index 0000000000000..f7c4c9093b432 --- /dev/null +++ b/flang/test/Semantics/call44.f90 @@ -0,0 +1,13 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror +subroutine assumedshape(normal, contig) + real normal(:) + real, contiguous :: contig(:) + !WARNING: If the procedure's interface were explicit, this reference would be in error + !BECAUSE: Element of assumed-shape array may not be associated with a dummy argument 'assumedsize=' array + call seqAssociate(normal(1)) + !PORTABILITY: Element of contiguous assumed-shape array is accepted for storage sequence association + call seqAssociate(contig(1)) +end +subroutine seqAssociate(assumedSize) + real assumedSize(*) +end