From faa1338ccdc5dc980dcf241eb380c27e24d3865a Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Tue, 15 Nov 2022 12:14:51 -0800 Subject: [PATCH] [flang] Check constraint C834 on INTENT(OUT) assumed-size dummy arrays An assumed-size dummy array argument with INTENT(OUT) can't have a type that might require any runtime (re)initialization, since the size of the array is not known. Differential Revision: https://reviews.llvm.org/D139149 --- flang/include/flang/Semantics/type.h | 1 - flang/lib/Semantics/check-declarations.cpp | 72 +++++++++++++++++------------- flang/test/Semantics/call29.f90 | 38 ++++++++++++++++ 3 files changed, 80 insertions(+), 31 deletions(-) create mode 100644 flang/test/Semantics/call29.f90 diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h index f526c95..16e2a22 100644 --- a/flang/include/flang/Semantics/type.h +++ b/flang/include/flang/Semantics/type.h @@ -268,7 +268,6 @@ public: bool IsForwardReferenced() const; bool HasDefaultInitialization(bool ignoreAllocatable = false) const; bool HasDestruction() const; - bool HasFinalization() const; // The "raw" type parameter list is a simple transcription from the // parameter list in the parse tree, built by calling AddRawParamValue(). diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 4ae4eae..6424325 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -512,6 +512,8 @@ void CheckHelper::CheckObjectEntity( } CheckAssumedTypeEntity(symbol, details); WarnMissingFinal(symbol); + const DeclTypeSpec *type{details.type()}; + const DerivedTypeSpec *derived{type ? type->AsDerived() : nullptr}; if (!details.coshape().empty()) { bool isDeferredCoshape{details.coshape().CanBeDeferredShape()}; if (IsAllocatable(symbol)) { @@ -533,16 +535,14 @@ void CheckHelper::CheckObjectEntity( symbol.name()); } } - if (const DeclTypeSpec *type{details.type()}) { - if (IsBadCoarrayType(type->AsDerived())) { // C747 & C824 - messages_.Say( - "Coarray '%s' may not have type TEAM_TYPE, C_PTR, or C_FUNPTR"_err_en_US, - symbol.name()); - } + if (IsBadCoarrayType(derived)) { // C747 & C824 + messages_.Say( + "Coarray '%s' may not have type TEAM_TYPE, C_PTR, or C_FUNPTR"_err_en_US, + symbol.name()); } } if (details.isDummy()) { - if (symbol.attrs().test(Attr::INTENT_OUT)) { + if (IsIntentOut(symbol)) { if (FindUltimateComponent(symbol, [](const Symbol &x) { return evaluate::IsCoarray(x) && IsAllocatable(x); })) { // C846 @@ -553,6 +553,22 @@ void CheckHelper::CheckObjectEntity( messages_.Say( "An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE"_err_en_US); } + if (details.IsAssumedSize()) { // C834 + if (type && type->IsPolymorphic()) { + messages_.Say( + "An INTENT(OUT) assumed-size dummy argument array may not be polymorphic"_err_en_US); + } + if (derived) { + if (derived->HasDefaultInitialization()) { + messages_.Say( + "An INTENT(OUT) assumed-size dummy argument array may not have a derived type with any default component initialization"_err_en_US); + } + if (IsFinalizable(*derived)) { + messages_.Say( + "An INTENT(OUT) assumed-size dummy argument array may not be finalizable"_err_en_US); + } + } + } } if (InPure() && !IsStmtFunction(DEREF(innermostSymbol_)) && !IsPointer(symbol) && !IsIntentIn(symbol) && @@ -561,22 +577,20 @@ void CheckHelper::CheckObjectEntity( messages_.Say( "non-POINTER dummy argument of pure function must be INTENT(IN) or VALUE"_err_en_US); } else if (IsIntentOut(symbol)) { - if (const DeclTypeSpec *type{details.type()}) { - if (type && type->IsPolymorphic()) { // C1588 + if (type && type->IsPolymorphic()) { // C1588 + messages_.Say( + "An INTENT(OUT) dummy argument of a pure subroutine may not be polymorphic"_err_en_US); + } else if (derived) { + if (FindUltimateComponent(*derived, [](const Symbol &x) { + const DeclTypeSpec *type{x.GetType()}; + return type && type->IsPolymorphic(); + })) { // C1588 messages_.Say( - "An INTENT(OUT) dummy argument of a pure subroutine may not be polymorphic"_err_en_US); - } else if (const DerivedTypeSpec *derived{type->AsDerived()}) { - if (FindUltimateComponent(*derived, [](const Symbol &x) { - const DeclTypeSpec *type{x.GetType()}; - return type && type->IsPolymorphic(); - })) { // C1588 - messages_.Say( - "An INTENT(OUT) dummy argument of a pure subroutine may not have a polymorphic ultimate component"_err_en_US); - } - if (HasImpureFinal(*derived)) { // C1587 - messages_.Say( - "An INTENT(OUT) dummy argument of a pure subroutine may not have an impure FINAL subroutine"_err_en_US); - } + "An INTENT(OUT) dummy argument of a pure subroutine may not have a polymorphic ultimate component"_err_en_US); + } + if (HasImpureFinal(*derived)) { // C1587 + messages_.Say( + "An INTENT(OUT) dummy argument of a pure subroutine may not have an impure FINAL subroutine"_err_en_US); } } } else if (!IsIntentInOut(symbol)) { // C1586 @@ -655,14 +669,12 @@ void CheckHelper::CheckObjectEntity( "An initialized variable in BLOCK DATA must be in a COMMON block"_err_en_US); } } - if (const DeclTypeSpec *type{details.type()}) { // C708 - if (type->IsPolymorphic() && - !(type->IsAssumedType() || IsAllocatableOrPointer(symbol) || - IsDummy(symbol))) { - messages_.Say("CLASS entity '%s' must be a dummy argument or have " - "ALLOCATABLE or POINTER attribute"_err_en_US, - symbol.name()); - } + if (type && type->IsPolymorphic() && + !(type->IsAssumedType() || IsAllocatableOrPointer(symbol) || + IsDummy(symbol))) { // C708 + messages_.Say("CLASS entity '%s' must be a dummy argument or have " + "ALLOCATABLE or POINTER attribute"_err_en_US, + symbol.name()); } } diff --git a/flang/test/Semantics/call29.f90 b/flang/test/Semantics/call29.f90 new file mode 100644 index 0000000..d8209a6 --- /dev/null +++ b/flang/test/Semantics/call29.f90 @@ -0,0 +1,38 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 + +module m + type t1 + integer, allocatable :: a(:) + end type + type t2 + integer :: n = 123 + end type + type t3 + contains + final :: t3final + end type + type t4 + type(t1) :: c1 + type(t2) :: c2 + type(t3) :: c3 + end type + type t5 + end type + contains + elemental subroutine t3final(x) + type(t3), intent(in) :: x + end subroutine + subroutine test1(x1,x2,x3,x4,x5) + !ERROR: An INTENT(OUT) assumed-size dummy argument array may not have a derived type with any default component initialization + type(t1), intent(out) :: x1(*) + !ERROR: An INTENT(OUT) assumed-size dummy argument array may not have a derived type with any default component initialization + type(t2), intent(out) :: x2(*) + !ERROR: An INTENT(OUT) assumed-size dummy argument array may not be finalizable + type(t3), intent(out) :: x3(*) + !ERROR: An INTENT(OUT) assumed-size dummy argument array may not have a derived type with any default component initialization + !ERROR: An INTENT(OUT) assumed-size dummy argument array may not be finalizable + type(t4), intent(out) :: x4(*) + !ERROR: An INTENT(OUT) assumed-size dummy argument array may not be polymorphic + class(t5), intent(out) :: x5(*) + end subroutine +end module -- 2.7.4