From: peter klausler Date: Wed, 16 Oct 2019 18:53:03 +0000 (-0700) Subject: [flang] Revert to returning default INTEGER for LEN() and offset-in-CHARACTER intrins... X-Git-Tag: llvmorg-12-init~9537^2~450 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=4abdc30b6302e5ae0ad148fc374dac6b0c2d6500;p=platform%2Fupstream%2Fllvm.git [flang] Revert to returning default INTEGER for LEN() and offset-in-CHARACTER intrinsics; further shape analysis of intrinsic results Original-commit: flang-compiler/f18@561f5965b2309df3cd15d7e2a96d7e73f2f76e35 Reviewed-on: https://github.com/flang-compiler/f18/pull/782 Tree-same-pre-rewrite: false --- diff --git a/flang/documentation/Extensions.md b/flang/documentation/Extensions.md index 91c6dfc..745a64a 100644 --- a/flang/documentation/Extensions.md +++ b/flang/documentation/Extensions.md @@ -20,8 +20,9 @@ Intentional violations of the standard rule imposes an artificially small constraint in some cases where Fortran mandates that something have the default `INTEGER` type: specifically, the results of references to the intrinsic functions - `LEN`, `SIZE`, `LBOUND`, `UBOUND`, and `SHAPE`. We return - `INTEGER(KIND=8)` in these cases. + `SIZE`, `LBOUND`, `UBOUND`, `SHAPE`, and the location reductions + `FINDLOC`, `MAXLOC`, and `MINLOC`. We return `INTEGER(KIND=8)` by + default in these cases. Extensions, deletions, and legacy features supported by default =============================================================== diff --git a/flang/lib/evaluate/intrinsics.cc b/flang/lib/evaluate/intrinsics.cc index 885f74b..b259ab1 100644 --- a/flang/lib/evaluate/intrinsics.cc +++ b/flang/lib/evaluate/intrinsics.cc @@ -445,7 +445,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {"index", {{"string", SameChar}, {"substring", SameChar}, {"back", AnyLogical, Rank::scalar, Optionality::optional}, - SubscriptDefaultKIND}, + DefaultingKIND}, KINDInt}, {"int", {{"a", AnyNumeric, Rank::elementalOrBOZ}, DefaultingKIND}, KINDInt}, {"int_ptr_kind", {}, DefaultInt, Rank::scalar}, @@ -467,9 +467,9 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {{"array", AnyData, Rank::anyOrAssumedRank}, SubscriptDefaultKIND}, KINDInt, Rank::vector}, {"leadz", {{"i", AnyInt}}, DefaultInt}, - {"len", {{"string", AnyChar, Rank::anyOrAssumedRank}, SubscriptDefaultKIND}, + {"len", {{"string", AnyChar, Rank::anyOrAssumedRank}, DefaultingKIND}, KINDInt, Rank::scalar}, - {"len_trim", {{"string", AnyChar}, SubscriptDefaultKIND}, KINDInt}, + {"len_trim", {{"string", AnyChar}, DefaultingKIND}, KINDInt}, {"lge", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical}, {"lgt", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical}, {"lle", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical}, @@ -618,7 +618,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {"scan", {{"string", SameChar}, {"set", SameChar}, {"back", AnyLogical, Rank::elemental, Optionality::optional}, - SubscriptDefaultKIND}, + DefaultingKIND}, KINDInt}, {"selected_char_kind", {{"name", DefaultChar, Rank::scalar}}, DefaultInt, Rank::scalar}, @@ -695,7 +695,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {"verify", {{"string", SameChar}, {"set", SameChar}, {"back", AnyLogical, Rank::elemental, Optionality::optional}, - SubscriptDefaultKIND}, + DefaultingKIND}, KINDInt}, }; diff --git a/flang/lib/evaluate/shape.cc b/flang/lib/evaluate/shape.cc index a74dfca..5e2d70d 100644 --- a/flang/lib/evaluate/shape.cc +++ b/flang/lib/evaluate/shape.cc @@ -475,6 +475,32 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result { const auto *expr{call.arguments().front().value().UnwrapExpr()}; CHECK(expr != nullptr); return Shape{MaybeExtentExpr{ExtentExpr{expr->Rank()}}}; + } else if (intrinsic->name == "all" || intrinsic->name == "any" || + intrinsic->name == "count" || intrinsic->name == "iall" || + intrinsic->name == "iany" || intrinsic->name == "iparity" || + intrinsic->name == "maxloc" || intrinsic->name == "maxval" || + intrinsic->name == "minloc" || intrinsic->name == "minval" || + intrinsic->name == "norm2" || intrinsic->name == "parity" || + intrinsic->name == "product" || intrinsic->name == "sum") { + // Reduction with DIM= + if (call.arguments().size() >= 2) { + auto arrayShape{ + (*this)(UnwrapExpr>(call.arguments().at(0)))}; + const auto *dimArg{UnwrapExpr>(call.arguments().at(1))}; + if (arrayShape.has_value() && dimArg != nullptr) { + if (auto dim{ToInt64(*dimArg)}) { + if (*dim >= 1 && + static_cast(*dim) <= arrayShape->size()) { + arrayShape->erase(arrayShape->begin() + (*dim - 1)); + return std::move(*arrayShape); + } + } + } + } + } else if (intrinsic->name == "cshift" || intrinsic->name == "eoshift") { + if (!call.arguments().empty()) { + return (*this)(call.arguments()[0]); + } } else if (intrinsic->name == "reshape") { if (call.arguments().size() >= 2 && call.arguments().at(1).has_value()) { // SHAPE(RESHAPE(array,shape)) -> shape @@ -484,19 +510,6 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result { return AsShape(context_, ConvertToType(std::move(shape))); } } - } else if (intrinsic->name == "transpose") { - if (call.arguments().size() >= 1) { - if (auto shape{(*this)(call.arguments().at(0))}) { - if (shape->size() == 2) { - std::swap((*shape)[0], (*shape)[1]); - return shape; - } - } - } - } else if (intrinsic->name == "cshift" || intrinsic->name == "eoshift") { - if (!call.arguments().empty()) { - return (*this)(call.arguments()[0]); - } } else if (intrinsic->name == "spread") { // SHAPE(SPREAD(ARRAY,DIM,NCOPIES)) = SHAPE(ARRAY) with NCOPIES inserted // at position DIM. @@ -517,6 +530,15 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result { } } } + } else if (intrinsic->name == "transpose") { + if (call.arguments().size() >= 1) { + if (auto shape{(*this)(call.arguments().at(0))}) { + if (shape->size() == 2) { + std::swap((*shape)[0], (*shape)[1]); + return shape; + } + } + } } else if (intrinsic->characteristics.value().attrs.test(characteristics:: Procedure::Attr::NullPointer)) { // NULL(MOLD=) return (*this)(call.arguments()); diff --git a/flang/lib/semantics/check-call.cc b/flang/lib/semantics/check-call.cc index dee7e6b..32edfa2 100644 --- a/flang/lib/semantics/check-call.cc +++ b/flang/lib/semantics/check-call.cc @@ -18,6 +18,7 @@ #include "../evaluate/characteristics.h" #include "../evaluate/shape.h" #include "../evaluate/tools.h" +#include "../parser/characters.h" #include "../parser/message.h" #include #include @@ -110,6 +111,7 @@ static void InspectType( } static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, + const std::string &dummyName, const evaluate::Expr &actual, const characteristics::TypeAndShape &actualType, const characteristics::Procedure &proc, evaluate::FoldingContext &context, @@ -152,12 +154,14 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, if (actualIsPolymorphic && dummyIsPolymorphic && actualIsCoindexed) { // 15.5.2.4(2) messages.Say( - "Coindexed polymorphic object may not be associated with a polymorphic dummy argument"_err_en_US); + "Coindexed polymorphic object may not be associated with a polymorphic %s"_err_en_US, + dummyName); } if (actualIsPolymorphic && !dummyIsPolymorphic && actualIsAssumedSize) { // 15.5.2.4(2) messages.Say( - "Assumed-size polymorphic array may not be associated with a monomorphic dummy argument"_err_en_US); + "Assumed-size polymorphic array may not be associated with a monomorphic %s"_err_en_US, + dummyName); } // derived type actual argument checks @@ -169,18 +173,21 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, if (dummy.type.type().IsAssumedType()) { if (!derived.parameters().empty()) { // 15.5.2.4(2) messages.Say( - "Actual argument associated with TYPE(*) dummy argument may not have a parameterized derived type"_err_en_US); + "Actual argument associated with TYPE(*) %s may not have a parameterized derived type"_err_en_US, + dummyName); } if (concerns.typeBoundProcedure) { // 15.5.2.4(2) if (auto *msg{messages.Say( - "Actual argument associated with TYPE(*) dummy argument may not have type-bound procedures"_err_en_US)}) { + "Actual argument associated with TYPE(*) %s may not have type-bound procedures"_err_en_US, + dummyName)}) { msg->Attach(concerns.typeBoundProcedure->name(), "Declaration of type-bound procedure"_en_US); } } if (concerns.finalProcedure) { // 15.5.2.4(2) if (auto *msg{messages.Say( - "Actual argument associated with TYPE(*) dummy argument may not have FINAL procedures"_err_en_US)}) { + "Actual argument associated with TYPE(*) %s may not have FINAL procedures"_err_en_US, + dummyName)}) { msg->Attach(concerns.finalProcedure->name(), "Declaration of FINAL procedure"_en_US); } @@ -190,7 +197,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, dummy.intent != common::Intent::In && !dummyIsValue) { // 15.5.2.4(6) if (auto *msg{messages.Say( - "Coindexed actual argument with ALLOCATABLE ultimate component must be associated with a dummy argument with VALUE or INTENT(IN) attributes"_err_en_US)}) { + "Coindexed actual argument with ALLOCATABLE ultimate component must be associated with a %s with VALUE or INTENT(IN) attributes"_err_en_US, + dummyName)}) { msg->Attach(concerns.allocatable->name(), "Declaration of ALLOCATABLE component"_en_US); } @@ -198,7 +206,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, if (concerns.coarray && actualIsVolatile != dummyIsVolatile) { // 15.5.2.4(22) if (auto *msg{messages.Say( - "VOLATILE attributes must match when actual argument has a coarray ultimate component"_err_en_US)}) { + "VOLATILE attribute must match for %s when actual argument has a coarray ultimate component"_err_en_US, + dummyName)}) { msg->Attach( concerns.coarray->name(), "Declaration of coarray component"_en_US); } @@ -216,11 +225,13 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, // 15.5.2.4(16) if (actualRank == 0) { messages.Say( - "Scalar actual argument may not be associated with assumed-shape dummy argument"_err_en_US); + "Scalar actual argument may not be associated with assumed-shape %s"_err_en_US, + dummyName); } if (actualIsAssumedSize) { if (auto *msg{messages.Say( - "Assumed-size array may not be associated with assumed-shape dummy argument"_err_en_US)}) { + "Assumed-size array may not be associated with assumed-shape %s"_err_en_US, + dummyName)}) { msg->Attach(actualLastSymbol->name(), "Declaration of assumed-size array actual argument"_en_US); } @@ -229,24 +240,29 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, // 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 dummy argument"_err_en_US); + "Coindexed scalar actual argument must be associated with a scalar %s"_err_en_US, + dummyName); } if (actualLastSymbol && actualLastSymbol->Rank() == 0 && !(dummy.type.type().IsAssumedType() && dummyIsAssumedSize)) { messages.Say( - "Whole scalar actual argument may not be associated with a dummy argument array"_err_en_US); + "Whole scalar actual argument may not be associated with a %s array"_err_en_US, + dummyName); } if (actualIsPolymorphic) { messages.Say( - "Element of polymorphic array may not be associated with a dummy argument array"_err_en_US); + "Element of polymorphic array may not be associated with a %s array"_err_en_US, + dummyName); } if (actualLastSymbol && actualLastSymbol->attrs().test(Attr::POINTER)) { messages.Say( - "Element of pointer array may not be associated with a dummy argument array"_err_en_US); + "Element of pointer array may not be associated with a %s array"_err_en_US, + dummyName); } if (actualLastObject && actualLastObject->IsAssumedShape()) { messages.Say( - "Element of assumed-shape array may not be associated with a dummy argument array"_err_en_US); + "Element of assumed-shape array may not be associated with a %s array"_err_en_US, + dummyName); } } @@ -279,7 +295,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, (dummyIsAsynchronous || dummyIsVolatile) && !dummyIsValue) { if (actualIsCoindexed) { // C1538 messages.Say( - "Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE"_err_en_US); + "Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with %s with ASYNCHRONOUS or VOLATILE attributes unless VALUE"_err_en_US, + dummyName); } if (actualRank > 0 && !IsSimplyContiguous(actual, context.intrinsics())) { bool dummyIsContiguous{ @@ -296,7 +313,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, !(dummyIsAssumedShape || dummyIsAssumedRank || (actualIsPointer && dummyIsPointer))) { // C1539 & C1540 messages.Say( - "ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument"_err_en_US); + "ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous %s"_err_en_US, + dummyName); } } } @@ -307,6 +325,10 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg, const characteristics::Procedure &proc, evaluate::FoldingContext &context, const Scope &scope) { auto &messages{context.messages()}; + std::string dummyName{"dummy argument"}; + if (!dummy.name.empty()) { + dummyName += " '"s + parser::ToLowerCaseLetters(dummy.name) + "='"; + } std::visit( common::visitors{ [&](const characteristics::DummyDataObject &object) { @@ -314,7 +336,7 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg, if (auto type{characteristics::TypeAndShape::Characterize( *expr, context)}) { CheckExplicitDataArg( - object, *expr, *type, proc, context, scope); + object, dummyName, *expr, *type, proc, context, scope); } else if (object.type.type().IsTypelessIntrinsicArgument() && std::holds_alternative( expr->u)) { @@ -327,8 +349,8 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg, // An assumed-type dummy is being forwarded. if (!object.type.type().IsAssumedType()) { messages.Say( - "Assumed-type TYPE(*) '%s' may be associated only with an assumed-TYPE(*) dummy argument"_err_en_US, - assumed->name()); + "Assumed-type TYPE(*) '%s' may be associated only with an assumed-TYPE(*) %s"_err_en_US, + assumed->name(), dummyName); } } else { messages.Say( @@ -416,9 +438,9 @@ parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc, "an actual argument in this procedure reference"_err_en_US, index); } else { - messages.Say( - "Dummy argument '%s' (#%d) is not OPTIONAL and is not associated " - "with an actual argument in this procedure reference"_err_en_US, + messages.Say("Dummy argument '%s=' (#%d) is not OPTIONAL and is not " + "associated with an actual argument in this procedure " + "reference"_err_en_US, dummy.name, index); } } diff --git a/flang/test/semantics/call03.f90 b/flang/test/semantics/call03.f90 index 2688ede..d8e76d6 100644 --- a/flang/test/semantics/call03.f90 +++ b/flang/test/semantics/call03.f90 @@ -96,7 +96,7 @@ module m01 subroutine test01(x) ! 15.5.2.4(2) class(t), intent(in) :: x[*] - !ERROR: Coindexed polymorphic object may not be associated with a polymorphic dummy argument + !ERROR: Coindexed polymorphic object may not be associated with a polymorphic dummy argument 'x=' call poly(x[1]) end subroutine @@ -105,7 +105,7 @@ module m01 end subroutine subroutine test02(x) ! 15.5.2.4(2) class(t), intent(in) :: x(*) - !ERROR: Assumed-size polymorphic array may not be associated with a monomorphic dummy argument + !ERROR: Assumed-size polymorphic array may not be associated with a monomorphic dummy argument 'x=' call mono(x) end subroutine @@ -114,19 +114,19 @@ module m01 end subroutine subroutine test03 ! 15.5.2.4(2) type(pdt(0)) :: x - !ERROR: Actual argument associated with TYPE(*) dummy argument may not have a parameterized derived type + !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have a parameterized derived type call typestar(x) end subroutine subroutine test04 ! 15.5.2.4(2) type(tbp) :: x - !ERROR: Actual argument associated with TYPE(*) dummy argument may not have type-bound procedures + !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have type-bound procedures call typestar(x) end subroutine subroutine test05 ! 15.5.2.4(2) type(final) :: x - !ERROR: Actual argument associated with TYPE(*) dummy argument may not have FINAL procedures + !ERROR: Actual argument associated with TYPE(*) dummy argument 'x=' may not have FINAL procedures call typestar(x) end subroutine @@ -146,13 +146,13 @@ module m01 end subroutine subroutine test07(x) ! 15.5.2.4(6) type(alloc) :: x[*] - !ERROR: Coindexed actual argument with ALLOCATABLE ultimate component must be associated with a dummy argument with VALUE or INTENT(IN) attributes + !ERROR: Coindexed actual argument with ALLOCATABLE ultimate component must be associated with a dummy argument 'x=' with VALUE or INTENT(IN) attributes call out01(x[1]) end subroutine subroutine test08(x) ! 15.5.2.4(13) real :: x(1)[*] - !ERROR: Coindexed scalar actual argument must be associated with a scalar dummy argument + !ERROR: Coindexed scalar actual argument must be associated with a scalar dummy argument 'x=' call assumedsize(x(1)[1]) end subroutine @@ -165,13 +165,13 @@ module m01 real :: ashape(:) class(t) :: polyarray(*) character(10) :: c(:) - !ERROR: Whole scalar actual argument may not be associated with a dummy argument array + !ERROR: Whole scalar actual argument may not be associated with a dummy argument 'x=' array call assumedsize(x) - !ERROR: Element of pointer array may not be associated with a dummy argument array + !ERROR: Element of pointer array may not be associated with a dummy argument 'x=' array call assumedsize(p(1)) - !ERROR: Element of assumed-shape array may not be associated with a dummy argument array + !ERROR: Element of assumed-shape array may not be associated with a dummy argument 'x=' array call assumedsize(ashape(1)) - !ERROR: Element of polymorphic array may not be associated with a dummy argument array + !ERROR: Element of polymorphic array may not be associated with a dummy argument 'x=' array call polyassumedsize(polyarray(1)) call charray(c(1:1)) ! not an error if character call assumedsize(arr(1)) ! not an error if element in sequence @@ -182,11 +182,11 @@ module m01 subroutine test10(a) ! 15.5.2.4(16) real :: scalar, matrix(2,3) real :: a(*) - !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument + !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'x=' call assumedshape(scalar) !ERROR: Rank of dummy argument is 1, but actual argument has rank 2 call assumedshape(matrix) - !ERROR: Assumed-size array may not be associated with assumed-shape dummy argument + !ERROR: Assumed-size array may not be associated with assumed-shape dummy argument 'x=' call assumedshape(a) end subroutine @@ -239,9 +239,9 @@ module m01 type(ultimateCoarray), volatile :: b call coarr(a) ! ok call volcoarr(b) ! ok - !ERROR: VOLATILE attributes must match when actual argument has a coarray ultimate component + !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component call coarr(b) - !ERROR: VOLATILE attributes must match when actual argument has a coarray ultimate component + !ERROR: VOLATILE attribute must match for dummy argument 'x=' when actual argument has a coarray ultimate component call volcoarr(a) end subroutine @@ -255,17 +255,17 @@ module m01 call asynchronousValue(b[1]) ! ok call asynchronousValue(c[1]) ! ok call asynchronousValue(d[1]) ! ok - !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE + !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE call asynchronous(b[1]) - !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE + !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE call volatile(b[1]) - !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE + !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE call asynchronous(c[1]) - !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE + !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE call volatile(c[1]) - !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE + !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE call asynchronous(d[1]) - !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument with ASYNCHRONOUS or VOLATILE attributes unless VALUE + !ERROR: Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with dummy argument 'x=' with ASYNCHRONOUS or VOLATILE attributes unless VALUE call volatile(d[1]) end subroutine @@ -280,17 +280,17 @@ module m01 call valueassumedsize(b(::2)) ! ok call valueassumedsize(c(::2)) ! ok call valueassumedsize(d(::2)) ! ok - !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument + !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' call volatileassumedsize(b(::2)) - !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument + !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' call volatilecontiguous(b(::2)) - !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument + !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' call volatileassumedsize(c(::2)) - !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument + !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' call volatilecontiguous(c(::2)) - !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument + !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' call volatileassumedsize(d(::2)) - !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument + !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' call volatilecontiguous(d(::2)) end subroutine @@ -309,17 +309,17 @@ module m01 call valueassumedsize(b) ! ok call valueassumedsize(c) ! ok call valueassumedsize(d) ! ok - !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument + !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' call volatileassumedsize(b) - !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument + !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' call volatilecontiguous(b) - !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument + !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' call volatileassumedsize(c) - !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument + !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' call volatilecontiguous(c) - !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument + !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' call volatileassumedsize(d) - !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument + !ERROR: ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous dummy argument 'x=' call volatilecontiguous(d) end subroutine diff --git a/flang/test/semantics/symbol13.f90 b/flang/test/semantics/symbol13.f90 index 508f07a..a732a4e 100644 --- a/flang/test/semantics/symbol13.f90 +++ b/flang/test/semantics/symbol13.f90 @@ -16,7 +16,7 @@ !DEF: /f1 (Function) Subprogram CHARACTER(1_8,1) !DEF: /f1/x1 INTENT(IN) ObjectEntity CHARACTER(2_4,1) -!DEF: /f1/x2 INTENT(IN) ObjectEntity CHARACTER(3_8,1) +!DEF: /f1/x2 INTENT(IN) ObjectEntity CHARACTER(3_4,1) character*1 function f1(x1, x2) !DEF: /f1/n PARAMETER ObjectEntity INTEGER(4) integer, parameter :: n = 2 @@ -29,7 +29,7 @@ character*1 function f1(x1, x2) type :: t !REF: /f1/len !REF: /f1/x2 - !DEF: /f1/t/c1 ObjectEntity CHARACTER(4_8,1) + !DEF: /f1/t/c1 ObjectEntity CHARACTER(4_4,1) !DEF: /f1/t/c2 ObjectEntity CHARACTER(6_8,1) character*(len(x2)+1) :: c1, c2*6 end type t