[flang] Add optional portability warning for upcoming Fortran 202X/3 breaking change

[klausler]

Summary

The soon-to-be-published next revision of the ISO Fortran language standard
contains a couple of breaking changes to previous specifications that may cause
existing programs to silently change their behavior.

For the change that introduces automatic reallocation of deferred length
allocatable character scalar variables when they appear as the targets
of internal WRITE statements, as IOMSG=/ERRMSG= variables, as outputs
of INQUIRE specifiers, or as INTENT(OUT) arguments to intrinsic
procedures, this patch adds an optional portability warning.

[kiranchandramohan]

LG.

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

ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     DistinguishableSpecifics, DefaultSave, PointerInSeqType, NonCharacterFormat,
     SaveMainProgram, SaveBigMainProgramVariables,
     DistinctArrayConstructorLengths, PPCVector, RelaxedIntentInChecking)
 
 // Portability and suspicious usage warnings for conforming code
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
     NonTargetPassedToTarget, PointerToPossibleNoncontiguous,
     ShortCharacterActual, ExprPassedToVolatile, ImplicitInterfaceActual,
-    PolymorphicTransferArg, PointerComponentTransferArg, TransferSizePresence)
+    PolymorphicTransferArg, PointerComponentTransferArg, TransferSizePresence,
+    F202XAllocatableBreakingChange)
 
 using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
 using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;
 
 class LanguageFeatureControl {
 public:
   LanguageFeatureControl() {
     // These features must be explicitly enabled by command line options.

flang/include/flang/Semantics/tools.h

 std::forward_list<std::string> GetAllNames(
     const SemanticsContext &, const SourceName &);
 
 // Determines the derived type of a procedure's initial "dtv" dummy argument,
 // assuming that the procedure is a specific procedure of a defined I/O
 // generic interface,
 const DerivedTypeSpec *GetDtvArgDerivedType(const Symbol &);
 
+// If "expr" exists and is a designator for a deferred length
+// character allocatable whose semantics might change under Fortran 202X,
+// emit a portability warning.
+void WarnOnDeferredLengthCharacterScalar(SemanticsContext &, const SomeExpr *,
+    parser::CharBlock at, const char *what);
+
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_TOOLS_H_

flang/lib/Semantics/check-allocate.cpp

common::visit(
                   common::visitors{
                       [&](const parser::StatVariable &) {
                         if (info.gotStat) { // C943
                           context.Say(
                               "STAT may not be duplicated in a ALLOCATE statement"_err_en_US);
                         }
                         info.gotStat = true;
                       },
-                      [&](const parser::MsgVariable &) {
+                      [&](const parser::MsgVariable &var) {
+                        WarnOnDeferredLengthCharacterScalar(context,
+                            GetExpr(context, var),
+                            var.v.thing.thing.GetSource(), "ERRMSG=");
                         if (info.gotMsg) { // C943
                           context.Say(
                               "ERRMSG may not be duplicated in a ALLOCATE statement"_err_en_US);
                         }
                         info.gotMsg = true;
                       },
                   },
                   statOrErr.u);

flang/lib/Semantics/check-call.cpp

if (!common::AreCompatibleCUDADataAttrs(
                 parser::ToUpperCaseLetters(common::EnumToString(*x)) + ")"s
                  : "no CUDA data attribute"s;
       }};
       messages.Say(
           "%s has %s but its associated actual argument has %s"_err_en_US,
           dummyName, toStr(dummyDataAttr), toStr(actualDataAttr));
     }
   }
+
+  // Breaking change warnings
+  if (intrinsic && dummy.intent != common::Intent::In) {
+    WarnOnDeferredLengthCharacterScalar(
+        context, &actual, messages.at(), dummyName.c_str());
+  }
 }
 
 static void CheckProcedureArg(evaluate::ActualArgument &arg,
     const characteristics::Procedure &proc,
     const characteristics::DummyProcedure &dummy, const std::string &dummyName,
     SemanticsContext &context) {
   evaluate::FoldingContext &foldingContext{context.foldingContext()};
   parser::ContextualMessages &messages{foldingContext.messages()};

flang/lib/Semantics/check-coarray.cpp

common::visit(
         common::visitors{
             [&](const parser::StatVariable &stat) {
               if (gotStat) {
                 context.Say( // C1172
                     "The stat-variable in a sync-stat-list may not be repeated"_err_en_US);
               }
               gotStat = true;
             },
-            [&](const parser::MsgVariable &errmsg) {
+            [&](const parser::MsgVariable &var) {
+              WarnOnDeferredLengthCharacterScalar(context,
+                  GetExpr(context, var), var.v.thing.thing.GetSource(),
+                  "ERRMSG=");
               if (gotMsg) {
                 context.Say( // C1172
                     "The errmsg-variable in a sync-stat-list may not be repeated"_err_en_US);
               }
               gotMsg = true;
             },
         },
         statOrErrmsg.u);
common::visit(
                   common::visitors{
                       [&](const parser::StatVariable &stat) {
                         if (gotStat) {
                           context_.Say( // C1178
                               "A stat-variable in a event-wait-spec-list may not be repeated"_err_en_US);
                         }
                         gotStat = true;
                       },
-                      [&](const parser::MsgVariable &errmsg) {
+                      [&](const parser::MsgVariable &var) {
+                        WarnOnDeferredLengthCharacterScalar(context_,
+                            GetExpr(context_, var),
+                            var.v.thing.thing.GetSource(), "ERRMSG=");
                         if (gotMsg) {
                           context_.Say( // C1178
                               "A errmsg-variable in a event-wait-spec-list may not be repeated"_err_en_US);
                         }
                         gotMsg = true;
                       },
                   },
                   statOrErrmsg.u);

flang/lib/Semantics/check-deallocate.cpp

common::visit(
         common::visitors{
             [&](const parser::StatVariable &) {
               if (gotStat) {
                 context_.Say(
                     "STAT may not be duplicated in a DEALLOCATE statement"_err_en_US);
               }
               gotStat = true;
             },
-            [&](const parser::MsgVariable &) {
+            [&](const parser::MsgVariable &var) {
+              WarnOnDeferredLengthCharacterScalar(context_,
+                  GetExpr(context_, var), var.v.thing.thing.GetSource(),
+                  "ERRMSG=");
               if (gotMsg) {
                 context_.Say(
                     "ERRMSG may not be duplicated in a DEALLOCATE statement"_err_en_US);
               }
               gotMsg = true;
             },
         },
         deallocOpt.u);
   }
 }
 
 } // namespace Fortran::semantics

flang/lib/Semantics/check-io.cpp

case ParseKind::Carriagecontrol:
     break;
   case ParseKind::Convert:
     specKind = IoSpecKind::Convert;
     break;
   case ParseKind::Dispose:
     specKind = IoSpecKind::Dispose;
     break;
   }
