[flang] Add documentation, control, and portability warning for extension

f18 allows, as an extension, an assumed-rank array to be storage
sequence associated with a dummy argument.  Document the extension,
make it disableable, and add an optional portability warning.

Fixes #114080.

Author: klausler

flang/docs/Extensions.md

@@ -391,6 +391,9 @@ end
   has the SAVE attribute and was initialized.
 * `PRINT namelistname` is accepted and interpreted as
   `WRITE(*,NML=namelistname)`, a near-universal extension.
+* An assumed-rank array can be storage associated with a non-assumed-rank
+  dummy array if it otherwise meets the requirements for storage association
+  in F'2023 15.5.2.12.
 
 ### Extensions supported when enabled by options
 

flang/include/flang/Common/Fortran-features.h

@@ -53,7 +53,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     NonBindCInteroperability, CudaManaged, CudaUnified,
     PolymorphicActualAllocatableOrPointerToMonomorphicDummy, RelaxedPureDummy,
     UndefinableAsynchronousOrVolatileActual, AutomaticInMainProgram, PrintCptr,
-    SavedLocalInSpecExpr, PrintNamelist)
+    SavedLocalInSpecExpr, PrintNamelist, AssumedRankSequenceAssociation)
 
 // Portability and suspicious usage warnings
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,

flang/lib/Semantics/check-call.cpp

@@ -135,6 +135,18 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
       dummy.type.type().kind() == actualType.type().kind() &&
       !dummy.attrs.test(
           characteristics::DummyDataObject::Attr::DeducedFromActual)) {
+    bool actualIsAssumedRank{evaluate::IsAssumedRank(actual)};
+    if (actualIsAssumedRank) {
+      if (!context.languageFeatures().IsEnabled(
+              common::LanguageFeature::AssumedRankSequenceAssociation)) {
+        messages.Say(
+            "Assumed-rank character array may not be storage sequence associated with a dummy argument"_err_en_US);
+      } else {
+        context.Warn(common::LanguageFeature::AssumedRankSequenceAssociation,
+            messages.at(),
+            "Assumed-rank character array should not be storage sequence associated with a dummy argument"_port_en_US);
+      }
+    }
     if (dummy.type.LEN() && actualType.LEN()) {
       evaluate::FoldingContext &foldingContext{context.foldingContext()};
       auto dummyLength{
@@ -148,7 +160,7 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
           if (auto dummySize{evaluate::ToInt64(evaluate::Fold(
                   foldingContext, evaluate::GetSize(dummy.type.shape())))}) {
             auto dummyChars{*dummySize * *dummyLength};
-            if (actualType.Rank() == 0) {
+            if (actualType.Rank() == 0 && !actualIsAssumedRank) {
               evaluate::DesignatorFolder folder{
                   context.foldingContext(), /*getLastComponent=*/true};
               if (auto actualOffset{folder.FoldDesignator(actual)}) {
@@ -602,7 +614,18 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
             characteristics::DummyDataObject::Attr::DeducedFromActual)) {
       if (auto dummySize{evaluate::ToInt64(evaluate::Fold(
               foldingContext, evaluate::GetSize(dummy.type.shape())))}) {
-        if (actualRank == 0 && !actualIsAssumedRank) {
+        if (actualIsAssumedRank) {
+          if (!context.languageFeatures().IsEnabled(
+                  common::LanguageFeature::AssumedRankSequenceAssociation)) {
+            messages.Say(
+                "Assumed-rank array may not be storage sequence associated with a dummy argument"_err_en_US);
+          } else {
+            context.Warn(
+                common::LanguageFeature::AssumedRankSequenceAssociation,
+                messages.at(),
+                "Assumed-rank array should not be storage sequence associated with a dummy argument"_port_en_US);
+          }
+        } else if (actualRank == 0) {
           if (evaluate::IsArrayElement(actual)) {
             // Actual argument is a scalar array element
             evaluate::DesignatorFolder folder{
@@ -643,7 +666,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
               }
             }
           }
-        } else { // actualRank > 0 || actualIsAssumedRank
+        } else {
           if (auto actualSize{evaluate::ToInt64(evaluate::Fold(
                   foldingContext, evaluate::GetSize(actualType.shape())))};
               actualSize && *actualSize < *dummySize) {

flang/test/Semantics/call38.f90

@@ -522,3 +522,20 @@ subroutine test
     call scalar('a')
   end
 end
+
+subroutine bug114080(arg)
+  character(*) :: arg(..)
+  interface
+   subroutine sub1(arg1) bind(c)
+     character(1) :: arg1(2,4)
+   end subroutine
+  end interface
+  !WARNING: Assumed-rank character array should not be storage sequence associated with a dummy argument
+  call sub1(arg)
+  !WARNING: Assumed-rank character array should not be storage sequence associated with a dummy argument
+  call sub2(arg)
+  contains
+    subroutine sub2(arg2)
+      character(*) :: arg2(10)
+    end subroutine sub2
+end subroutine