[flang-commits] [flang] 5718a42 - [flang] Catch insufficient actual elements/characters associated with longer dummy argument
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue Aug 1 13:32:01 PDT 2023
Author: Peter Klausler
Date: 2023-08-01T13:31:45-07:00
New Revision: 5718a4256be0b357a6493a875f57ce4ff0f76459
URL: https://github.com/llvm/llvm-project/commit/5718a4256be0b357a6493a875f57ce4ff0f76459
DIFF: https://github.com/llvm/llvm-project/commit/5718a4256be0b357a6493a875f57ce4ff0f76459.diff
LOG: [flang] Catch insufficient actual elements/characters associated with longer dummy argument
Check for cases of storage sequence association in which an element or
substring is an actual argument associated with a dummy argument array
that can be detected as being larger than the remaining elements or characters
in the actual argument's storage sequence.
Differential Revision: https://reviews.llvm.org/D156757
Added:
flang/test/Semantics/call38.f90
Modified:
flang/include/flang/Evaluate/characteristics.h
flang/include/flang/Evaluate/fold-designator.h
flang/lib/Evaluate/characteristics.cpp
flang/lib/Evaluate/fold-designator.cpp
flang/lib/Semantics/check-call.cpp
flang/test/Semantics/call33.f90
flang/test/Semantics/ignore_tkr01.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 824060f725d2cc..8f87868441b02c 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -199,8 +199,11 @@ class TypeAndShape {
// 15.3.2.2
struct DummyDataObject {
ENUM_CLASS(Attr, Optional, Allocatable, Asynchronous, Contiguous, Value,
- Volatile, Pointer, Target)
+ Volatile, Pointer, Target, DeducedFromActual)
using Attrs = common::EnumSet<Attr, Attr_enumSize>;
+ static bool IdenticalSignificantAttrs(const Attrs &x, const Attrs &y) {
+ return (x - Attr::DeducedFromActual) == (y - Attr::DeducedFromActual);
+ }
DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(DummyDataObject)
explicit DummyDataObject(const TypeAndShape &t) : type{t} {}
explicit DummyDataObject(TypeAndShape &&t) : type{std::move(t)} {}
@@ -215,6 +218,7 @@ struct DummyDataObject {
const semantics::Symbol &, FoldingContext &);
bool CanBePassedViaImplicitInterface() const;
llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
+
TypeAndShape type;
std::vector<Expr<SubscriptInteger>> coshape;
common::Intent intent{common::Intent::Default};
diff --git a/flang/include/flang/Evaluate/fold-designator.h b/flang/include/flang/Evaluate/fold-designator.h
index f246bd12020e00..9622d2661d3f41 100644
--- a/flang/include/flang/Evaluate/fold-designator.h
+++ b/flang/include/flang/Evaluate/fold-designator.h
@@ -60,7 +60,8 @@ class OffsetSymbol {
// corresponding to an element in array element order.
class DesignatorFolder {
public:
- explicit DesignatorFolder(FoldingContext &c) : context_{c} {}
+ explicit DesignatorFolder(FoldingContext &c, bool getLastComponent = false)
+ : context_{c}, getLastComponent_{getLastComponent} {}
bool isEmpty() const { return isEmpty_; }
bool isOutOfRange() const { return isOutOfRange_; }
@@ -103,7 +104,7 @@ class DesignatorFolder {
}
template <typename A>
- std::optional<OffsetSymbol> FoldDesignator(const A &x, ConstantSubscript) {
+ std::optional<OffsetSymbol> FoldDesignator(const A &, ConstantSubscript) {
return std::nullopt;
}
@@ -157,6 +158,7 @@ class DesignatorFolder {
}
FoldingContext &context_;
+ bool getLastComponent_{false};
ConstantSubscript elementNumber_{0}; // zero-based
bool isEmpty_{false};
bool isOutOfRange_{false};
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 4c036652711657..694f6a1abf4cb4 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -336,7 +336,8 @@ bool DummyDataObject::IsCompatibleWith(
}
}
}
- if (attrs != actual.attrs || type.attrs() != actual.type.attrs()) {
+ if (!IdenticalSignificantAttrs(attrs, actual.attrs) ||
+ type.attrs() != actual.type.attrs()) {
if (whyNot) {
*whyNot = "incompatible dummy data object attributes";
}
@@ -775,14 +776,18 @@ std::optional<DummyArgument> DummyArgument::FromActual(
return common::visit(
common::visitors{
[&](const BOZLiteralConstant &) {
- return std::make_optional<DummyArgument>(std::move(name),
- DummyDataObject{
- TypeAndShape{DynamicType::TypelessIntrinsicArgument()}});
+ DummyDataObject obj{
+ TypeAndShape{DynamicType::TypelessIntrinsicArgument()}};
+ obj.attrs.set(DummyDataObject::Attr::DeducedFromActual);
+ return std::make_optional<DummyArgument>(
+ std::move(name), std::move(obj));
},
[&](const NullPointer &) {
- return std::make_optional<DummyArgument>(std::move(name),
- DummyDataObject{
- TypeAndShape{DynamicType::TypelessIntrinsicArgument()}});
+ DummyDataObject obj{
+ TypeAndShape{DynamicType::TypelessIntrinsicArgument()}};
+ obj.attrs.set(DummyDataObject::Attr::DeducedFromActual);
+ return std::make_optional<DummyArgument>(
+ std::move(name), std::move(obj));
},
[&](const ProcedureDesignator &designator) {
if (auto proc{Procedure::Characterize(designator, context)}) {
@@ -802,8 +807,10 @@ std::optional<DummyArgument> DummyArgument::FromActual(
},
[&](const auto &) {
if (auto type{TypeAndShape::Characterize(expr, context)}) {
+ DummyDataObject obj{std::move(*type)};
+ obj.attrs.set(DummyDataObject::Attr::DeducedFromActual);
return std::make_optional<DummyArgument>(
- std::move(name), DummyDataObject{std::move(*type)});
+ std::move(name), std::move(obj));
} else {
return std::optional<DummyArgument>{};
}
diff --git a/flang/lib/Evaluate/fold-designator.cpp b/flang/lib/Evaluate/fold-designator.cpp
index d86b44971cc703..7298b0a2fb10c5 100644
--- a/flang/lib/Evaluate/fold-designator.cpp
+++ b/flang/lib/Evaluate/fold-designator.cpp
@@ -15,7 +15,7 @@ DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(OffsetSymbol)
std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
const Symbol &symbol, ConstantSubscript which) {
- if (IsAllocatableOrPointer(symbol)) {
+ if (!getLastComponent_ && IsAllocatableOrPointer(symbol)) {
// A pointer may appear as a DATA statement object if it is the
// rightmost symbol in a designator and has no subscripts.
// An allocatable may appear if its initializer is NULL().
@@ -142,21 +142,26 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
const Component &component, ConstantSubscript which) {
const Symbol &comp{component.GetLastSymbol()};
- const DataRef &base{component.base()};
- std::optional<OffsetSymbol> baseResult, compResult;
- if (base.Rank() == 0) { // A%X(:) - apply "which" to component
- baseResult = FoldDesignator(base, 0);
- compResult = FoldDesignator(comp, which);
- } else { // A(:)%X - apply "which" to base
- baseResult = FoldDesignator(base, which);
- compResult = FoldDesignator(comp, 0);
- }
- if (baseResult && compResult) {
- OffsetSymbol result{baseResult->symbol(), compResult->size()};
- result.Augment(baseResult->offset() + compResult->offset() + comp.offset());
- return {std::move(result)};
+ if (getLastComponent_) {
+ return FoldDesignator(comp, which);
} else {
- return std::nullopt;
+ const DataRef &base{component.base()};
+ std::optional<OffsetSymbol> baseResult, compResult;
+ if (base.Rank() == 0) { // A%X(:) - apply "which" to component
+ baseResult = FoldDesignator(base, 0);
+ compResult = FoldDesignator(comp, which);
+ } else { // A(:)%X - apply "which" to base
+ baseResult = FoldDesignator(base, which);
+ compResult = FoldDesignator(comp, 0);
+ }
+ if (baseResult && compResult) {
+ OffsetSymbol result{baseResult->symbol(), compResult->size()};
+ result.Augment(
+ baseResult->offset() + compResult->offset() + comp.offset());
+ return {std::move(result)};
+ } else {
+ return std::nullopt;
+ }
}
}
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index c5d3cb251fc230..9db0563d73ba7d 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -11,6 +11,7 @@
#include "pointer-assignment.h"
#include "flang/Evaluate/characteristics.h"
#include "flang/Evaluate/check-expression.h"
+#include "flang/Evaluate/fold-designator.h"
#include "flang/Evaluate/shape.h"
#include "flang/Evaluate/tools.h"
#include "flang/Parser/characters.h"
@@ -98,6 +99,19 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
}
}
+// F'2023 15.5.2.12p1: "Sequence association only applies when the dummy
+// argument is an explicit-shape or assumed-size array."
+static bool CanAssociateWithStorageSequence(
+ const characteristics::DummyDataObject &dummy) {
+ return !dummy.type.attrs().test(
+ characteristics::TypeAndShape::Attr::AssumedRank) &&
+ !dummy.type.attrs().test(
+ characteristics::TypeAndShape::Attr::AssumedShape) &&
+ !dummy.type.attrs().test(characteristics::TypeAndShape::Attr::Coarray) &&
+ !dummy.attrs.test(characteristics::DummyDataObject::Attr::Allocatable) &&
+ !dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer);
+}
+
// When a CHARACTER actual argument is known to be short,
// we extend it on the right with spaces and a warning if
// possible. When it is long, and not required to be equal,
@@ -105,46 +119,106 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
const characteristics::DummyDataObject &dummy,
characteristics::TypeAndShape &actualType, SemanticsContext &context,
- parser::ContextualMessages &messages) {
+ parser::ContextualMessages &messages, bool extentErrors,
+ const std::string &dummyName) {
if (dummy.type.type().category() == TypeCategory::Character &&
actualType.type().category() == TypeCategory::Character &&
- dummy.type.type().kind() == actualType.type().kind()) {
+ dummy.type.type().kind() == actualType.type().kind() &&
+ !dummy.attrs.test(
+ characteristics::DummyDataObject::Attr::DeducedFromActual)) {
if (dummy.type.LEN() && actualType.LEN()) {
evaluate::FoldingContext &foldingContext{context.foldingContext()};
auto dummyLength{
ToInt64(Fold(foldingContext, common::Clone(*dummy.type.LEN())))};
auto actualLength{
ToInt64(Fold(foldingContext, common::Clone(*actualType.LEN())))};
- if (dummyLength && actualLength && *actualLength != *dummyLength) {
- if (dummy.attrs.test(
- characteristics::DummyDataObject::Attr::Allocatable) ||
- dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer) ||
- dummy.type.attrs().test(
- characteristics::TypeAndShape::Attr::AssumedRank) ||
- dummy.type.attrs().test(
- characteristics::TypeAndShape::Attr::AssumedShape)) {
- // See 15.5.2.4 paragraph 4., 15.5.2.5.
- messages.Say(
- "Actual argument variable length '%jd' does not match the expected length '%jd'"_err_en_US,
- *actualLength, *dummyLength);
- } else if (*actualLength < *dummyLength) {
- bool isVariable{evaluate::IsVariable(actual)};
- if (context.ShouldWarn(common::UsageWarning::ShortCharacterActual)) {
- if (isVariable) {
- messages.Say(
- "Actual argument variable length '%jd' is less than expected length '%jd'"_warn_en_US,
- *actualLength, *dummyLength);
- } else {
- messages.Say(
- "Actual argument expression length '%jd' is less than expected length '%jd'"_warn_en_US,
- *actualLength, *dummyLength);
+ if (dummyLength && actualLength) {
+ bool canAssociate{CanAssociateWithStorageSequence(dummy)};
+ if (dummy.type.Rank() > 0 && canAssociate) {
+ // Character storage sequence association (F'2023 15.5.2.12p4)
+ if (auto dummySize{evaluate::ToInt64(evaluate::Fold(foldingContext,
+ evaluate::GetSize(evaluate::Shape{dummy.type.shape()})))}) {
+ auto dummyChars{*dummySize * *dummyLength};
+ if (actualType.Rank() == 0) {
+ evaluate::DesignatorFolder folder{
+ context.foldingContext(), /*getLastComponent=*/true};
+ if (auto actualOffset{folder.FoldDesignator(actual)}) {
+ std::int64_t actualChars{*actualLength};
+ if (static_cast<std::size_t>(actualOffset->offset()) >=
+ actualOffset->symbol().size() ||
+ !evaluate::IsContiguous(
+ actualOffset->symbol(), foldingContext)) {
+ // If substring, take rest of substring
+ if (*actualLength > 0) {
+ actualChars -=
+ (actualOffset->offset() / actualType.type().kind()) %
+ *actualLength;
+ }
+ } else {
+ actualChars = (static_cast<std::int64_t>(
+ actualOffset->symbol().size()) -
+ actualOffset->offset()) /
+ actualType.type().kind();
+ }
+ if (actualChars < dummyChars) {
+ auto msg{
+ "Actual argument has fewer characters remaining in storage sequence (%jd) than %s (%jd)"_warn_en_US};
+ if (extentErrors) {
+ msg.set_severity(parser::Severity::Error);
+ }
+ messages.Say(std::move(msg),
+ static_cast<std::intmax_t>(actualChars), dummyName,
+ static_cast<std::intmax_t>(dummyChars));
+ }
+ }
+ } else { // actual.type.Rank() > 0
+ if (auto actualSize{evaluate::ToInt64(evaluate::Fold(
+ foldingContext,
+ evaluate::GetSize(evaluate::Shape(actualType.shape()))))};
+ actualSize &&
+ *actualSize * *actualLength < *dummySize * *dummyLength) {
+ auto msg{
+ "Actual argument array has fewer characters (%jd) than %s array (%jd)"_warn_en_US};
+ if (extentErrors) {
+ msg.set_severity(parser::Severity::Error);
+ }
+ messages.Say(std::move(msg),
+ static_cast<std::intmax_t>(*actualSize * *actualLength),
+ dummyName,
+ static_cast<std::intmax_t>(*dummySize * *dummyLength));
+ }
}
}
- if (!isVariable) {
- auto converted{ConvertToType(dummy.type.type(), std::move(actual))};
- CHECK(converted);
- actual = std::move(*converted);
- actualType.set_LEN(SubscriptIntExpr{*dummyLength});
+ } else if (*actualLength != *dummyLength) {
+ // Not using storage sequence association, and the lengths don't
+ // match.
+ if (!canAssociate) {
+ // F'2023 15.5.2.5 paragraph 4
+ messages.Say(
+ "Actual argument variable length '%jd' does not match the expected length '%jd'"_err_en_US,
+ *actualLength, *dummyLength);
+ } else if (*actualLength < *dummyLength) {
+ CHECK(dummy.type.Rank() == 0);
+ bool isVariable{evaluate::IsVariable(actual)};
+ if (context.ShouldWarn(
+ common::UsageWarning::ShortCharacterActual)) {
+ if (isVariable) {
+ messages.Say(
+ "Actual argument variable length '%jd' is less than expected length '%jd'"_warn_en_US,
+ *actualLength, *dummyLength);
+ } else {
+ messages.Say(
+ "Actual argument expression length '%jd' is less than expected length '%jd'"_warn_en_US,
+ *actualLength, *dummyLength);
+ }
+ }
+ if (!isVariable) {
+ auto converted{
+ ConvertToType(dummy.type.type(), std::move(actual))};
+ CHECK(converted);
+ actual = std::move(*converted);
+ actualType.set_LEN(SubscriptIntExpr{*dummyLength});
+ }
}
}
}
@@ -201,7 +275,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
// Basic type & rank checking
parser::ContextualMessages &messages{foldingContext.messages()};
- CheckCharacterActual(actual, dummy, actualType, context, messages);
+ CheckCharacterActual(
+ actual, dummy, actualType, context, messages, extentErrors, dummyName);
bool dummyIsAllocatable{
dummy.attrs.test(characteristics::DummyDataObject::Attr::Allocatable)};
bool dummyIsPointer{
@@ -221,8 +296,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
bool typesCompatible{typesCompatibleWithIgnoreTKR ||
dummy.type.type().IsTkCompatibleWith(actualType.type())};
- if (!typesCompatible && dummy.type.Rank() == 0 &&
- allowActualArgumentConversions) {
+ int dummyRank{dummy.type.Rank()};
+ if (!typesCompatible && dummyRank == 0 && allowActualArgumentConversions) {
// Extension: pass Hollerith literal to scalar as if it had been BOZ
if (auto converted{evaluate::HollerithToBOZ(
foldingContext, actual, dummy.type.type())}) {
@@ -238,7 +313,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
} else if (dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedRank)) {
} else if (dummy.ignoreTKR.test(common::IgnoreTKR::Rank)) {
- } else if (dummy.type.Rank() > 0 && !dummyIsAllocatableOrPointer &&
+ } else if (dummyRank > 0 && !dummyIsAllocatableOrPointer &&
!dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedShape) &&
!dummy.type.attrs().test(
@@ -364,7 +439,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
const ObjectEntityDetails *actualLastObject{actualLastSymbol
? actualLastSymbol->detailsIf<ObjectEntityDetails>()
: nullptr};
- int actualRank{evaluate::GetRank(actualType.shape())};
+ int actualRank{actualType.Rank()};
bool actualIsPointer{evaluate::IsObjectPointer(actual, foldingContext)};
bool dummyIsAssumedRank{dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedRank)};
@@ -381,59 +456,111 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
"Assumed-size array may not be associated with assumed-shape %s"_err_en_US,
dummyName);
}
- } else if (actualRank == 0 && dummy.type.Rank() > 0 &&
- !dummyIsAllocatableOrPointer) {
- // Actual is scalar, dummy is an array. 15.5.2.4(14), 15.5.2.11
- if (actualIsCoindexed) {
- messages.Say(
- "Coindexed scalar actual argument must be associated with a scalar %s"_err_en_US,
- dummyName);
- }
- bool actualIsArrayElement{IsArrayElement(actual)};
- bool actualIsCKindCharacter{
- actualType.type().category() == TypeCategory::Character &&
- actualType.type().kind() == 1};
- if (!actualIsCKindCharacter) {
- if (!actualIsArrayElement &&
- !(dummy.type.type().IsAssumedType() && dummyIsAssumedSize) &&
- !dummyIsAssumedRank &&
- !dummy.ignoreTKR.test(common::IgnoreTKR::Rank)) {
- messages.Say(
- "Whole scalar actual argument may not be associated with a %s array"_err_en_US,
- dummyName);
- }
- if (actualIsPolymorphic) {
+ } else if (dummyRank > 0) {
+ bool basicError{false};
+ if (actualRank == 0 && !dummyIsAllocatableOrPointer) {
+ // Actual is scalar, dummy is an array. F'2023 15.5.2.5p14
+ if (actualIsCoindexed) {
+ basicError = true;
messages.Say(
- "Polymorphic scalar may not be associated with a %s array"_err_en_US,
+ "Coindexed scalar actual argument must be associated with a scalar %s"_err_en_US,
dummyName);
}
- if (actualIsArrayElement && actualLastSymbol &&
- IsPointer(*actualLastSymbol)) {
- messages.Say(
- "Element of pointer array may not be associated with a %s array"_err_en_US,
- dummyName);
- }
- if (actualLastSymbol && IsAssumedShape(*actualLastSymbol)) {
- messages.Say(
- "Element of assumed-shape array may not be associated with a %s array"_err_en_US,
- dummyName);
+ bool actualIsArrayElement{IsArrayElement(actual)};
+ bool actualIsCKindCharacter{
+ actualType.type().category() == TypeCategory::Character &&
+ actualType.type().kind() == 1};
+ if (!actualIsCKindCharacter) {
+ if (!actualIsArrayElement &&
+ !(dummy.type.type().IsAssumedType() && dummyIsAssumedSize) &&
+ !dummyIsAssumedRank &&
+ !dummy.ignoreTKR.test(common::IgnoreTKR::Rank)) {
+ basicError = true;
+ messages.Say(
+ "Whole scalar actual argument may not be associated with a %s array"_err_en_US,
+ dummyName);
+ }
+ if (actualIsPolymorphic) {
+ basicError = true;
+ messages.Say(
+ "Polymorphic scalar may not be associated with a %s array"_err_en_US,
+ dummyName);
+ }
+ if (actualIsArrayElement && actualLastSymbol &&
+ IsPointer(*actualLastSymbol)) {
+ basicError = true;
+ messages.Say(
+ "Element of pointer array may not be associated with a %s array"_err_en_US,
+ dummyName);
+ }
+ if (actualLastSymbol && IsAssumedShape(*actualLastSymbol)) {
+ basicError = true;
+ messages.Say(
+ "Element of assumed-shape array may not be associated with a %s array"_err_en_US,
+ dummyName);
+ }
}
}
- } else if (actualRank > 0 && dummy.type.Rank() > 0 &&
- actualType.type().category() != TypeCategory::Character) {
- // Both arrays, dummy is not assumed-shape, not character
- if (auto dummySize{evaluate::ToInt64(evaluate::Fold(foldingContext,
- evaluate::GetSize(evaluate::Shape{dummy.type.shape()})))}) {
- if (auto actualSize{evaluate::ToInt64(evaluate::Fold(foldingContext,
- evaluate::GetSize(evaluate::Shape{actualType.shape()})))}) {
- if (*actualSize < *dummySize) {
- auto msg{
- "Actual argument array is smaller (%jd element(s)) than %s array (%jd)"_warn_en_US};
- if (extentErrors) {
- msg.set_severity(parser::Severity::Error);
+ // Storage sequence association (F'2023 15.5.2.12p3) checks.
+ // Character storage sequence association is checked in
+ // CheckCharacterActual().
+ if (!basicError &&
+ actualType.type().category() != TypeCategory::Character &&
+ CanAssociateWithStorageSequence(dummy) &&
+ !dummy.attrs.test(
+ characteristics::DummyDataObject::Attr::DeducedFromActual)) {
+ if (auto dummySize{evaluate::ToInt64(evaluate::Fold(foldingContext,
+ evaluate::GetSize(evaluate::Shape{dummy.type.shape()})))}) {
+ if (actualRank == 0) {
+ if (evaluate::IsArrayElement(actual)) {
+ // Actual argument is a scalar array element
+ evaluate::DesignatorFolder folder{
+ context.foldingContext(), /*getLastComponent=*/true};
+ if (auto actualOffset{folder.FoldDesignator(actual)}) {
+ std::optional<std::int64_t> actualElements;
+ if (static_cast<std::size_t>(actualOffset->offset()) >=
+ actualOffset->symbol().size() ||
+ !evaluate::IsContiguous(
+ actualOffset->symbol(), foldingContext)) {
+ actualElements = 1;
+ } else if (auto actualSymType{evaluate::DynamicType::From(
+ actualOffset->symbol())}) {
+ if (auto actualSymTypeBytes{
+ evaluate::ToInt64(evaluate::Fold(foldingContext,
+ actualSymType->MeasureSizeInBytes(
+ foldingContext, false)))};
+ actualSymTypeBytes && *actualSymTypeBytes > 0) {
+ actualElements = (static_cast<std::int64_t>(
+ actualOffset->symbol().size()) -
+ actualOffset->offset()) /
+ *actualSymTypeBytes;
+ }
+ }
+ if (actualElements && *actualElements < *dummySize) {
+ auto msg{
+ "Actual argument has fewer elements remaining in storage sequence (%jd) than %s array (%jd)"_warn_en_US};
+ if (extentErrors) {
+ msg.set_severity(parser::Severity::Error);
+ }
+ messages.Say(std::move(msg),
+ static_cast<std::intmax_t>(*actualElements), dummyName,
+ static_cast<std::intmax_t>(*dummySize));
+ }
+ }
+ }
+ } else { // actualRank > 0
+ if (auto actualSize{evaluate::ToInt64(evaluate::Fold(foldingContext,
+ evaluate::GetSize(evaluate::Shape(actualType.shape()))))};
+ actualSize && *actualSize < *dummySize) {
+ auto msg{
+ "Actual argument array has fewer elements (%jd) than %s array (%jd)"_warn_en_US};
+ if (extentErrors) {
+ msg.set_severity(parser::Severity::Error);
+ }
+ messages.Say(std::move(msg),
+ static_cast<std::intmax_t>(*actualSize), dummyName,
+ static_cast<std::intmax_t>(*dummySize));
}
- messages.Say(std::move(msg), static_cast<std::intmax_t>(*actualSize),
- dummyName, static_cast<std::intmax_t>(*dummySize));
}
}
}
@@ -626,7 +753,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
dummyName);
}
}
- if (actualRank == dummy.type.Rank() && !actualIsContiguous) {
+ if (actualRank == dummyRank && !actualIsContiguous) {
if (dummyIsContiguous) {
messages.Say(
"Actual argument associated with a CONTIGUOUS coarray %s must be simply contiguous"_err_en_US,
diff --git a/flang/test/Semantics/call33.f90 b/flang/test/Semantics/call33.f90
index 2fc017f1e444f2..285c4be98a9dbf 100644
--- a/flang/test/Semantics/call33.f90
+++ b/flang/test/Semantics/call33.f90
@@ -31,7 +31,7 @@ program test
character(4), pointer :: longptr
!WARNING: Actual argument variable length '2' is less than expected length '3'
call s1(short)
- !WARNING: Actual argument variable length '2' is less than expected length '3'
+ !ERROR: Actual argument array has fewer characters (2) than dummy argument 'x=' array (3)
call s2(shortarr)
!ERROR: Actual argument variable length '2' does not match the expected length '3'
call s3(shortarr)
diff --git a/flang/test/Semantics/call38.f90 b/flang/test/Semantics/call38.f90
new file mode 100644
index 00000000000000..0e7ebcdfe9df53
--- /dev/null
+++ b/flang/test/Semantics/call38.f90
@@ -0,0 +1,524 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror
+! Tests the checking of storage sequence argument association (F'2023 15.2.5.12)
+module nonchar
+ contains
+ subroutine scalar(a)
+ real a
+ end
+ subroutine explicit1(a)
+ real a(2)
+ end
+ subroutine explicit2(a)
+ real a(2,2)
+ end
+ subroutine assumedSize1(a)
+ real a(*)
+ end
+ subroutine assumedSize2(a)
+ real a(2,*)
+ end
+ subroutine assumedShape1(a)
+ real a(:)
+ end
+ subroutine assumedShape2(a)
+ real a(:,:)
+ end
+ subroutine assumedRank(a)
+ real a(..)
+ end
+ subroutine allocatable0(a)
+ real, allocatable :: a
+ end
+ subroutine allocatable1(a)
+ real, allocatable :: a(:)
+ end
+ subroutine allocatable2(a)
+ real, allocatable :: a(:,:)
+ end
+ subroutine pointer0(a)
+ real, intent(in), pointer :: a
+ end
+ subroutine pointer1(a)
+ real, intent(in), pointer :: a(:)
+ end
+ subroutine pointer2(a)
+ real, intent(in), pointer :: a(:,:)
+ end
+ subroutine coarray0(a)
+ real a[*]
+ end
+
+ subroutine test
+ real, target :: scalar0
+ real, target :: vector1(1), vector2(2), vector4(4)
+ real, target :: matrix11(1,1), matrix12(1,2), matrix22(2,2)
+ real, allocatable :: alloScalar, alloVector(:), alloMatrix(:,:)
+
+ call scalar(scalar0)
+ !ERROR: Rank of dummy argument is 0, but actual argument has rank 1
+ call scalar(vector1)
+ call scalar(vector1(1))
+
+ !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'a=' array
+ call explicit1(scalar0)
+ !ERROR: Actual argument array has fewer elements (1) than dummy argument 'a=' array (2)
+ call explicit1(vector1)
+ call explicit1(vector2)
+ call explicit1(vector4)
+ !ERROR: Actual argument has fewer elements remaining in storage sequence (1) than dummy argument 'a=' array (2)
+ call explicit1(vector2(2))
+ call explicit1(vector4(3))
+ !ERROR: Actual argument has fewer elements remaining in storage sequence (1) than dummy argument 'a=' array (2)
+ call explicit1(vector4(4))
+ !ERROR: Actual argument array has fewer elements (1) than dummy argument 'a=' array (2)
+ call explicit1(matrix11)
+
+ !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'a=' array
+ call explicit2(scalar0)
+ !ERROR: Actual argument array has fewer elements (1) than dummy argument 'a=' array (4)
+ call explicit2(vector1)
+ !ERROR: Actual argument array has fewer elements (2) than dummy argument 'a=' array (4)
+ call explicit2(vector2)
+ call explicit2(vector4)
+ !ERROR: Actual argument has fewer elements remaining in storage sequence (1) than dummy argument 'a=' array (4)
+ call explicit2(vector2(2))
+ !ERROR: Actual argument has fewer elements remaining in storage sequence (3) than dummy argument 'a=' array (4)
+ call explicit2(vector4(2))
+ call explicit2(vector4(1))
+ !ERROR: Actual argument array has fewer elements (1) than dummy argument 'a=' array (4)
+ call explicit2(matrix11)
+ !ERROR: Actual argument array has fewer elements (2) than dummy argument 'a=' array (4)
+ call explicit2(matrix12)
+ call explicit2(matrix22)
+ call explicit2(matrix22(1,1))
+ !ERROR: Actual argument has fewer elements remaining in storage sequence (3) than dummy argument 'a=' array (4)
+ call explicit2(matrix22(2,1))
+
+ !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'a=' array
+ call assumedSize1(scalar0)
+ call assumedSize1(vector1)
+ call assumedSize1(vector2)
+ call assumedSize1(vector4)
+ call assumedSize1(vector2(2))
+ call assumedSize1(vector4(2))
+ call assumedSize1(vector4(1))
+ call assumedSize1(matrix11)
+ call assumedSize1(matrix12)
+ call assumedSize1(matrix22)
+ call assumedSize1(matrix22(1,1))
+ call assumedSize1(matrix22(2,1))
+
+ !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'a=' array
+ call assumedSize2(scalar0)
+ call assumedSize2(vector1)
+ call assumedSize2(vector2)
+ call assumedSize2(vector4)
+ call assumedSize2(vector2(2))
+ call assumedSize2(vector4(2))
+ call assumedSize2(vector4(1))
+ call assumedSize2(matrix11)
+ call assumedSize2(matrix12)
+ call assumedSize2(matrix22)
+ call assumedSize2(matrix22(1,1))
+ call assumedSize2(matrix22(2,1))
+
+ !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'a='
+ call assumedShape1(scalar0)
+ call assumedShape1(vector1)
+ call assumedShape1(vector2)
+ call assumedShape1(vector4)
+ !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'a='
+ call assumedShape1(vector2(2))
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
+ call assumedShape1(matrix11)
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
+ call assumedShape1(matrix12)
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
+ call assumedShape1(matrix22)
+ !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'a='
+ call assumedShape1(matrix22(1,1))
+
+ !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'a='
+ call assumedShape2(scalar0)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 1
+ call assumedShape2(vector1)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 1
+ call assumedShape2(vector2)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 1
+ call assumedShape2(vector4)
+ !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'a='
+ call assumedShape2(vector2(2))
+ call assumedShape2(matrix11)
+ call assumedShape2(matrix12)
+ call assumedShape2(matrix22)
+ !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'a='
+ call assumedShape2(matrix22(1,1))
+
+ call assumedRank(scalar0)
+ call assumedRank(vector1)
+ call assumedRank(vector1(1))
+ call assumedRank(matrix11)
+ call assumedRank(matrix11(1,1))
+
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable0(scalar0)
+ call allocatable0(alloScalar)
+ !ERROR: Rank of dummy argument is 0, but actual argument has rank 1
+ call allocatable0(alloVector)
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable0(alloVector(1))
+ !ERROR: Rank of dummy argument is 0, but actual argument has rank 2
+ call allocatable0(alloMatrix)
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable0(alloMatrix(1,1))
+
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable1(scalar0)
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
+ call allocatable1(alloScalar)
+ call allocatable1(alloVector)
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable1(alloVector(1))
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
+ call allocatable1(alloMatrix)
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable1(alloMatrix(1,1))
+
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 0
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable2(scalar0)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 0
+ call allocatable2(alloScalar)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 1
+ call allocatable2(alloVector)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 0
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable2(alloVector(1))
+ call allocatable2(alloMatrix)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 0
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable2(alloMatrix(1,1))
+
+ call pointer0(scalar0)
+ !ERROR: Rank of dummy argument is 0, but actual argument has rank 1
+ !ERROR: Pointer has rank 0 but target has rank 1
+ call pointer0(vector1)
+ call pointer0(vector1(1))
+ !ERROR: Rank of dummy argument is 0, but actual argument has rank 2
+ !ERROR: Pointer has rank 0 but target has rank 2
+ call pointer0(matrix11)
+ call pointer0(matrix11(1,1))
+
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
+ !ERROR: Pointer has rank 1 but target has rank 0
+ call pointer1(scalar0)
+ call pointer1(vector1)
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
+ !ERROR: Pointer has rank 1 but target has rank 0
+ call pointer1(vector1(1))
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
+ !ERROR: Pointer has rank 1 but target has rank 2
+ call pointer1(matrix11)
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
+ !ERROR: Pointer has rank 1 but target has rank 0
+ call pointer1(matrix11(1,1))
+
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 0
+ !ERROR: Pointer has rank 2 but target has rank 0
+ call pointer2(scalar0)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 1
+ !ERROR: Pointer has rank 2 but target has rank 1
+ call pointer2(vector1)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 0
+ !ERROR: Pointer has rank 2 but target has rank 0
+ call pointer2(vector1(1))
+ call pointer2(matrix11)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 0
+ !ERROR: Pointer has rank 2 but target has rank 0
+ call pointer2(matrix11(1,1))
+
+ !ERROR: Actual argument associated with coarray dummy argument 'a=' must be a coarray
+ call coarray0(scalar0)
+ !ERROR: Rank of dummy argument is 0, but actual argument has rank 1
+ !ERROR: Actual argument associated with coarray dummy argument 'a=' must be a coarray
+ call coarray0(vector1)
+ !ERROR: Actual argument associated with coarray dummy argument 'a=' must be a coarray
+ call coarray0(vector1(1))
+ !ERROR: Rank of dummy argument is 0, but actual argument has rank 2
+ !ERROR: Actual argument associated with coarray dummy argument 'a=' must be a coarray
+ call coarray0(matrix11)
+ !ERROR: Actual argument associated with coarray dummy argument 'a=' must be a coarray
+ call coarray0(matrix11(1,1))
+ end
+end
+
+module char
+ contains
+ subroutine scalar(a)
+ character(2) a
+ end
+ subroutine explicit1(a)
+ character(2) a(2)
+ end
+ subroutine explicit2(a)
+ character(2) a(2,2)
+ end
+ subroutine assumedSize1(a)
+ character(2) a(*)
+ end
+ subroutine assumedSize2(a)
+ character(2) a(2,*)
+ end
+ subroutine assumedShape1(a)
+ character(2) a(:)
+ end
+ subroutine assumedShape2(a)
+ character(2) a(:,:)
+ end
+ subroutine assumedRank(a)
+ character(2) a(..)
+ end
+ subroutine allocatable0(a)
+ character(2), allocatable :: a
+ end
+ subroutine allocatable1(a)
+ character(2), allocatable :: a(:)
+ end
+ subroutine allocatable2(a)
+ character(2), allocatable :: a(:,:)
+ end
+ subroutine pointer0(a)
+ character(2), intent(in), pointer :: a
+ end
+ subroutine pointer1(a)
+ character(2), intent(in), pointer :: a(:)
+ end
+ subroutine pointer2(a)
+ character(2), intent(in), pointer :: a(:,:)
+ end
+ subroutine coarray0(a)
+ character(2) a[*]
+ end
+
+ subroutine test
+ character(2), target :: scalar0
+ character(2), target :: vector1(1), vector2(2), vector4(4)
+ character(2), target :: matrix11(1,1), matrix12(1,2), matrix22(2,2)
+ character(2), allocatable :: alloScalar, alloVector(:), alloMatrix(:,:)
+
+ call scalar(scalar0)
+ !ERROR: Rank of dummy argument is 0, but actual argument has rank 1
+ call scalar(vector1)
+ call scalar(vector1(1))
+
+ !ERROR: Actual argument has fewer characters remaining in storage sequence (2) than dummy argument 'a=' (4)
+ call explicit1(scalar0)
+ !ERROR: Actual argument array has fewer characters (2) than dummy argument 'a=' array (4)
+ call explicit1(vector1)
+ call explicit1(vector2)
+ call explicit1(vector4)
+ !ERROR: Actual argument has fewer characters remaining in storage sequence (2) than dummy argument 'a=' (4)
+ call explicit1(vector2(2))
+ !ERROR: Actual argument has fewer characters remaining in storage sequence (3) than dummy argument 'a=' (4)
+ call explicit1(vector2(1)(2:2))
+ call explicit1(vector4(3))
+ !ERROR: Actual argument has fewer characters remaining in storage sequence (2) than dummy argument 'a=' (4)
+ call explicit1(vector4(4))
+ !ERROR: Actual argument array has fewer characters (2) than dummy argument 'a=' array (4)
+ call explicit1(matrix11)
+ call explicit1(matrix12)
+ call explicit1(matrix12(1,1))
+ !ERROR: Actual argument has fewer characters remaining in storage sequence (3) than dummy argument 'a=' (4)
+ call explicit1(matrix12(1,1)(2:2))
+ !ERROR: Actual argument has fewer characters remaining in storage sequence (2) than dummy argument 'a=' (4)
+ call explicit1(matrix12(1,2))
+
+ !ERROR: Actual argument has fewer characters remaining in storage sequence (2) than dummy argument 'a=' (8)
+ call explicit2(scalar0)
+ !ERROR: Actual argument array has fewer characters (2) than dummy argument 'a=' array (8)
+ call explicit2(vector1)
+ !ERROR: Actual argument array has fewer characters (4) than dummy argument 'a=' array (8)
+ call explicit2(vector2)
+ call explicit2(vector4)
+ !ERROR: Actual argument has fewer characters remaining in storage sequence (2) than dummy argument 'a=' (8)
+ call explicit2(vector2(2))
+ !ERROR: Actual argument has fewer characters remaining in storage sequence (6) than dummy argument 'a=' (8)
+ call explicit2(vector4(2))
+ call explicit2(vector4(1))
+ !ERROR: Actual argument array has fewer characters (2) than dummy argument 'a=' array (8)
+ call explicit2(matrix11)
+ !ERROR: Actual argument array has fewer characters (4) than dummy argument 'a=' array (8)
+ call explicit2(matrix12)
+ call explicit2(matrix22)
+ call explicit2(matrix22(1,1))
+ !ERROR: Actual argument has fewer characters remaining in storage sequence (7) than dummy argument 'a=' (8)
+ call explicit2(matrix22(1,1)(2:2))
+ !ERROR: Actual argument has fewer characters remaining in storage sequence (6) than dummy argument 'a=' (8)
+ call explicit2(matrix22(2,1))
+
+ call assumedSize1(scalar0)
+ call assumedSize1(vector1)
+ call assumedSize1(vector2)
+ call assumedSize1(vector4)
+ call assumedSize1(vector2(2))
+ call assumedSize1(vector4(2))
+ call assumedSize1(vector4(1))
+ call assumedSize1(matrix11)
+ call assumedSize1(matrix12)
+ call assumedSize1(matrix22)
+ call assumedSize1(matrix22(1,1))
+ call assumedSize1(matrix22(2,1))
+
+ call assumedSize2(scalar0)
+ call assumedSize2(vector1)
+ call assumedSize2(vector2)
+ call assumedSize2(vector4)
+ call assumedSize2(vector2(2))
+ call assumedSize2(vector4(2))
+ call assumedSize2(vector4(1))
+ call assumedSize2(matrix11)
+ call assumedSize2(matrix12)
+ call assumedSize2(matrix22)
+ call assumedSize2(matrix22(1,1))
+ call assumedSize2(matrix22(2,1))
+
+ !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'a='
+ call assumedShape1(scalar0)
+ call assumedShape1(vector1)
+ call assumedShape1(vector2)
+ call assumedShape1(vector4)
+ !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'a='
+ call assumedShape1(vector2(2))
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
+ call assumedShape1(matrix11)
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
+ call assumedShape1(matrix12)
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
+ call assumedShape1(matrix22)
+ !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'a='
+ call assumedShape1(matrix22(1,1))
+
+ !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'a='
+ call assumedShape2(scalar0)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 1
+ call assumedShape2(vector1)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 1
+ call assumedShape2(vector2)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 1
+ call assumedShape2(vector4)
+ !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'a='
+ call assumedShape2(vector2(2))
+ call assumedShape2(matrix11)
+ call assumedShape2(matrix12)
+ call assumedShape2(matrix22)
+ !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'a='
+ call assumedShape2(matrix22(1,1))
+
+ call assumedRank(scalar0)
+ call assumedRank(vector1)
+ call assumedRank(vector1(1))
+ call assumedRank(matrix11)
+ call assumedRank(matrix11(1,1))
+
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable0(scalar0)
+ call allocatable0(alloScalar)
+ !ERROR: Rank of dummy argument is 0, but actual argument has rank 1
+ call allocatable0(alloVector)
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable0(alloVector(1))
+ !ERROR: Rank of dummy argument is 0, but actual argument has rank 2
+ call allocatable0(alloMatrix)
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable0(alloMatrix(1,1))
+
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable1(scalar0)
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
+ call allocatable1(alloScalar)
+ call allocatable1(alloVector)
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable1(alloVector(1))
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
+ call allocatable1(alloMatrix)
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable1(alloMatrix(1,1))
+
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 0
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable2(scalar0)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 0
+ call allocatable2(alloScalar)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 1
+ call allocatable2(alloVector)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 0
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable2(alloVector(1))
+ call allocatable2(alloMatrix)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 0
+ !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument
+ call allocatable2(alloMatrix(1,1))
+
+ call pointer0(scalar0)
+ !ERROR: Rank of dummy argument is 0, but actual argument has rank 1
+ !ERROR: Pointer has rank 0 but target has rank 1
+ call pointer0(vector1)
+ call pointer0(vector1(1))
+ !ERROR: Rank of dummy argument is 0, but actual argument has rank 2
+ !ERROR: Pointer has rank 0 but target has rank 2
+ call pointer0(matrix11)
+ call pointer0(matrix11(1,1))
+
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
+ !ERROR: Pointer has rank 1 but target has rank 0
+ call pointer1(scalar0)
+ call pointer1(vector1)
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
+ !ERROR: Pointer has rank 1 but target has rank 0
+ call pointer1(vector1(1))
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
+ !ERROR: Pointer has rank 1 but target has rank 2
+ call pointer1(matrix11)
+ !ERROR: Rank of dummy argument is 1, but actual argument has rank 0
+ !ERROR: Pointer has rank 1 but target has rank 0
+ call pointer1(matrix11(1,1))
+
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 0
+ !ERROR: Pointer has rank 2 but target has rank 0
+ call pointer2(scalar0)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 1
+ !ERROR: Pointer has rank 2 but target has rank 1
+ call pointer2(vector1)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 0
+ !ERROR: Pointer has rank 2 but target has rank 0
+ call pointer2(vector1(1))
+ call pointer2(matrix11)
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 0
+ !ERROR: Pointer has rank 2 but target has rank 0
+ call pointer2(matrix11(1,1))
+
+ !ERROR: Actual argument associated with coarray dummy argument 'a=' must be a coarray
+ call coarray0(scalar0)
+ !ERROR: Rank of dummy argument is 0, but actual argument has rank 1
+ !ERROR: Actual argument associated with coarray dummy argument 'a=' must be a coarray
+ call coarray0(vector1)
+ !ERROR: Actual argument associated with coarray dummy argument 'a=' must be a coarray
+ call coarray0(vector1(1))
+ !ERROR: Rank of dummy argument is 0, but actual argument has rank 2
+ !ERROR: Actual argument associated with coarray dummy argument 'a=' must be a coarray
+ call coarray0(matrix11)
+ !ERROR: Actual argument associated with coarray dummy argument 'a=' must be a coarray
+ call coarray0(matrix11(1,1))
+
+ !WARNING: Actual argument variable length '1' is less than expected length '2'
+ call scalar(scalar0(1:1))
+ !WARNING: Actual argument expression length '1' is less than expected length '2'
+ call scalar('a')
+ end
+end
diff --git a/flang/test/Semantics/ignore_tkr01.f90 b/flang/test/Semantics/ignore_tkr01.f90
index 39676e8b6129b5..bc1d5c8548c998 100644
--- a/flang/test/Semantics/ignore_tkr01.f90
+++ b/flang/test/Semantics/ignore_tkr01.f90
@@ -201,7 +201,7 @@ program test
call t4(x)
call t4(m)
call t5(x)
- !WARNING: Actual argument array is smaller (2 element(s)) than dummy argument 'm=' array (4)
+ !WARNING: Actual argument array has fewer elements (2) than dummy argument 'm=' array (4)
call t5(a)
call t6(1)
More information about the flang-commits
mailing list