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

[via flang-commits]

Author: Peter Klausler
Date: 2025-05-12T12:15:24-07:00
New Revision: ea87d7c0dbceaf21ddbd53d261600ca5e3aeddd7

URL: https://github.com/llvm/llvm-project/commit/ea87d7c0dbceaf21ddbd53d261600ca5e3aeddd7
DIFF: https://github.com/llvm/llvm-project/commit/ea87d7c0dbceaf21ddbd53d261600ca5e3aeddd7.diff

LOG: [flang] Add control and a portability warning for an extension (#137995)

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.

Added: 
    flang/test/Semantics/call44.f90

Modified: 
    flang/include/flang/Support/Fortran-features.h
    flang/lib/Semantics/check-call.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h
index 6cb1bcdb0003f..550a5c8f307d3 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 11928860fea5f..231f3a4222a2c 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