[flang-commits] [flang] bc56620 - [flang] Implement checks for defined input/output procedures
Peter Steinfeld via flang-commits
flang-commits at lists.llvm.org
Tue May 25 13:41:07 PDT 2021
Author: Peter Steinfeld
Date: 2021-05-25T13:27:00-07:00
New Revision: bc56620b8b765b5720dbc1849511fb783e05b8cc
URL: https://github.com/llvm/llvm-project/commit/bc56620b8b765b5720dbc1849511fb783e05b8cc
DIFF: https://github.com/llvm/llvm-project/commit/bc56620b8b765b5720dbc1849511fb783e05b8cc.diff
LOG: [flang] Implement checks for defined input/output procedures
Defined input/output procedures are specified in 12.6.4.8. There are different
versions for read versus write and formatted versus unformatted, but they all
share the same basic set of dummy arguments.
I added several checking functions to check-declarations.cpp along with a test.
In the process of implementing this, I noticed and fixed a typo in
.../lib/Evaluate/characteristics.cpp.
Differential Revision: https://reviews.llvm.org/D103045
Added:
flang/test/Semantics/io11.f90
Modified:
flang/lib/Evaluate/characteristics.cpp
flang/lib/Semantics/check-declarations.cpp
Removed:
################################################################################
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index c6d6afeb81d18..9588de4fd37f6 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -611,7 +611,7 @@ common::Intent DummyArgument::GetIntent() const {
[](const DummyDataObject &data) { return data.intent; },
[](const DummyProcedure &proc) { return proc.intent; },
[](const AlternateReturn &) -> common::Intent {
- DIE("Alternate return have no intent");
+ DIE("Alternate returns have no intent");
},
},
u);
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 7e83ccfa64ee3..6633e02cba839 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -103,6 +103,21 @@ class CheckHelper {
}
bool IsResultOkToDiffer(const FunctionResult &);
void CheckBindCName(const Symbol &);
+ // Check functions for defined I/O procedures
+ void CheckDefinedIoProc(
+ const Symbol &, const GenericDetails &, GenericKind::DefinedIo);
+ bool CheckDioDummyIsData(const Symbol &, const Symbol *, std::size_t);
+ void CheckDioDummyIsDerived(const Symbol &, const Symbol &);
+ void CheckDioDummyIsDefaultInteger(const Symbol &, const Symbol &);
+ void CheckDioDummyIsScalar(const Symbol &, const Symbol &);
+ void CheckDioDummyAttrs(const Symbol &, const Symbol &, Attr);
+ void CheckDioDtvArg(const Symbol &, const Symbol *, GenericKind::DefinedIo);
+ void CheckDefaultIntegerArg(const Symbol &, const Symbol *, Attr);
+ void CheckDioAssumedLenCharacterArg(
+ const Symbol &, const Symbol *, std::size_t, Attr);
+ void CheckDioVlistArg(const Symbol &, const Symbol *, std::size_t);
+ void CheckDioArgCount(
+ const Symbol &, GenericKind::DefinedIo ioKind, std::size_t);
SemanticsContext &context_;
evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
@@ -657,7 +672,7 @@ void CheckHelper::CheckProcEntity(
" may not have an INTENT attribute"_err_en_US);
}
- const Symbol *interface{details.interface().symbol()};
+ const Symbol *interface { details.interface().symbol() };
if (!symbol.attrs().test(Attr::INTRINSIC) &&
(symbol.attrs().test(Attr::ELEMENTAL) ||
(interface && !interface->attrs().test(Attr::INTRINSIC) &&
@@ -1021,6 +1036,13 @@ void CheckHelper::CheckHostAssoc(
void CheckHelper::CheckGeneric(
const Symbol &symbol, const GenericDetails &details) {
CheckSpecificsAreDistinguishable(symbol, details);
+ std::visit(common::visitors{
+ [&](const GenericKind::DefinedIo &io) {
+ CheckDefinedIoProc(symbol, details, io);
+ },
+ [](const auto &) {},
+ },
+ details.kind().u);
}
// Check that the specifics of this generic are distinguishable from each other
@@ -1255,7 +1277,7 @@ bool CheckHelper::CheckDefinedAssignmentArg(
bool CheckHelper::CheckConflicting(const Symbol &symbol, Attr a1, Attr a2) {
if (symbol.attrs().test(a1) && symbol.attrs().test(a2)) {
messages_.Say("'%s' may not have both the %s and %s attributes"_err_en_US,
- symbol.name(), EnumToString(a1), EnumToString(a2));
+ symbol.name(), AttrToString(a1), AttrToString(a2));
return true;
} else {
return false;
@@ -1703,6 +1725,212 @@ void CheckHelper::CheckBindCName(const Symbol &symbol) {
}
}
+bool CheckHelper::CheckDioDummyIsData(
+ const Symbol &subp, const Symbol *arg, std::size_t position) {
+ if (arg && arg->detailsIf<ObjectEntityDetails>()) {
+ return true;
+ } else {
+ if (arg) {
+ messages_.Say(arg->name(),
+ "Dummy argument '%s' must be a data object"_err_en_US, arg->name());
+ } else {
+ messages_.Say(subp.name(),
+ "Dummy argument %d of '%s' must be a data object"_err_en_US, position,
+ subp.name());
+ }
+ return false;
+ }
+}
+
+void CheckHelper::CheckDioDummyIsDerived(
+ const Symbol &subp, const Symbol &arg) {
+ if (const DeclTypeSpec * type{arg.GetType()}; type && type->AsDerived()) {
+ return;
+ }
+ messages_.Say(arg.name(),
+ "Dummy argument '%s' of a defined input/output procedure must have a"
+ " derived type"_err_en_US,
+ arg.name());
+}
+
+void CheckHelper::CheckDioDummyIsDefaultInteger(
+ const Symbol &subp, const Symbol &arg) {
+ if (const DeclTypeSpec * type{arg.GetType()};
+ type && type->IsNumeric(TypeCategory::Integer)) {
+ if (const auto kind{evaluate::ToInt64(type->numericTypeSpec().kind())};
+ kind && *kind == context_.GetDefaultKind(TypeCategory::Integer)) {
+ return;
+ }
+ }
+ messages_.Say(arg.name(),
+ "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,
+ arg.name());
+ }
+}
+
+void CheckHelper::CheckDioDtvArg(
+ const Symbol &subp, const Symbol *arg, GenericKind::DefinedIo ioKind) {
+ // Dtv argument looks like: dtv-type-spec, INTENT(INOUT) :: dtv
+ if (CheckDioDummyIsData(subp, arg, 0)) {
+ CheckDioDummyIsDerived(subp, *arg);
+ CheckDioDummyAttrs(subp, *arg,
+ ioKind == GenericKind::DefinedIo::ReadFormatted ||
+ ioKind == GenericKind::DefinedIo::ReadUnformatted
+ ? Attr::INTENT_INOUT
+ : Attr::INTENT_IN);
+ }
+}
+
+void CheckHelper::CheckDefaultIntegerArg(
+ const Symbol &subp, const Symbol *arg, Attr intent) {
+ // Argument looks like: INTEGER, INTENT(intent) :: arg
+ if (CheckDioDummyIsData(subp, arg, 1)) {
+ CheckDioDummyIsDefaultInteger(subp, *arg);
+ CheckDioDummyIsScalar(subp, *arg);
+ CheckDioDummyAttrs(subp, *arg, intent);
+ }
+}
+
+void CheckHelper::CheckDioAssumedLenCharacterArg(const Symbol &subp,
+ const Symbol *arg, std::size_t argPosition, Attr intent) {
+ // Argument looks like: CHARACTER (LEN=*), INTENT(intent) :: (iotype OR iomsg)
+ if (CheckDioDummyIsData(subp, arg, argPosition)) {
+ CheckDioDummyAttrs(subp, *arg, intent);
+ if (!IsAssumedLengthCharacter(*arg)) {
+ messages_.Say(arg->name(),
+ "Dummy argument '%s' of a defined input/output procedure"
+ " must be assumed-length CHARACTER"_err_en_US,
+ arg->name());
+ }
+ }
+}
+
+void CheckHelper::CheckDioVlistArg(
+ const Symbol &subp, const Symbol *arg, std::size_t argPosition) {
+ // Vlist argument looks like: INTEGER, INTENT(IN) :: v_list(:)
+ if (CheckDioDummyIsData(subp, arg, argPosition)) {
+ CheckDioDummyIsDefaultInteger(subp, *arg);
+ CheckDioDummyAttrs(subp, *arg, Attr::INTENT_IN);
+ if (const auto *objectDetails{arg->detailsIf<ObjectEntityDetails>()}) {
+ if (objectDetails->shape().IsDeferredShape()) {
+ return;
+ }
+ }
+ messages_.Say(arg->name(),
+ "Dummy argument '%s' of a defined input/output procedure must be"
+ " deferred shape"_err_en_US,
+ arg->name());
+ }
+}
+
+void CheckHelper::CheckDioArgCount(
+ const Symbol &subp, GenericKind::DefinedIo ioKind, std::size_t argCount) {
+ const std::size_t requiredArgCount{
+ (std::size_t)(ioKind == GenericKind::DefinedIo::ReadFormatted ||
+ ioKind == GenericKind::DefinedIo::WriteFormatted
+ ? 6
+ : 4)};
+ if (argCount != requiredArgCount) {
+ SayWithDeclaration(subp,
+ "Defined input/output procedure '%s' must have"
+ " %d dummy arguments rather than %d"_err_en_US,
+ subp.name(), requiredArgCount, argCount);
+ context_.SetError(subp);
+ }
+}
+
+void CheckHelper::CheckDioDummyAttrs(
+ const Symbol &subp, const Symbol &arg, Attr goodIntent) {
+ // Defined I/O procedures can't have attributes other than INTENT
+ 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,
+ 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,
+ arg.name());
+ }
+}
+
+// Enforce semantics for defined input/output procedures (12.6.4.8.2) and C777
+void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
+ const GenericDetails &details, GenericKind::DefinedIo ioKind) {
+ for (auto ref : details.specificProcs()) {
+ const auto *binding{ref->detailsIf<ProcBindingDetails>()};
+ const Symbol &specific{*(binding ? &binding->symbol() : &*ref)};
+ if (ref->attrs().test(Attr::NOPASS)) { // C774
+ messages_.Say("Defined input/output procedure '%s' may not have NOPASS "
+ "attribute"_err_en_US,
+ ref->name());
+ context_.SetError(*ref);
+ }
+ if (const auto *subpDetails{specific.detailsIf<SubprogramDetails>()}) {
+ const std::vector<Symbol *> &dummyArgs{subpDetails->dummyArgs()};
+ CheckDioArgCount(specific, ioKind, dummyArgs.size());
+ int argCount{0};
+ for (auto *arg : dummyArgs) {
+ switch (argCount++) {
+ case 0:
+ // dtv-type-spec, INTENT(INOUT) :: dtv
+ CheckDioDtvArg(specific, arg, ioKind);
+ break;
+ case 1:
+ // INTEGER, INTENT(IN) :: unit
+ CheckDefaultIntegerArg(specific, arg, Attr::INTENT_IN);
+ break;
+ case 2:
+ if (ioKind == GenericKind::DefinedIo::ReadFormatted ||
+ ioKind == GenericKind::DefinedIo::WriteFormatted) {
+ // CHARACTER (LEN=*), INTENT(IN) :: iotype
+ CheckDioAssumedLenCharacterArg(
+ specific, arg, argCount, Attr::INTENT_IN);
+ } else {
+ // INTEGER, INTENT(OUT) :: iostat
+ CheckDefaultIntegerArg(specific, arg, Attr::INTENT_OUT);
+ }
+ break;
+ case 3:
+ if (ioKind == GenericKind::DefinedIo::ReadFormatted ||
+ ioKind == GenericKind::DefinedIo::WriteFormatted) {
+ // INTEGER, INTENT(IN) :: v_list(:)
+ CheckDioVlistArg(specific, arg, argCount);
+ } else {
+ // CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
+ CheckDioAssumedLenCharacterArg(
+ specific, arg, argCount, Attr::INTENT_INOUT);
+ }
+ break;
+ case 4:
+ // INTEGER, INTENT(OUT) :: iostat
+ CheckDefaultIntegerArg(specific, arg, Attr::INTENT_OUT);
+ break;
+ case 5:
+ // CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
+ CheckDioAssumedLenCharacterArg(
+ specific, arg, argCount, Attr::INTENT_INOUT);
+ break;
+ default:;
+ }
+ }
+ }
+ }
+}
+
void SubprogramMatchHelper::Check(
const Symbol &symbol1, const Symbol &symbol2) {
const auto details1{symbol1.get<SubprogramDetails>()};
@@ -1962,7 +2190,8 @@ void DistinguishabilityHelper::SayNotDistinguishable(const Scope &scope,
MakeOpName(name), name1, name2);
} else {
msg = &context_.Say(*GetTopLevelUnitContaining(proc1).GetName(),
- "USE-associated generic '%s' may not have specific procedures '%s' and"
+ "USE-associated generic '%s' may not have specific procedures '%s' "
+ "and"
" '%s' as their interfaces are not distinguishable"_err_en_US,
MakeOpName(name), name1, name2);
}
diff --git a/flang/test/Semantics/io11.f90 b/flang/test/Semantics/io11.f90
new file mode 100644
index 0000000000000..fd1d494da3233
--- /dev/null
+++ b/flang/test/Semantics/io11.f90
@@ -0,0 +1,366 @@
+! RUN: %S/test_errors.sh %s %t %flang_fc1
+
+! Tests for defined input/output. See 12.6.4.8 and 15.4.3.2, and C777
+module m1
+ type,public :: t
+ integer c
+ contains
+ procedure, nopass :: tbp=>formattedReadProc !Error, NOPASS not allowed
+ !ERROR: Defined input/output procedure 'tbp' may not have NOPASS attribute
+ generic :: read(formatted) => tbp
+ end type
+ private
+contains
+ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(t), intent(inout) :: dtv
+ integer, intent(in) :: unit
+ character(len=*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+
+ iostat = 343
+ stop 'fail'
+ end subroutine
+end module m1
+
+module m2
+ type,public :: t
+ integer c
+ contains
+ procedure, pass :: tbp=>formattedReadProc
+ !ERROR: Defined input/output procedure 'formattedreadproc' must have 6 dummy arguments rather than 5
+ generic :: read(formatted) => tbp
+ end type
+ private
+contains
+ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat)
+ class(t), intent(inout) :: dtv
+ integer, intent(in) :: unit
+ character(len=*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+
+ iostat = 343
+ stop 'fail'
+ end subroutine
+end module m2
+
+module m3
+ type,public :: t
+ integer c
+ contains
+ procedure, pass :: tbp=>unformattedReadProc
+ !ERROR: Defined input/output procedure 'unformattedreadproc' must have 4 dummy arguments rather than 5
+ generic :: read(unformatted) => tbp
+ end type
+ private
+contains
+ ! Error bad # of args
+ subroutine unformattedReadProc(dtv, unit, iostat, iomsg, iotype)
+ class(t), intent(inout) :: dtv
+ integer, intent(in) :: unit
+ integer, intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+ integer, intent(out) :: iotype
+
+ iostat = 343
+ stop 'fail'
+ end subroutine
+end module m3
+
+module m4
+ type,public :: t
+ integer c
+ contains
+ procedure, pass :: tbp=>formattedReadProc
+ generic :: read(formatted) => tbp
+ end type
+ private
+contains
+ !ERROR: Dummy argument 0 of 'formattedreadproc' must be a data object
+ !ERROR: Cannot use an alternate return as the passed-object dummy argument
+ subroutine formattedReadProc(*, unit, iotype, vlist, iostat, iomsg)
+ !ERROR: Dummy argument 'unit' must be a data object
+ !ERROR: A dummy procedure without the POINTER attribute may not have an INTENT attribute
+ procedure(sin), intent(in) :: unit
+ character(len=*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+
+ iostat = 343
+ stop 'fail'
+ end subroutine
+end module m4
+
+module m5
+ type,public :: t
+ integer c
+ contains
+ !ERROR: Passed-object dummy argument 'dtv' of procedure 'tbp' must be of type 't' but is 'INTEGER(4)'
+ procedure, pass :: tbp=>formattedReadProc
+ generic :: read(formatted) => tbp
+ end type
+ private
+contains
+ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
+ !ERROR: Dummy argument 'dtv' of a defined input/output procedure must have a derived type
+ integer, intent(inout) :: dtv ! error, must be of type t
+ integer, intent(in) :: unit
+ character(len=*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+
+ iostat = 343
+ stop 'fail'
+ end subroutine
+end module m5
+
+module m6
+ interface read(formatted)
+ procedure :: formattedReadProc
+ end interface
+
+ contains
+ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
+ !ERROR: Dummy argument 'dtv' of a defined input/output procedure must have a derived type
+ integer, intent(inout) :: dtv
+ integer, intent(in) :: unit
+ character(len=*), intent(in) :: iotype ! error, must be deferred
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+ end subroutine
+end module m6
+
+module m7
+ type,public :: t
+ integer c
+ contains
+ procedure, pass :: tbp=>formattedReadProc
+ generic :: read(formatted) => tbp
+ end type
+ private
+contains
+ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
+ !ERROR: Dummy argument 'dtv' of a defined input/output procedure must have intent 'INTENT(INOUT)'
+ class(t), intent(in) :: dtv ! Error, must be intent(inout)
+ integer, intent(in) :: unit
+ character(len=*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+
+ iostat = 343
+ stop 'fail'
+ end subroutine
+end module m7
+
+module m8
+ type,public :: t
+ integer c
+ contains
+ procedure, pass :: tbp=>formattedWriteProc
+ generic :: write(formatted) => tbp
+ end type
+ private
+contains
+ subroutine formattedWriteProc(dtv, unit, iotype, vlist, iostat, iomsg)
+ !ERROR: Dummy argument 'dtv' of a defined input/output procedure must have intent 'INTENT(IN)'
+ class(t), intent(inout) :: dtv ! Error, must be intent(inout)
+ integer, intent(in) :: unit
+ character(len=*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+
+ iostat = 343
+ stop 'fail'
+ end subroutine
+end module m8
+
+module m9
+ type,public :: t
+ integer c
+ contains
+ procedure, pass :: tbp=>formattedReadProc
+ generic :: read(formatted) => tbp
+ end type
+ private
+contains
+ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(t), intent(inout) :: dtv ! Error, can't have attributes
+ !ERROR: Dummy argument 'unit' of a defined input/output procedure may not have any attributes
+ integer, pointer, intent(in) :: unit
+ character(len=*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+
+ iostat = 343
+ stop 'fail'
+ end subroutine
+end module m9
+
+module m10
+ type,public :: t
+ integer c
+ contains
+ procedure, pass :: tbp=>formattedReadProc
+ generic :: read(formatted) => tbp
+ end type
+ private
+contains
+ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(t), intent(inout) :: dtv
+ !ERROR: Dummy argument 'unit' of a defined input/output procedure must be an INTEGER of default KIND
+ real, intent(in) :: unit ! Error, must be an integer
+ character(len=*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+
+ iostat = 343
+ stop 'fail'
+ end subroutine
+end module m10
+
+module m11
+ type,public :: t
+ integer c
+ contains
+ procedure, pass :: tbp=>formattedReadProc
+ generic :: read(formatted) => tbp
+ end type
+ private
+contains
+ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(t), intent(inout) :: dtv
+ !ERROR: Dummy argument 'unit' of a defined input/output procedure must be an INTEGER of default KIND
+ integer(8), intent(in) :: unit ! Error, must be default KIND
+ character(len=*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+
+ iostat = 343
+ stop 'fail'
+ end subroutine
+end module m11
+
+module m12
+ type,public :: t
+ integer c
+ contains
+ procedure, pass :: tbp=>formattedReadProc
+ generic :: read(formatted) => tbp
+ end type
+ private
+contains
+ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(t), intent(inout) :: dtv
+ !ERROR: Dummy argument 'unit' of a defined input/output procedure must be a scalar
+ integer, dimension(22), intent(in) :: unit ! Error, must be a scalar
+ character(len=*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+
+ iostat = 343
+ stop 'fail'
+ end subroutine
+end module m12
+
+module m13
+ type,public :: t
+ integer c
+ contains
+ procedure, pass :: tbp=>formattedReadProc
+ generic :: read(formatted) => tbp
+ end type
+ private
+contains
+ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(t), intent(inout) :: dtv
+ !ERROR: Dummy argument 'unit' of a defined input/output procedure must have intent 'INTENT(IN)'
+ integer, intent(out) :: unit !Error, must be intent(in)
+ character(len=*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+
+ iostat = 343
+ stop 'fail'
+ end subroutine
+end module m13
+
+module m14
+ type,public :: t
+ integer c
+ contains
+ procedure, pass :: tbp=>formattedReadProc
+ generic :: read(formatted) => tbp
+ end type
+ private
+contains
+ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(t), intent(inout) :: dtv
+ !ERROR: Dummy argument 'unit' of a defined input/output procedure must have intent 'INTENT(IN)'
+ integer :: unit !Error, must be INTENT(IN)
+ character(len=*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+
+ iostat = 343
+ stop 'fail'
+ end subroutine
+end module m14
+
+module m15
+ type,public :: t
+ integer c
+ contains
+ procedure, pass :: tbp=>formattedReadProc
+ generic :: read(formatted) => tbp
+ end type
+ private
+contains
+ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(t), intent(inout) :: dtv
+ integer, intent(in) :: unit
+ !ERROR: Dummy argument 'iotype' of a defined input/output procedure must be assumed-length CHARACTER
+ character(len=5), intent(in) :: iotype ! Error, must be assumed length
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+
+ iostat = 343
+ stop 'fail'
+ end subroutine
+end module m15
+
+module m16
+ type,public :: t
+ integer c
+ contains
+ procedure, pass :: tbp=>formattedReadProc
+ generic :: read(formatted) => tbp
+ end type
+ private
+contains
+ 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
+ integer, intent(in) :: vlist(5)
+ integer, intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+
+ iostat = 343
+ stop 'fail'
+ end subroutine
+end module m16
More information about the flang-commits
mailing list