[flang-commits] [flang] [flang] Add control and a portability warning for an extension (PR #137995)

[Peter Klausler via flang-commits]

https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/137995

>From 698c3e90b6e1fd646c45c70646a7c15dbe497953 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 30 Apr 2025 10:04:20 -0700
Subject: [PATCH] [flang] Add control and a portability warning for an
 extension

This compiler allows an element of an assumed-shape array or POINTER
to be used in sequence association as an actual argument, so long
as the array is declared to have the CONTIGUOUS attribute.

Make sure that this extension is under control of a LanguageFeature
enum, so that a hypothetical compiler driver option could disable it,
and add an optional portability warning for its use.
---
 .../include/flang/Support/Fortran-features.h  |  2 +-
 flang/lib/Semantics/check-call.cpp            | 36 ++++++++++++++-----
 flang/test/Semantics/call44.f90               | 13 +++++++
 3 files changed, 41 insertions(+), 10 deletions(-)
 create mode 100644 flang/test/Semantics/call44.f90

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