[flang-commits] [flang] [flang] Fix bogus error on defined I/O procedure. (PR #125898)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Wed Feb 5 09:53:01 PST 2025
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/125898
The check that "v_list" be deferred shape is just wrong; there are no deferred shape non-pointer non-allocatable dummy arguments in Fortran. Correct to check for an assumed shape dummy argument. And de-split the error messages that were split across multiple source lines, making them much harder to find with grep.
Fixes https://github.com/llvm/llvm-project/issues/125878.
>From 4db9e65f06b56dcf162dac173321297ed1a1c3cf Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 5 Feb 2025 09:49:40 -0800
Subject: [PATCH] [flang] Fix bogus error on defined I/O procedure.
The check that "v_list" be deferred shape is just wrong;
there are no deferred shape non-pointer non-allocatable dummy
arguments in Fortran. Correct to check for an assumed shape
dummy argument. And de-split the error messages that were split
across multiple source lines, making them much harder to find
with grep.
Fixes https://github.com/llvm/llvm-project/issues/125878.
---
flang/lib/Semantics/check-declarations.cpp | 30 ++++++++--------------
flang/test/Semantics/io11.f90 | 2 +-
2 files changed, 12 insertions(+), 20 deletions(-)
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 5c26469b9fa2482..1dc33754143aa57 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -3368,8 +3368,7 @@ void CheckHelper::CheckDioDummyIsDerived(const Symbol &subp, const Symbol &arg,
}
} else {
messages_.Say(arg.name(),
- "Dummy argument '%s' of a defined input/output procedure must have a"
- " derived type"_err_en_US,
+ "Dummy argument '%s' of a defined input/output procedure must have a derived type"_err_en_US,
arg.name());
}
}
@@ -3385,16 +3384,14 @@ void CheckHelper::CheckDioDummyIsDefaultInteger(
}
}
messages_.Say(arg.name(),
- "Dummy argument '%s' of a defined input/output procedure"
- " must be an INTEGER of default KIND"_err_en_US,
+ "Dummy argument '%s' of a defined input/output procedure must be an INTEGER of default KIND"_err_en_US,
arg.name());
}
void CheckHelper::CheckDioDummyIsScalar(const Symbol &subp, const Symbol &arg) {
if (arg.Rank() > 0 || arg.Corank() > 0) {
messages_.Say(arg.name(),
- "Dummy argument '%s' of a defined input/output procedure"
- " must be a scalar"_err_en_US,
+ "Dummy argument '%s' of a defined input/output procedure must be a scalar"_err_en_US,
arg.name());
}
}
@@ -3471,8 +3468,7 @@ void CheckHelper::CheckDioAssumedLenCharacterArg(const Symbol &subp,
context_.defaultKinds().GetDefaultKind(
TypeCategory::Character))) {
messages_.Say(arg->name(),
- "Dummy argument '%s' of a defined input/output procedure"
- " must be assumed-length CHARACTER of default kind"_err_en_US,
+ "Dummy argument '%s' of a defined input/output procedure must be assumed-length CHARACTER of default kind"_err_en_US,
arg->name());
}
}
@@ -3485,10 +3481,9 @@ void CheckHelper::CheckDioVlistArg(
CheckDioDummyIsDefaultInteger(subp, *arg);
CheckDioDummyAttrs(subp, *arg, Attr::INTENT_IN);
const auto *objectDetails{arg->detailsIf<ObjectEntityDetails>()};
- if (!objectDetails || !objectDetails->shape().CanBeDeferredShape()) {
+ if (!objectDetails || !objectDetails->shape().CanBeAssumedShape()) {
messages_.Say(arg->name(),
- "Dummy argument '%s' of a defined input/output procedure must be"
- " deferred shape"_err_en_US,
+ "Dummy argument '%s' of a defined input/output procedure must be assumed shape"_err_en_US,
arg->name());
}
}
@@ -3503,8 +3498,7 @@ void CheckHelper::CheckDioArgCount(
: 4)};
if (argCount != requiredArgCount) {
SayWithDeclaration(subp,
- "Defined input/output procedure '%s' must have"
- " %d dummy arguments rather than %d"_err_en_US,
+ "Defined input/output procedure '%s' must have %d dummy arguments rather than %d"_err_en_US,
subp.name(), requiredArgCount, argCount);
context_.SetError(subp);
}
@@ -3516,15 +3510,13 @@ void CheckHelper::CheckDioDummyAttrs(
Attrs attrs{arg.attrs()};
if (!attrs.test(goodIntent)) {
messages_.Say(arg.name(),
- "Dummy argument '%s' of a defined input/output procedure"
- " must have intent '%s'"_err_en_US,
+ "Dummy argument '%s' of a defined input/output procedure must have intent '%s'"_err_en_US,
arg.name(), AttrToString(goodIntent));
}
attrs = attrs - Attr::INTENT_IN - Attr::INTENT_OUT - Attr::INTENT_INOUT;
if (!attrs.empty()) {
messages_.Say(arg.name(),
- "Dummy argument '%s' of a defined input/output procedure may not have"
- " any attributes"_err_en_US,
+ "Dummy argument '%s' of a defined input/output procedure may not have any attributes"_err_en_US,
arg.name());
}
}
@@ -3537,8 +3529,8 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
const auto *binding{ultimate.detailsIf<ProcBindingDetails>()};
const Symbol &specific{*(binding ? &binding->symbol() : &ultimate)};
if (ultimate.attrs().test(Attr::NOPASS)) { // C774
- messages_.Say("Defined input/output procedure '%s' may not have NOPASS "
- "attribute"_err_en_US,
+ messages_.Say(
+ "Defined input/output procedure '%s' may not have NOPASS attribute"_err_en_US,
ultimate.name());
context_.SetError(ultimate);
}
diff --git a/flang/test/Semantics/io11.f90 b/flang/test/Semantics/io11.f90
index 9b5ad1b8427d917..23f0081f4b9fa36 100644
--- a/flang/test/Semantics/io11.f90
+++ b/flang/test/Semantics/io11.f90
@@ -355,7 +355,7 @@ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
class(t), intent(inout) :: dtv
integer, intent(in) :: unit
character(len=*), intent(in) :: iotype
- !ERROR: Dummy argument 'vlist' of a defined input/output procedure must be deferred shape
+ !ERROR: Dummy argument 'vlist' of a defined input/output procedure must be assumed shape
integer, intent(in) :: vlist(5)
integer, intent(out) :: iostat
character(len=*), intent(inout) :: iomsg
More information about the flang-commits
mailing list