[flang] Disable extension by default

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, AssumedRankPassedToNonAssumedRank)
 
 // Portability and suspicious usage warnings
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,

flang/lib/Common/Fortran-features.cpp

@@ -30,6 +30,8 @@ LanguageFeatureControl::LanguageFeatureControl() {
   disable_.set(LanguageFeature::LogicalAbbreviations);
   disable_.set(LanguageFeature::XOROperator);
   disable_.set(LanguageFeature::OldStyleParameter);
+  // Possibly an accidental "feature" of nvfortran.
+  disable_.set(LanguageFeature::AssumedRankPassedToNonAssumedRank);
   // These warnings are enabled by default, but only because they used
   // to be unconditional.  TODO: prune this list
   warnLanguage_.set(LanguageFeature::ExponentMatchingKindParam);

flang/lib/Semantics/check-call.cpp

@@ -135,6 +135,20 @@ 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 &&
+        !dummy.type.attrs().test(
+            characteristics::TypeAndShape::Attr::AssumedRank)) {
+      if (!context.languageFeatures().IsEnabled(
+              common::LanguageFeature::AssumedRankPassedToNonAssumedRank)) {
+        messages.Say(
+            "Assumed-rank character array may not be associated with a dummy argument that is not assumed-rank"_err_en_US);
+      } else {
+        context.Warn(common::LanguageFeature::AssumedRankPassedToNonAssumedRank,
+            messages.at(),
+            "Assumed-rank character array should not be associated with a dummy argument that is not assumed-rank"_port_en_US);
+      }
+    }
     if (dummy.type.LEN() && actualType.LEN()) {
       evaluate::FoldingContext &foldingContext{context.foldingContext()};
       auto dummyLength{
@@ -148,7 +162,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 +616,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::AssumedRankPassedToNonAssumedRank)) {
+            messages.Say(
+                "Assumed-rank array may not be associated with a dummy argument that is not assumed-rank"_err_en_US);
+          } else {
+            context.Warn(
+                common::LanguageFeature::AssumedRankPassedToNonAssumedRank,
+                messages.at(),
+                "Assumed-rank array should not be associated with a dummy argument that is not assumed-rank"_port_en_US);
+          }
+        } else if (actualRank == 0) {
           if (evaluate::IsArrayElement(actual)) {
             // Actual argument is a scalar array element
             evaluate::DesignatorFolder folder{
@@ -643,7 +668,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,25 @@ subroutine test
     call scalar('a')
   end
 end
+
+subroutine bug114080(arg, contigArg)
+  character(*) :: arg(..)
+  character(*), contiguous :: contigArg(..)
+  interface
+   subroutine sub1(arg1) bind(c)
+     character(1) :: arg1(2,4)
+   end subroutine
+  end interface
+  !ERROR: Assumed-rank character array may not be associated with a dummy argument that is not assumed-rank
+  call sub1(arg)
+  !ERROR: Assumed-rank character array may not be associated with a dummy argument that is not assumed-rank
+  call sub1(contigArg)
+  !ERROR: Assumed-rank character array may not be associated with a dummy argument that is not assumed-rank
+  call sub2(arg)
+  !ERROR: Assumed-rank character array may not be associated with a dummy argument that is not assumed-rank
+  call sub2(contigArg)
+  contains
+    subroutine sub2(arg2)
+      character(*) :: arg2(10)
+    end subroutine sub2
+end subroutine