[flang-commits] [flang] faa1338 - [flang] Check constraint C834 on INTENT(OUT) assumed-size dummy arrays
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Sun Dec 4 10:38:57 PST 2022
Author: Peter Klausler
Date: 2022-12-04T10:38:42-08:00
New Revision: faa1338ccdc5dc980dcf241eb380c27e24d3865a
URL: https://github.com/llvm/llvm-project/commit/faa1338ccdc5dc980dcf241eb380c27e24d3865a
DIFF: https://github.com/llvm/llvm-project/commit/faa1338ccdc5dc980dcf241eb380c27e24d3865a.diff
LOG: [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
Added:
flang/test/Semantics/call29.f90
Modified:
flang/include/flang/Semantics/type.h
flang/lib/Semantics/check-declarations.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h
index f526c95bb6ae7..16e2a2293ba1f 100644
--- a/flang/include/flang/Semantics/type.h
+++ b/flang/include/flang/Semantics/type.h
@@ -268,7 +268,6 @@ class DerivedTypeSpec {
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 4ae4eae6c1ccc..6424325dbcef2 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 0000000000000..d8209a6448b8e
--- /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
More information about the flang-commits
mailing list