-  CheckForDefinableVariable(std::get<parser::ScalarDefaultCharVariable>(spec.t),
-      parser::ToUpperCaseLetters(common::EnumToString(specKind)));
+  const parser::Variable &var{
+      std::get<parser::ScalarDefaultCharVariable>(spec.t).thing.thing};
+  std::string what{parser::ToUpperCaseLetters(common::EnumToString(specKind))};
+  CheckForDefinableVariable(var, what);
+  WarnOnDeferredLengthCharacterScalar(
+      context_, GetExpr(context_, var), var.GetSource(), what.c_str());
   SetSpecifier(specKind);
 }
 
 void IoChecker::Enter(const parser::InquireSpec::IntVar &spec) {
   IoSpecKind specKind{};
   using ParseKind = parser::InquireSpec::IntVar::Kind;
   switch (std::get<parser::InquireSpec::IntVar::Kind>(spec.t)) {
   case ParseKind::Iostat:
if (dyType && dyType->category() == TypeCategory::Integer) {
           parser::ScalarIntExpr{parser::IntExpr{std::move(newExpr)}}};
     } else if (!dyType || dyType->category() != TypeCategory::Character) {
       SetSpecifier(IoSpecKind::Unit);
       context_.Say(parser::FindSourceLocation(*var),
           "I/O unit must be a character variable or a scalar integer expression"_err_en_US);
     } else { // CHARACTER variable (internal I/O)
       if (stmt_ == IoStmtKind::Write) {
         CheckForDefinableVariable(*var, "Internal file");
+        WarnOnDeferredLengthCharacterScalar(
+            context_, expr, var->GetSource(), "Internal file");
       }
       if (HasVectorSubscript(*expr)) {
         context_.Say(parser::FindSourceLocation(*var), // C1201
             "Internal file must not have a vector subscript"_err_en_US);
       }
       SetSpecifier(IoSpecKind::Unit);
       flags_.set(Flag::InternalUnit);
     }
   } else if (std::get_if<parser::Star>(&spec.u)) {
     SetSpecifier(IoSpecKind::Unit);
     flags_.set(Flag::StarUnit);
   }
 }
 
