llvm · klausler · May 12, 2025 · Apr 30, 2025
diff --git 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
@@ -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
@@ -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