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

…breaking change 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. Differential Revision: https://reviews.llvm.org/D154242
llvm · Jul 3, 2023 · 7871deb · 7871deb
1 parent de9caf2
commit 7871deb
Show file tree

Hide file tree

Showing 9 changed files with 91 additions and 14 deletions.
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
@@ -42,7 +42,8 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
 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>;

diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
@@ -650,5 +650,11 @@ std::forward_list<std::string> GetAllNames(
 // 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_
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
@@ -143,7 +143,10 @@ static std::optional<AllocateCheckerInfo> CheckAllocateOptions(
                         }
                         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);

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
@@ -688,6 +688,12 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
           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,

diff --git a/flang/lib/Semantics/check-coarray.cpp b/flang/lib/Semantics/check-coarray.cpp
@@ -110,7 +110,10 @@ static void CheckSyncStatList(
               }
               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);
@@ -214,7 +217,10 @@ void CoarrayChecker::Leave(const parser::EventWaitStmt &x) {
                         }
                         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);

diff --git a/flang/lib/Semantics/check-deallocate.cpp b/flang/lib/Semantics/check-deallocate.cpp
@@ -103,7 +103,10 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
               }
               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);

diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp
@@ -424,8 +424,12 @@ void IoChecker::Enter(const parser::InquireSpec::CharVar &spec) {
     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);
 }
 
@@ -583,6 +587,8 @@ void IoChecker::Enter(const parser::IoUnit &spec) {
     } 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
@@ -597,14 +603,19 @@ void IoChecker::Enter(const parser::IoUnit &spec) {
   }
 }
 
-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);
   }
-  CheckForDefinableVariable(var, "IOMSG");
-  SetSpecifier(IoSpecKind::Iomsg);
 }
 
 void IoChecker::Enter(const parser::OutputItem &item) {
@@ -654,10 +665,10 @@ 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);
   }
-  CheckForDefinableVariable(var, "IOSTAT");
-  SetSpecifier(IoSpecKind::Iostat);
 }
 
 void IoChecker::Leave(const parser::BackspaceStmt &) {

diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
@@ -1610,4 +1610,23 @@ bool HasDefinedIo(common::DefinedIo which, const DerivedTypeSpec &derived,
   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
diff --git a/flang/test/Semantics/breaking01.f90 b/flang/test/Semantics/breaking01.f90
@@ -0,0 +1,22 @@
+! 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