[flang-commits] [flang] [flang] Fix derived type compatibility checking in ALLOCATE (PR #102035)
via flang-commits
flang-commits at lists.llvm.org
Mon Aug 5 11:39:43 PDT 2024
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Peter Klausler (klausler)
<details>
<summary>Changes</summary>
The derived type compatibility checking for ALLOCATE statements with SOURCE= or MOLD= was only checking for the same derived type name. That is a necessary but not sufficient check, and it can produce bogus errors as well as miss valid errors.
Fixes https://github.com/llvm/llvm-project/issues/101909.
---
Full diff: https://github.com/llvm/llvm-project/pull/102035.diff
4 Files Affected:
- (modified) flang/include/flang/Evaluate/type.h (+3-1)
- (modified) flang/lib/Evaluate/type.cpp (+7-1)
- (modified) flang/lib/Semantics/check-allocate.cpp (+4-2)
- (modified) flang/test/Semantics/allocate08.f90 (+36)
``````````diff
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index 16c2b319ff1de..bd8887dbce4e8 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -494,7 +494,9 @@ bool IsCUDAIntrinsicType(const DynamicType &);
// Determine whether two derived type specs are sufficiently identical
// to be considered the "same" type even if declared separately.
bool AreSameDerivedType(
- const semantics::DerivedTypeSpec &x, const semantics::DerivedTypeSpec &y);
+ const semantics::DerivedTypeSpec &, const semantics::DerivedTypeSpec &);
+bool AreSameDerivedTypeIgnoringTypeParameters(
+ const semantics::DerivedTypeSpec &, const semantics::DerivedTypeSpec &);
// For generating "[extern] template class", &c. boilerplate
#define EXPAND_FOR_EACH_INTEGER_KIND(M, P, S) \
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index 463ac01da0e29..5ecc3701b4f24 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -505,7 +505,13 @@ bool AreSameDerivedType(
return AreSameDerivedType(x, y, false, false, inProgress);
}
-bool AreSameDerivedType(
+bool AreSameDerivedTypeIgnoringTypeParameters(
+ const semantics::DerivedTypeSpec &x, const semantics::DerivedTypeSpec &y) {
+ SetOfDerivedTypePairs inProgress;
+ return AreSameDerivedType(x, y, true, true, inProgress);
+}
+
+static bool AreSameDerivedType(
const semantics::DerivedTypeSpec *x, const semantics::DerivedTypeSpec *y) {
return x == y || (x && y && AreSameDerivedType(*x, *y));
}
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index 8f7a200d23239..a5363a6710d31 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -270,11 +270,13 @@ static bool IsTypeCompatible(
const DeclTypeSpec &type1, const DerivedTypeSpec &derivedType2) {
if (const DerivedTypeSpec * derivedType1{type1.AsDerived()}) {
if (type1.category() == DeclTypeSpec::Category::TypeDerived) {
- return &derivedType1->typeSymbol() == &derivedType2.typeSymbol();
+ return evaluate::AreSameDerivedTypeIgnoringTypeParameters(
+ *derivedType1, derivedType2);
} else if (type1.category() == DeclTypeSpec::Category::ClassDerived) {
for (const DerivedTypeSpec *parent{&derivedType2}; parent;
parent = parent->typeSymbol().GetParentTypeSpec()) {
- if (&derivedType1->typeSymbol() == &parent->typeSymbol()) {
+ if (evaluate::AreSameDerivedTypeIgnoringTypeParameters(
+ *derivedType1, *parent)) {
return true;
}
}
diff --git a/flang/test/Semantics/allocate08.f90 b/flang/test/Semantics/allocate08.f90
index cc074a149ae9e..b2b88f78b32be 100644
--- a/flang/test/Semantics/allocate08.f90
+++ b/flang/test/Semantics/allocate08.f90
@@ -95,6 +95,42 @@ subroutine bar
end subroutine
end module
+module mod1
+ type, bind(C) :: t
+ integer :: n
+ end type
+ type(t), allocatable :: x
+end
+
+module mod2
+ type, bind(C) :: t
+ integer :: n
+ end type
+ type(t), allocatable :: x
+end
+
+module mod3
+ type, bind(C) :: t
+ real :: a
+ end type
+ type(t), allocatable :: x
+end
+
+subroutine same_type
+ use mod1, only: a => x
+ use mod2, only: b => x
+ use mod3, only: c => x
+ allocate(a)
+ allocate(b, source=a) ! ok
+ deallocate(a)
+ allocate(a, source=b) ! ok
+ !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
+ allocate(c, source=a)
+ deallocate(a)
+ !ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
+ allocate(a, source=c)
+end
+
! Related to C945, check typeless expression are caught
subroutine sub
``````````
</details>
https://github.com/llvm/llvm-project/pull/102035
More information about the flang-commits
mailing list