diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h --- a/flang/include/flang/Evaluate/characteristics.h +++ b/flang/include/flang/Evaluate/characteristics.h @@ -199,8 +199,11 @@ // 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; + 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 @@ const semantics::Symbol &, FoldingContext &); bool CanBePassedViaImplicitInterface() const; llvm::raw_ostream &Dump(llvm::raw_ostream &) const; + TypeAndShape type; std::vector> 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 --- a/flang/include/flang/Evaluate/fold-designator.h +++ b/flang/include/flang/Evaluate/fold-designator.h @@ -60,7 +60,8 @@ // 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 @@ } template - std::optional FoldDesignator(const A &x, ConstantSubscript) { + std::optional FoldDesignator(const A &, ConstantSubscript) { return std::nullopt; } @@ -157,6 +158,7 @@ } 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 --- a/flang/lib/Evaluate/characteristics.cpp +++ b/flang/lib/Evaluate/characteristics.cpp @@ -336,7 +336,8 @@ } } } - 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 @@ return common::visit( common::visitors{ [&](const BOZLiteralConstant &) { - return std::make_optional(std::move(name), - DummyDataObject{ - TypeAndShape{DynamicType::TypelessIntrinsicArgument()}}); + DummyDataObject obj{ + TypeAndShape{DynamicType::TypelessIntrinsicArgument()}}; + obj.attrs.set(DummyDataObject::Attr::DeducedFromActual); + return std::make_optional( + std::move(name), std::move(obj)); }, [&](const NullPointer &) { - return std::make_optional(std::move(name), - DummyDataObject{ - TypeAndShape{DynamicType::TypelessIntrinsicArgument()}}); + DummyDataObject obj{ + TypeAndShape{DynamicType::TypelessIntrinsicArgument()}}; + obj.attrs.set(DummyDataObject::Attr::DeducedFromActual); + return std::make_optional( + std::move(name), std::move(obj)); }, [&](const ProcedureDesignator &designator) { if (auto proc{Procedure::Characterize(designator, context)}) { @@ -802,8 +807,10 @@ }, [&](const auto &) { if (auto type{TypeAndShape::Characterize(expr, context)}) { + DummyDataObject obj{std::move(*type)}; + obj.attrs.set(DummyDataObject::Attr::DeducedFromActual); return std::make_optional( - std::move(name), DummyDataObject{std::move(*type)}); + std::move(name), std::move(obj)); } else { return std::optional{}; } diff --git a/flang/lib/Evaluate/fold-designator.cpp b/flang/lib/Evaluate/fold-designator.cpp --- a/flang/lib/Evaluate/fold-designator.cpp +++ b/flang/lib/Evaluate/fold-designator.cpp @@ -15,7 +15,7 @@ std::optional 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 DesignatorFolder::FoldDesignator( const Component &component, ConstantSubscript which) { const Symbol &comp{component.GetLastSymbol()}; - const DataRef &base{component.base()}; - std::optional 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 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 --- 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 @@ } } +// 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 CheckCharacterActual(evaluate::Expr &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(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( + 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(actualChars), dummyName, + static_cast(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(*actualSize * *actualLength), + dummyName, + static_cast(*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 @@ // 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 @@ } 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 @@ } 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 @@ const ObjectEntityDetails *actualLastObject{actualLastSymbol ? actualLastSymbol->detailsIf() : 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 @@ "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 actualElements; + if (static_cast(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( + 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(*actualElements), dummyName, + static_cast(*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(*actualSize), dummyName, + static_cast(*dummySize)); } - messages.Say(std::move(msg), static_cast(*actualSize), - dummyName, static_cast(*dummySize)); } } } @@ -626,7 +753,7 @@ 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 --- a/flang/test/Semantics/call33.f90 +++ b/flang/test/Semantics/call33.f90 @@ -31,7 +31,7 @@ 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 --- /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 --- a/flang/test/Semantics/ignore_tkr01.f90 +++ b/flang/test/Semantics/ignore_tkr01.f90 @@ -201,7 +201,7 @@ 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)