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

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

<details>
<summary>Changes</summary>

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.

---
Full diff: https://github.com/llvm/llvm-project/pull/137995.diff


3 Files Affected:

- (modified) flang/include/flang/Support/Fortran-features.h (+1-1) 
- (modified) flang/lib/Semantics/check-call.cpp (+27-9) 
- (added) flang/test/Semantics/call43.f90 (+13) 


``````````diff
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/call43.f90 b/flang/test/Semantics/call43.f90
new file mode 100644
index 0000000000000..f7c4c9093b432
--- /dev/null
+++ b/flang/test/Semantics/call43.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

``````````

</details>


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