[flang-commits] [flang] 7871deb - [flang] Add optional portability warning for upcoming Fortran 202X/3 breaking change
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Jul 3 09:28:57 PDT 2023
Author: Peter Klausler
Date: 2023-07-03T09:07:00-07:00
New Revision: 7871deb8213c2162e6234537f334ff6b11257b23
URL: https://github.com/llvm/llvm-project/commit/7871deb8213c2162e6234537f334ff6b11257b23
DIFF: https://github.com/llvm/llvm-project/commit/7871deb8213c2162e6234537f334ff6b11257b23.diff
LOG: [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
Added:
flang/test/Semantics/breaking01.f90
Modified:
flang/include/flang/Common/Fortran-features.h
flang/include/flang/Semantics/tools.h
flang/lib/Semantics/check-allocate.cpp
flang/lib/Semantics/check-call.cpp
flang/lib/Semantics/check-coarray.cpp
flang/lib/Semantics/check-deallocate.cpp
flang/lib/Semantics/check-io.cpp
flang/lib/Semantics/tools.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index 1af049c7f4e614..3539c9aeab5763 100644
--- 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
index 0906e72d7501f1..c8550ab1464689 100644
--- 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
index ece66444ffb457..d4039b3177c594 100644
--- 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
index 57ddc3fde58df7..5669fb43c662fc 100644
--- 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
index 31fa3088d16bf2..77b198284e0501 100644
--- 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
index 2bdded9018f425..e3aad077ed0db0 100644
--- 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
index ba3b41a75cad52..81b58a27deb9d6 100644
--- 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
index f283103d98a2c5..891d23d773a1c4 100644
--- 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
diff erent 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
new file mode 100644
index 00000000000000..30acd5a0ad3473
--- /dev/null
+++ 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
diff erent 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
diff erent 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
diff erent 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
diff erent 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
diff erent 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
diff erent length under the new Fortran 202X standard semantics for dummy argument 'cmdmsg='
+ call execute_command_line("true", cmdmsg=str)
+end
More information about the flang-commits
mailing list