From 926da903f23d8c37e069588fb023802e4e6439ed Mon Sep 17 00:00:00 2001 From: peter klausler Date: Tue, 29 Oct 2019 12:46:25 -0700 Subject: [PATCH] [flang] enable call06.f90 test Relax checking when irrelevant due to INTENT(IN) Add and pass call14.f90 test on VALUE Allow ASYNCHRONOUS/VOLATILE to apply to host/USE associated entities, add tests Pass call06 Check C827 & C828, fix tests Original-commit: flang-compiler/f18@df6cb83794b4f8842170c748d9edb7b53ba56fe8 Reviewed-on: https://github.com/flang-compiler/f18/pull/801 --- flang/documentation/Extensions.md | 3 + flang/lib/evaluate/characteristics.cc | 4 +- flang/lib/evaluate/characteristics.h | 2 + flang/lib/semantics/check-call.cc | 66 +++++++--- flang/lib/semantics/check-declarations.cc | 135 ++++++++++++++++++--- flang/lib/semantics/resolve-names.cc | 6 +- flang/lib/semantics/tools.cc | 18 +++ flang/lib/semantics/tools.h | 10 +- flang/test/semantics/CMakeLists.txt | 3 + flang/test/semantics/blockconstruct01.f90 | 2 +- flang/test/semantics/call03.f90 | 4 +- flang/test/semantics/call04.f90 | 3 +- flang/test/semantics/call06.f90 | 16 +-- flang/test/semantics/call14.f90 | 51 ++++++++ flang/test/semantics/doconcurrent01.f90 | 4 +- flang/test/semantics/init01.f90 | 2 +- flang/test/semantics/misc-declarations.f90 | 54 +++++++++ flang/test/semantics/modfile24.f90 | 8 +- 18 files changed, 335 insertions(+), 56 deletions(-) create mode 100644 flang/test/semantics/call14.f90 create mode 100644 flang/test/semantics/misc-declarations.f90 diff --git a/flang/documentation/Extensions.md b/flang/documentation/Extensions.md index d2b82e571543..12444af012b9 100644 --- a/flang/documentation/Extensions.md +++ b/flang/documentation/Extensions.md @@ -106,6 +106,9 @@ Extensions, deletions, and legacy features supported by default * When a scalar CHARACTER actual argument of the same kind is known to have a length shorter than the associated dummy argument, it is extended on the right with blanks, similar to assignment. +* When a dummy argument is `POINTER` or `ALLOCATABLE` and is `INTENT(IN)`, we + relax enforcement of some requirements on actual arguments that must otherwise + hold true for definable arguments. Extensions supported when enabled by options -------------------------------------------- diff --git a/flang/lib/evaluate/characteristics.cc b/flang/lib/evaluate/characteristics.cc index e603c8d04979..7a1b18a3688f 100644 --- a/flang/lib/evaluate/characteristics.cc +++ b/flang/lib/evaluate/characteristics.cc @@ -41,7 +41,8 @@ static void CopyAttrs(const semantics::Symbol &src, A &dst, } bool TypeAndShape::operator==(const TypeAndShape &that) const { - return type_ == that.type_ && shape_ == that.shape_ && attrs_ == that.attrs_; + return type_ == that.type_ && shape_ == that.shape_ && + attrs_ == that.attrs_ && corank_ == that.corank_; } std::optional TypeAndShape::Characterize( @@ -142,6 +143,7 @@ bool TypeAndShape::IsCompatibleWith(parser::ContextualMessages &messages, void TypeAndShape::AcquireShape(const semantics::ObjectEntityDetails &object) { CHECK(shape_.empty() && !attrs_.test(Attr::AssumedRank)); + corank_ = object.coshape().Rank(); if (object.IsAssumedRank()) { attrs_.set(Attr::AssumedRank); return; diff --git a/flang/lib/evaluate/characteristics.h b/flang/lib/evaluate/characteristics.h index 59fad99dc57d..2df4f1ff8f7c 100644 --- a/flang/lib/evaluate/characteristics.h +++ b/flang/lib/evaluate/characteristics.h @@ -102,6 +102,7 @@ public: } const Shape &shape() const { return shape_; } const Attrs &attrs() const { return attrs_; } + int corank() const { return corank_; } int Rank() const { return GetRank(shape_); } bool IsCompatibleWith(parser::ContextualMessages &, const TypeAndShape &that, @@ -119,6 +120,7 @@ protected: std::optional> LEN_; Shape shape_; Attrs attrs_; + int corank_{0}; }; // 15.3.2.2 diff --git a/flang/lib/semantics/check-call.cc b/flang/lib/semantics/check-call.cc index 779bce127651..da4c5d4513fc 100644 --- a/flang/lib/semantics/check-call.cc +++ b/flang/lib/semantics/check-call.cc @@ -330,34 +330,66 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, } } - // 15.5.2.5 -- actual & dummy are both POINTER or both ALLOCATABLE - bool actualIsAllocatable{ - actualLastSymbol && IsAllocatable(*actualLastSymbol)}; + // 15.5.2.6 -- dummy is ALLOCATABLE bool dummyIsAllocatable{ dummy.attrs.test(characteristics::DummyDataObject::Attr::Allocatable)}; + bool actualIsAllocatable{ + actualLastSymbol && IsAllocatable(*actualLastSymbol)}; + if (dummyIsAllocatable) { + if (!actualIsAllocatable) { + messages.Say( + "ALLOCATABLE %s must be associated with an ALLOCATABLE actual argument"_err_en_US, + dummyName); + } + if (actualIsAllocatable && actualIsCoindexed && + dummy.intent != common::Intent::In) { + messages.Say( + "ALLOCATABLE %s must have INTENT(IN) to be associated with a coindexed actual argument"_err_en_US, + dummyName); + } + if (!actualIsCoindexed && actualLastSymbol && + actualLastSymbol->Corank() != dummy.type.corank()) { + messages.Say( + "ALLOCATABLE %s has corank %d but actual argument has corank %d"_err_en_US, + dummyName, dummy.type.corank(), actualLastSymbol->Corank()); + } + } + + // 15.5.2.5 -- actual & dummy are both POINTER or both ALLOCATABLE if ((actualIsPointer && dummyIsPointer) || (actualIsAllocatable && dummyIsAllocatable)) { - if (dummyIsPolymorphic != actualIsPolymorphic) { - messages.Say( - "If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so"_err_en_US); - } bool actualIsUnlimited{actualType.type().IsUnlimitedPolymorphic()}; bool dummyIsUnlimited{dummy.type.type().IsUnlimitedPolymorphic()}; - if (!actualIsUnlimited) { - if (dummyIsUnlimited) { + if (actualIsUnlimited != dummyIsUnlimited) { + if (typesCompatible) { messages.Say( "If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so"_err_en_US); - } else if (typesCompatible) { - if (!actualType.type().IsTypeCompatibleWith(dummy.type.type())) { + } + } else if (dummyIsPolymorphic != actualIsPolymorphic) { + if (dummy.intent == common::Intent::In && typesCompatible) { + // extension: allow with warning, rule is only relevant for definables + messages.Say( + "If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both should be so"_en_US); + } else { + messages.Say( + "If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so"_err_en_US); + } + } else if (!actualIsUnlimited && typesCompatible) { + if (!actualType.type().IsTypeCompatibleWith(dummy.type.type())) { + if (dummy.intent == common::Intent::In) { + // extension: allow with warning, rule is only relevant for definables + messages.Say( + "POINTER or ALLOCATABLE dummy and actual arguments should have the same declared type"_en_US); + } else { messages.Say( "POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type"_err_en_US); } - if (actualType.type().category() == TypeCategory::Derived && - !DefersSameTypeParameters(actualType.type().GetDerivedTypeSpec(), - dummy.type.type().GetDerivedTypeSpec())) { - messages.Say( - "Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE"_err_en_US); - } + } + if (actualType.type().category() == TypeCategory::Derived && + !DefersSameTypeParameters(actualType.type().GetDerivedTypeSpec(), + dummy.type.type().GetDerivedTypeSpec())) { + messages.Say( + "Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE"_err_en_US); } } } diff --git a/flang/lib/semantics/check-declarations.cc b/flang/lib/semantics/check-declarations.cc index 87f128294193..d14497365d2d 100644 --- a/flang/lib/semantics/check-declarations.cc +++ b/flang/lib/semantics/check-declarations.cc @@ -31,15 +31,15 @@ public: void Check() { Check(context_.globalScope()); } void Check(const ParamValue &, bool canBeAssumed); - void Check(Bound &bound) { CheckSpecExpr(bound.GetExplicit()); } - void Check(ShapeSpec &spec) { + void Check(const Bound &bound) { CheckSpecExpr(bound.GetExplicit()); } + void Check(const ShapeSpec &spec) { Check(spec.lbound()); Check(spec.ubound()); } - void Check(ArraySpec &); - void Check(DeclTypeSpec &, bool canHaveAssumedTypeParameters); - void Check(Symbol &); - void Check(Scope &); + void Check(const ArraySpec &); + void Check(const DeclTypeSpec &, bool canHaveAssumedTypeParameters); + void Check(const Symbol &); + void Check(const Scope &); private: template void CheckSpecExpr(A &x) { @@ -49,11 +49,16 @@ private: template void CheckSpecExpr(const A &x) { evaluate::CheckSpecificationExpr(x, messages_, DEREF(scope_)); } + void CheckValue(const Symbol &, const DerivedTypeSpec *); + void CheckVolatile( + const Symbol &, bool isAssociated, const DerivedTypeSpec *); SemanticsContext &context_; evaluate::FoldingContext &foldingContext_{context_.foldingContext()}; parser::ContextualMessages &messages_{foldingContext_.messages()}; const Scope *scope_{nullptr}; + bool inBindC_{false}; // scope is BIND(C) + bool inPure_{false}; // scope is PURE }; void CheckHelper::Check(const ParamValue &value, bool canBeAssumed) { @@ -67,13 +72,14 @@ void CheckHelper::Check(const ParamValue &value, bool canBeAssumed) { } } -void CheckHelper::Check(ArraySpec &shape) { - for (auto &spec : shape) { +void CheckHelper::Check(const ArraySpec &shape) { + for (const auto &spec : shape) { Check(spec); } } -void CheckHelper::Check(DeclTypeSpec &type, bool canHaveAssumedTypeParameters) { +void CheckHelper::Check( + const DeclTypeSpec &type, bool canHaveAssumedTypeParameters) { if (type.category() == DeclTypeSpec::Character) { Check(type.characterTypeSpec().length(), canHaveAssumedTypeParameters); } else if (const DerivedTypeSpec * spec{type.AsDerived()}) { @@ -83,14 +89,25 @@ void CheckHelper::Check(DeclTypeSpec &type, bool canHaveAssumedTypeParameters) { } } -void CheckHelper::Check(Symbol &symbol) { - if (context_.HasError(symbol) || symbol.has() || - symbol.has()) { +void CheckHelper::Check(const Symbol &symbol) { + if (context_.HasError(symbol)) { return; } + const DeclTypeSpec *type{symbol.GetUltimate().GetType()}; + const DerivedTypeSpec *derived{nullptr}; + if (type != nullptr) { + derived = type->AsDerived(); + } auto save{messages_.SetLocation(symbol.name())}; context_.set_location(symbol.name()); - if (DeclTypeSpec * type{symbol.GetType()}) { + bool isAssociated{symbol.has() || symbol.has()}; + if (symbol.attrs().test(Attr::VOLATILE)) { + CheckVolatile(symbol, isAssociated, derived); + } + if (isAssociated) { + return; // only care about checking VOLATILE on associated symbols + } + if (type != nullptr) { bool canHaveAssumedParameter{IsNamedConstant(symbol) || IsAssumedLengthCharacterFunction(symbol) || symbol.test(Symbol::Flag::ParentComp)}; @@ -130,6 +147,19 @@ void CheckHelper::Check(Symbol &symbol) { if (auto *object{symbol.detailsIf()}) { Check(object->shape()); Check(object->coshape()); + if (!object->coshape().empty()) { + if (IsAllocatable(symbol)) { + if (!object->coshape().IsDeferredShape()) { // C827 + messages_.Say( + "ALLOCATABLE coarray must have a deferred coshape"_err_en_US); + } + } else { + if (!object->coshape().IsAssumedSize()) { // C828 + messages_.Say( + "Non-ALLOCATABLE coarray must have an explicit coshape"_err_en_US); + } + } + } if (object->isDummy() && symbol.attrs().test(Attr::INTENT_OUT)) { if (FindUltimateComponent(symbol, [](const Symbol &symbol) { return IsCoarray(symbol) && IsAllocatable(symbol); @@ -143,14 +173,87 @@ void CheckHelper::Check(Symbol &symbol) { } } } + if (symbol.attrs().test(Attr::VALUE)) { + CheckValue(symbol, derived); + } } -void CheckHelper::Check(Scope &scope) { +void CheckHelper::CheckValue( + const Symbol &symbol, const DerivedTypeSpec *derived) { // C863 - C865 + if (!IsDummy(symbol)) { + messages_.Say( + "VALUE attribute may apply only to a dummy argument"_err_en_US); + } + if (IsProcedure(symbol)) { + messages_.Say( + "VALUE attribute may apply only to a dummy data object"_err_en_US); + } + if (IsAssumedSizeArray(symbol)) { + messages_.Say( + "VALUE attribute may not apply to an assumed-size array"_err_en_US); + } + if (IsCoarray(symbol)) { + messages_.Say("VALUE attribute may not apply to a coarray"_err_en_US); + } + if (IsAllocatable(symbol)) { + messages_.Say("VALUE attribute may not apply to an ALLOCATABLE"_err_en_US); + } else if (IsPointer(symbol)) { + messages_.Say("VALUE attribute may not apply to a POINTER"_err_en_US); + } + if (IsIntentInOut(symbol)) { + messages_.Say( + "VALUE attribute may not apply to an INTENT(IN OUT) argument"_err_en_US); + } else if (IsIntentOut(symbol)) { + messages_.Say( + "VALUE attribute may not apply to an INTENT(OUT) argument"_err_en_US); + } + if (symbol.attrs().test(Attr::VOLATILE)) { + messages_.Say("VALUE attribute may not apply to a VOLATILE"_err_en_US); + } + if (inBindC_ && IsOptional(symbol)) { + messages_.Say( + "VALUE attribute may not apply to an OPTIONAL in a BIND(C) procedure"_err_en_US); + } + if (derived != nullptr) { + if (FindCoarrayUltimateComponent(*derived)) { + messages_.Say( + "VALUE attribute may not apply to a type with a coarray ultimate component"_err_en_US); + } + } +} + +void CheckHelper::CheckVolatile(const Symbol &symbol, bool isAssociated, + const DerivedTypeSpec *derived) { // C866 - C868 + if (IsIntentIn(symbol)) { + messages_.Say( + "VOLATILE attribute may not apply to an INTENT(IN) argument"_err_en_US); + } + if (IsProcedure(symbol)) { + messages_.Say("VOLATILE attribute may apply only to a variable"_err_en_US); + } + if (isAssociated) { + const Symbol &ultimate{symbol.GetUltimate()}; + if (IsCoarray(ultimate)) { + messages_.Say( + "VOLATILE attribute may not apply to a coarray accessed by USE or host association"_err_en_US); + } + if (derived != nullptr) { + if (FindCoarrayUltimateComponent(*derived)) { + messages_.Say( + "VOLATILE attribute may not apply to a type with a coarray ultimate component accessed by USE or host association"_err_en_US); + } + } + } +} + +void CheckHelper::Check(const Scope &scope) { scope_ = &scope; - for (auto &pair : scope) { + inBindC_ = IsBindCProcedure(scope); + inPure_ = IsPureProcedure(scope); + for (const auto &pair : scope) { Check(*pair.second); } - for (Scope &child : scope.children()) { + for (const Scope &child : scope.children()) { Check(child); } } diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc index 988044b32ba7..918d5f77cc58 100644 --- a/flang/lib/semantics/resolve-names.cc +++ b/flang/lib/semantics/resolve-names.cc @@ -3137,8 +3137,10 @@ Symbol &DeclarationVisitor::HandleAttributeStmt( } auto *symbol{FindInScope(currScope(), name)}; if (attr == Attr::ASYNCHRONOUS || attr == Attr::VOLATILE) { - // these can be set on a symbol that is host-assoc into block or use-assoc - if (!symbol && currScope().kind() == Scope::Kind::Block) { + // these can be set on a symbol that is host-assoc or use-assoc + if (!symbol && + (currScope().kind() == Scope::Kind::Subprogram || + currScope().kind() == Scope::Kind::Block)) { if (auto *hostSymbol{FindSymbol(name)}) { name.symbol = nullptr; symbol = &MakeSymbol(name, HostAssocDetails{*hostSymbol}); diff --git a/flang/lib/semantics/tools.cc b/flang/lib/semantics/tools.cc index da07fe45f9ed..17da3e379962 100644 --- a/flang/lib/semantics/tools.cc +++ b/flang/lib/semantics/tools.cc @@ -184,6 +184,24 @@ bool IsPureProcedure(const Scope &scope) { } } +bool IsBindCProcedure(const Symbol &symbol) { + if (const auto *procDetails{symbol.detailsIf()}) { + if (const Symbol * procInterface{procDetails->interface().symbol()}) { + // procedure component with a BIND(C) interface + return IsBindCProcedure(*procInterface); + } + } + return symbol.attrs().test(Attr::BIND_C) && IsProcedure(symbol); +} + +bool IsBindCProcedure(const Scope &scope) { + if (const Symbol * symbol{scope.GetSymbol()}) { + return IsBindCProcedure(*symbol); + } else { + return false; + } +} + bool IsProcedure(const Symbol &symbol) { return std::visit( common::visitors{ diff --git a/flang/lib/semantics/tools.h b/flang/lib/semantics/tools.h index 811f587bdd38..34255d80b27d 100644 --- a/flang/lib/semantics/tools.h +++ b/flang/lib/semantics/tools.h @@ -54,13 +54,15 @@ bool IsGenericDefinedOp(const Symbol &); bool IsCommonBlockContaining(const Symbol &block, const Symbol &object); bool DoesScopeContain(const Scope *maybeAncestor, const Scope &maybeDescendent); bool DoesScopeContain(const Scope *, const Symbol &); -bool IsUseAssociated(const Symbol *, const Scope &); +bool IsUseAssociated(const Symbol &, const Scope &); bool IsHostAssociated(const Symbol &, const Scope &); bool IsDummy(const Symbol &); bool IsPointerDummy(const Symbol &); bool IsFunction(const Symbol &); bool IsPureProcedure(const Symbol &); bool IsPureProcedure(const Scope &); +bool IsBindCProcedure(const Symbol &); +bool IsBindCProcedure(const Scope &); bool IsProcedure(const Symbol &); bool IsProcName(const Symbol &symbol); // proc-name bool IsVariableName(const Symbol &symbol); // variable-name @@ -111,6 +113,12 @@ inline bool IsOptional(const Symbol &symbol) { inline bool IsIntentIn(const Symbol &symbol) { return symbol.attrs().test(Attr::INTENT_IN); } +inline bool IsIntentInOut(const Symbol &symbol) { + return symbol.attrs().test(Attr::INTENT_INOUT); +} +inline bool IsIntentOut(const Symbol &symbol) { + return symbol.attrs().test(Attr::INTENT_OUT); +} inline bool IsProtected(const Symbol &symbol) { return symbol.attrs().test(Attr::PROTECTED); } diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt index 02872e9b801e..93c187cfaae3 100644 --- a/flang/test/semantics/CMakeLists.txt +++ b/flang/test/semantics/CMakeLists.txt @@ -177,7 +177,10 @@ set(ERROR_TESTS call03.f90 call04.f90 call05.f90 + call06.f90 call13.f90 + call14.f90 + misc-declarations.f90 ) # These test files have expected symbols in the source diff --git a/flang/test/semantics/blockconstruct01.f90 b/flang/test/semantics/blockconstruct01.f90 index b0fc00c59b80..c3c3a0344a7e 100644 --- a/flang/test/semantics/blockconstruct01.f90 +++ b/flang/test/semantics/blockconstruct01.f90 @@ -50,7 +50,7 @@ subroutine s4_c1107 end block end -subroutine s5_c1107 +subroutine s5_c1107(x,y) integer x, y value x block diff --git a/flang/test/semantics/call03.f90 b/flang/test/semantics/call03.f90 index 7af39d3edfa7..a97ded268c68 100644 --- a/flang/test/semantics/call03.f90 +++ b/flang/test/semantics/call03.f90 @@ -33,7 +33,7 @@ module m01 real, allocatable :: a(:) end type type :: ultimateCoarray - real, allocatable :: a[*] + real, allocatable :: a[:] end type contains @@ -85,7 +85,7 @@ module m01 real, pointer :: x(:) end subroutine subroutine valueassumedsize(x) - real, value :: x(*) + real, intent(in) :: x(*) end subroutine subroutine volatileassumedsize(x) real, volatile :: x(*) diff --git a/flang/test/semantics/call04.f90 b/flang/test/semantics/call04.f90 index 1949c0afe13a..ca62f3483b75 100644 --- a/flang/test/semantics/call04.f90 +++ b/flang/test/semantics/call04.f90 @@ -17,7 +17,7 @@ module m type :: hasCoarray - real, allocatable :: a(:)[*] + real, allocatable :: a(:)[:] end type type, extends(hasCoarray) :: extendsHasCoarray end type @@ -36,6 +36,7 @@ module m end subroutine subroutine s01b ! C846 - can only be caught at a call via explicit interface !ERROR: ALLOCATABLE coarray 'coarray' may not be associated with INTENT(OUT) dummy argument 'x=' + !ERROR: ALLOCATABLE dummy argument 'x=' has corank 0 but actual argument has corank 1 call s01a(coarray) end subroutine diff --git a/flang/test/semantics/call06.f90 b/flang/test/semantics/call06.f90 index 45dd75f6d5b5..6091ab4a9b36 100644 --- a/flang/test/semantics/call06.f90 +++ b/flang/test/semantics/call06.f90 @@ -46,24 +46,24 @@ module m subroutine test(x) real :: scalar real, allocatable, intent(in) :: x - !ERROR: ALLOCATABLE dummy argument must be associated with an ALLOCATABLE effective argument + !ERROR: ALLOCATABLE dummy argument 'x=' must be associated with an ALLOCATABLE actual argument call s01(scalar) - !ERROR: ALLOCATABLE dummy argument must be associated with an ALLOCATABLE effective argument + !ERROR: ALLOCATABLE dummy argument 'x=' must be associated with an ALLOCATABLE actual argument call s01(1.) - !ERROR: ALLOCATABLE dummy argument must be associated with an ALLOCATABLE effective argument + !ERROR: ALLOCATABLE dummy argument 'x=' must be associated with an ALLOCATABLE actual argument call s01(allofunc()) ! subtle: ALLOCATABLE function result isn't call s02(cov) ! ok call s03(com) ! ok - !ERROR: Dummy argument has corank 1, but effective argument has corank 2 + !ERROR: ALLOCATABLE dummy argument 'x=' has corank 1 but actual argument has corank 2 call s02(com) - !ERROR: Dummy argument has corank 2, but effective argument has corank 1 + !ERROR: ALLOCATABLE dummy argument 'x=' has corank 2 but actual argument has corank 1 call s03(cov) call s04(cov[1]) ! ok - !ERROR: Coindexed ALLOCATABLE effective argument must be associated with INTENT(IN) dummy argument + !ERROR: ALLOCATABLE dummy argument 'x=' must have INTENT(IN) to be associated with a coindexed actual argument call s01(cov[1]) - !ERROR: Effective argument associated with INTENT(OUT) dummy is not definable + !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' must be definable call s05(x) - !ERROR: Effective argument associated with INTENT(IN OUT) dummy is not definable + !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable call s06(x) end subroutine end module diff --git a/flang/test/semantics/call14.f90 b/flang/test/semantics/call14.f90 new file mode 100644 index 000000000000..72e9ce706ac9 --- /dev/null +++ b/flang/test/semantics/call14.f90 @@ -0,0 +1,51 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +! Test 8.5.18 constraints on the VALUE attribute + +module m + type :: hasCoarray + real :: coarray[*] + end type + contains + !ERROR: VALUE attribute may apply only to a dummy data object + subroutine C863(notData,assumedSize,coarray,coarrayComponent) + external :: notData + !ERROR: VALUE attribute may apply only to a dummy argument + real, value :: notADummy + value :: notData + !ERROR: VALUE attribute may not apply to an assumed-size array + real, value :: assumedSize(10,*) + !ERROR: VALUE attribute may not apply to a coarray + real, value :: coarray[*] + !ERROR: VALUE attribute may not apply to a type with a coarray ultimate component + type(hasCoarray), value :: coarrayComponent + end subroutine + subroutine C864(allocatable, inout, out, pointer, volatile) + !ERROR: VALUE attribute may not apply to an ALLOCATABLE + real, value, allocatable :: allocatable + !ERROR: VALUE attribute may not apply to an INTENT(IN OUT) argument + real, value, intent(in out) :: inout + !ERROR: VALUE attribute may not apply to an INTENT(OUT) argument + real, value, intent(out) :: out + !ERROR: VALUE attribute may not apply to a POINTER + real, value, pointer :: pointer + !ERROR: VALUE attribute may not apply to a VOLATILE + real, value, volatile :: volatile + end subroutine + subroutine C865(optional) bind(c) + !ERROR: VALUE attribute may not apply to an OPTIONAL in a BIND(C) procedure + real, value, optional :: optional + end subroutine +end module diff --git a/flang/test/semantics/doconcurrent01.f90 b/flang/test/semantics/doconcurrent01.f90 index c8ed49f09056..af4e27b258a3 100644 --- a/flang/test/semantics/doconcurrent01.f90 +++ b/flang/test/semantics/doconcurrent01.f90 @@ -123,7 +123,7 @@ end subroutine s5 subroutine s6() type :: type0 integer, allocatable, dimension(:) :: type0_field - integer, allocatable, dimension(:), codimension[*] :: coarray_type0_field + integer, allocatable, dimension(:), codimension[:] :: coarray_type0_field end type type :: type1 @@ -134,7 +134,7 @@ subroutine s6() type(type1) :: qvar; integer, allocatable, dimension(:) :: array1 integer, allocatable, dimension(:) :: array2 - integer, allocatable, codimension[*] :: ca, cb + integer, allocatable, codimension[:] :: ca, cb integer, allocatable :: aa, ab ! All of the following are allowable outside a DO CONCURRENT diff --git a/flang/test/semantics/init01.f90 b/flang/test/semantics/init01.f90 index 39ce40870a81..8051e6bd6804 100644 --- a/flang/test/semantics/init01.f90 +++ b/flang/test/semantics/init01.f90 @@ -17,7 +17,7 @@ subroutine test(j) integer, intent(in) :: j real, allocatable, target, save :: x1 - real, codimension[:], target, save :: x2 + real, codimension[*], target, save :: x2 real, save :: x3 real, target :: x4 real, target, save :: x5(10) diff --git a/flang/test/semantics/misc-declarations.f90 b/flang/test/semantics/misc-declarations.f90 new file mode 100644 index 000000000000..04656939a32b --- /dev/null +++ b/flang/test/semantics/misc-declarations.f90 @@ -0,0 +1,54 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +! Miscellaneous constraint and requirement checking on declarations: +! - 8.5.6.2 & 8.5.6.3 constraints on coarrays +! - 8.5.19 constraints on the VOLATILE attribute + +module m + !ERROR: ALLOCATABLE coarray must have a deferred coshape + real, allocatable :: mustBeDeferred[*] ! C827 + !ERROR: Non-ALLOCATABLE coarray must have an explicit coshape + real :: mustBeExplicit[:] ! C828 + type :: hasCoarray + real :: coarray[*] + end type + real :: coarray[*] + type(hasCoarray) :: coarrayComponent + contains + !ERROR: VOLATILE attribute may not apply to an INTENT(IN) argument + subroutine C866(x) + intent(in) :: x + volatile :: x + !ERROR: VOLATILE attribute may apply only to a variable + volatile :: notData + external :: notData + end subroutine + subroutine C867 + !ERROR: VOLATILE attribute may not apply to a coarray accessed by USE or host association + volatile :: coarray + !ERROR: VOLATILE attribute may not apply to a type with a coarray ultimate component accessed by USE or host association + volatile :: coarrayComponent + end subroutine + subroutine C868(coarray,coarrayComponent) + real, volatile :: coarray[*] + type(hasCoarray) :: coarrayComponent + block + !ERROR: VOLATILE attribute may not apply to a coarray accessed by USE or host association + volatile :: coarray + !ERROR: VOLATILE attribute may not apply to a type with a coarray ultimate component accessed by USE or host association + volatile :: coarrayComponent + end block + end subroutine +end module diff --git a/flang/test/semantics/modfile24.f90 b/flang/test/semantics/modfile24.f90 index 1ad3a6cba3ac..87b2992c9ee4 100644 --- a/flang/test/semantics/modfile24.f90 +++ b/flang/test/semantics/modfile24.f90 @@ -49,8 +49,8 @@ end ! coarray-spec in components and with non-constants bounds module m3 type t - real, allocatable :: c(:)[1:10,1:*] - complex, allocatable, codimension[5,*] :: d + real :: c[1:10,1:*] + complex, codimension[5,*] :: d end type real, allocatable :: e[:,:,:] contains @@ -63,8 +63,8 @@ end !Expect: m3.mod !module m3 ! type::t -! real(4),allocatable::c(:)[1_8:10_8,1_8:*] -! complex(4),allocatable::d[1_8:5_8,1_8:*] +! real(4)::c[1_8:10_8,1_8:*] +! complex(4)::d[1_8:5_8,1_8:*] ! end type ! real(4),allocatable::e[:,:,:] !contains