diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h --- a/flang/include/flang/Common/Fortran-features.h +++ b/flang/include/flang/Common/Fortran-features.h @@ -42,7 +42,8 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable, NonTargetPassedToTarget, PointerToPossibleNoncontiguous, ShortCharacterActual, ExprPassedToVolatile, ImplicitInterfaceActual, - PolymorphicTransferArg, PointerComponentTransferArg, TransferSizePresence) + PolymorphicTransferArg, PointerComponentTransferArg, TransferSizePresence, + F202XAllocatableBreakingChange) using LanguageFeatures = EnumSet; using UsageWarnings = EnumSet; diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -650,5 +650,11 @@ // 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 --- a/flang/lib/Semantics/check-allocate.cpp +++ b/flang/lib/Semantics/check-allocate.cpp @@ -143,7 +143,10 @@ } 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 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -688,6 +688,12 @@ 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 --- a/flang/lib/Semantics/check-coarray.cpp +++ b/flang/lib/Semantics/check-coarray.cpp @@ -110,7 +110,10 @@ } 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 @@ } 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 --- a/flang/lib/Semantics/check-deallocate.cpp +++ b/flang/lib/Semantics/check-deallocate.cpp @@ -103,7 +103,10 @@ } 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 --- a/flang/lib/Semantics/check-io.cpp +++ b/flang/lib/Semantics/check-io.cpp @@ -424,8 +424,12 @@ specKind = IoSpecKind::Dispose; break; } - CheckForDefinableVariable(std::get(spec.t), - parser::ToUpperCaseLetters(common::EnumToString(specKind))); + const parser::Variable &var{ + std::get(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 @@ } 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::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 @@ 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 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -1610,4 +1610,23 @@ 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 new file mode 100644 --- /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 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