-void IoChecker::Enter(const parser::MsgVariable &var) {
+void IoChecker::Enter(const parser::MsgVariable &msgVar) {
+  const parser::Variable &var{msgVar.v.thing.thing};
   if (stmt_ == IoStmtKind::None) {
     // allocate, deallocate, image control
     CheckForDefinableVariable(var, "ERRMSG");
-    return;
-  }
+    WarnOnDeferredLengthCharacterScalar(
+        context_, GetExpr(context_, var), var.GetSource(), "ERRMSG=");
+  } else {
     CheckForDefinableVariable(var, "IOMSG");
+    WarnOnDeferredLengthCharacterScalar(
+        context_, GetExpr(context_, var), var.GetSource(), "IOMSG=");
     SetSpecifier(IoSpecKind::Iomsg);
   }
+}
 
 void IoChecker::Enter(const parser::OutputItem &item) {
   flags_.set(Flag::DataList);
   if (const auto *x{std::get_if<parser::Expr>(&item.u)}) {
     if (const auto *expr{GetExpr(context_, *x)}) {
       if (evaluate::IsBOZLiteral(*expr)) {
         context_.Say(parser::FindSourceLocation(*x), // C7109
             "Output item must not be a BOZ literal constant"_err_en_US);
if (const std::optional<std::string> charConst{
     }
   }
 }
 
 void IoChecker::Enter(const parser::StatVariable &var) {
   if (stmt_ == IoStmtKind::None) {
     // allocate, deallocate, image control
     CheckForDefinableVariable(var, "STAT");
-    return;
-  }
+  } else {
     CheckForDefinableVariable(var, "IOSTAT");
     SetSpecifier(IoSpecKind::Iostat);
   }
+}
 
 void IoChecker::Leave(const parser::BackspaceStmt &) {
   CheckForPureSubprogram();
   CheckForRequiredSpecifier(
       flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
   Done();
 }
 

flang/lib/Semantics/tools.cpp

for (; scope && !scope->IsGlobal(); scope = &scope->parent()) {
           }
         }
       }
     }
   }
   return false;
 }
 
+void WarnOnDeferredLengthCharacterScalar(SemanticsContext &context,
+    const SomeExpr *expr, parser::CharBlock at, const char *what) {
+  if (context.languageFeatures().ShouldWarn(
+          common::UsageWarning::F202XAllocatableBreakingChange)) {
+    if (const Symbol *
+        symbol{evaluate::UnwrapWholeSymbolOrComponentDataRef(expr)}) {
+      const Symbol &ultimate{ResolveAssociations(*symbol)};
+      if (const DeclTypeSpec * type{ultimate.GetType()}; type &&
+          type->category() == DeclTypeSpec::Category::Character &&
+          type->characterTypeSpec().length().isDeferred() &&
+          IsAllocatable(ultimate) && ultimate.Rank() == 0) {
+        context.Say(at,
+            "The deferred length allocatable character scalar variable '%s' may be reallocated to a different length under the new Fortran 202X standard semantics for %s"_port_en_US,
+            symbol->name(), what);
+      }
+    }
+  }
+}
+
 } // namespace Fortran::semantics

flang/test/Semantics/breaking01.f90

+! RUN: %flang_fc1 -fsyntax-only -pedantic %s  2>&1 | FileCheck %s --allow-empty
+! Verify portability warning on usage that trips over a F202X breaking change
+program main
+  character(:), allocatable :: str
+  real, allocatable :: x
+  allocate(character(10)::str)
+!CHECK: portability: The deferred length allocatable character scalar variable 'str' may be reallocated to a different length under the new Fortran 202X standard semantics for Internal file
+  write(str, 1) 3.14159
+1 format(F6.4)
+  print 2, str
+2 format('>',a,'<')
+!CHECK: portability: The deferred length allocatable character scalar variable 'str' may be reallocated to a different length under the new Fortran 202X standard semantics for IOMSG=
+  open(1,file="/dev/nonexistent",status="old",iomsg=str)
+!CHECK: portability: The deferred length allocatable character scalar variable 'str' may be reallocated to a different length under the new Fortran 202X standard semantics for ENCODING
+  inquire(6,encoding=str)
+!CHECK: portability: The deferred length allocatable character scalar variable 'str' may be reallocated to a different length under the new Fortran 202X standard semantics for ERRMSG=
+  allocate(x,errmsg=str)
+!CHECK: portability: The deferred length allocatable character scalar variable 'str' may be reallocated to a different length under the new Fortran 202X standard semantics for ERRMSG=
+  deallocate(x,errmsg=str)
+!CHECK: portability: The deferred length allocatable character scalar variable 'str' may be reallocated to a different length under the new Fortran 202X standard semantics for dummy argument 'cmdmsg='
+  call execute_command_line("true", cmdmsg=str)
+end