[flang] Derived type structural equivalence #69376
Merged
Conversation
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
llvmbot
added
flang
|
@llvm/pr-subscribers-flang-semantics Author: Peter Klausler (klausler) ChangesF'202X 7.5.2.4 describes conditions under which two derived type definitions are to be considered equivalent. These rules are already implemented in Evaluate/type.cpp but not exposed for general use; rearrange the code a little so that the compatibility checking of separate module procedure interfaces and explicit definitions can use it to avoid emitting a bogus error message. Fixes #67946. Full diff: https://github.com/llvm/llvm-project/pull/69376.diff 6 Files Affected:
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index 13060e42e47adbf..33b94ed31843cf6 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -207,6 +207,10 @@ class DynamicType {
// SAME_TYPE_AS (16.9.165); ignores type parameter values
std::optional<bool> SameTypeAs(const DynamicType &) const;
+ // 7.5.2.4 type equivalence; like operator==(), but SEQUENCE/BIND(C)
+ // derived types can be structurally equivalent.
+ bool IsEquivalentTo(const DynamicType &) const;
+
// Result will be missing when a symbol is absent or
// has an erroneous type, e.g., REAL(KIND=666).
static std::optional<DynamicType> From(const semantics::DeclTypeSpec &);
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index e5d9851e2496aeb..967a933375940e0 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -288,7 +288,7 @@ const semantics::DerivedTypeSpec *GetParentTypeSpec(
}
// Compares two derived type representations to see whether they both
-// represent the "same type" in the sense of section 7.5.2.4.
+// represent the "same type" in the sense of section F'2023 7.5.2.4.
using SetOfDerivedTypePairs =
std::set<std::pair<const semantics::DerivedTypeSpec *,
const semantics::DerivedTypeSpec *>>;
@@ -508,6 +508,19 @@ bool AreSameDerivedType(
return AreSameDerivedType(x, y, false, false, inProgress);
}
+bool AreSameDerivedType(
+ const semantics::DerivedTypeSpec *x, const semantics::DerivedTypeSpec *y) {
+ return x == y || (x && y && AreSameDerivedType(*x, *y));
+}
+
+bool DynamicType::IsEquivalentTo(const DynamicType &that) const {
+ return category_ == that.category_ && kind_ == that.kind_ &&
+ PointeeComparison(charLengthParamValue_, that.charLengthParamValue_) &&
+ knownLength().has_value() == that.knownLength().has_value() &&
+ (!knownLength() || *knownLength() == *that.knownLength()) &&
+ AreSameDerivedType(derived_, that.derived_);
+}
+
static bool AreCompatibleDerivedTypes(const semantics::DerivedTypeSpec *x,
const semantics::DerivedTypeSpec *y, bool isPolymorphic,
bool ignoreTypeParameterValues, bool ignoreLenTypeParameters) {
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 2c2866d590ae5a4..ce16b2df54b050f 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -3354,10 +3354,9 @@ void SubprogramMatchHelper::CheckDummyDataObject(const Symbol &symbol1,
const DummyDataObject &obj2) {
if (!CheckSameIntent(symbol1, symbol2, obj1.intent, obj2.intent)) {
} else if (!CheckSameAttrs(symbol1, symbol2, obj1.attrs, obj2.attrs)) {
- } else if (obj1.type.type() != obj2.type.type()) {
+ } else if (!obj1.type.type().IsEquivalentTo(obj2.type.type())) {
Say(symbol1, symbol2,
- "Dummy argument '%s' has type %s; the corresponding argument in the"
- " interface body has type %s"_err_en_US,
+ "Dummy argument '%s' has type %s; the corresponding argument in the interface body has distinct type %s"_err_en_US,
obj1.type.type().AsFortran(), obj2.type.type().AsFortran());
} else if (!ShapesAreCompatible(obj1, obj2)) {
Say(symbol1, symbol2,
diff --git a/flang/test/Semantics/separate-mp02.f90 b/flang/test/Semantics/separate-mp02.f90
index fd9c4c3cc18f98b..39a469b6ccc09e8 100644
--- a/flang/test/Semantics/separate-mp02.f90
+++ b/flang/test/Semantics/separate-mp02.f90
@@ -51,9 +51,9 @@ module subroutine s5(x, y)
real :: y
end
module subroutine s6(x, y)
- !ERROR: Dummy argument 'x' has type INTEGER(4); the corresponding argument in the interface body has type REAL(4)
+ !ERROR: Dummy argument 'x' has type INTEGER(4); the corresponding argument in the interface body has distinct type REAL(4)
integer :: x
- !ERROR: Dummy argument 'y' has type REAL(8); the corresponding argument in the interface body has type REAL(4)
+ !ERROR: Dummy argument 'y' has type REAL(8); the corresponding argument in the interface body has distinct type REAL(4)
real(8) :: y
end
module subroutine s7(x, y, z)
@@ -72,10 +72,10 @@ module subroutine s8(x, y, z)
end
module subroutine s9(x, y, z, w)
character(len=4) :: x
- !ERROR: Dummy argument 'y' has type CHARACTER(KIND=1,LEN=5_8); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=4_8)
+ !ERROR: Dummy argument 'y' has type CHARACTER(KIND=1,LEN=5_8); the corresponding argument in the interface body has distinct type CHARACTER(KIND=1,LEN=4_8)
character(len=5) :: y
character(len=*) :: z
- !ERROR: Dummy argument 'w' has type CHARACTER(KIND=1,LEN=4_8); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=*)
+ !ERROR: Dummy argument 'w' has type CHARACTER(KIND=1,LEN=4_8); the corresponding argument in the interface body has distinct type CHARACTER(KIND=1,LEN=*)
character(len=4) :: w
end
end
@@ -330,7 +330,7 @@ module subroutine sub1(s)
character(len=-1) s ! ok
end subroutine
module subroutine sub2(s)
- !ERROR: Dummy argument 's' has type CHARACTER(KIND=1,LEN=1_8); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=0_8)
+ !ERROR: Dummy argument 's' has type CHARACTER(KIND=1,LEN=1_8); the corresponding argument in the interface body has distinct type CHARACTER(KIND=1,LEN=0_8)
character(len=1) s
end subroutine
end submodule
diff --git a/flang/test/Semantics/separate-mp03.f90 b/flang/test/Semantics/separate-mp03.f90
index 33bf1cf8e414fd5..1bbeced44a4f7a2 100644
--- a/flang/test/Semantics/separate-mp03.f90
+++ b/flang/test/Semantics/separate-mp03.f90
@@ -74,7 +74,7 @@ pure module subroutine s2
end interface
contains
integer module function f1(x)
- !ERROR: Dummy argument 'x' has type INTEGER(4); the corresponding argument in the interface body has type REAL(4)
+ !ERROR: Dummy argument 'x' has type INTEGER(4); the corresponding argument in the interface body has distinct type REAL(4)
integer, intent(in) :: x
f1 = x
end function
diff --git a/flang/test/Semantics/separate-mp06.f90 b/flang/test/Semantics/separate-mp06.f90
new file mode 100644
index 000000000000000..9c76466d726dc63
--- /dev/null
+++ b/flang/test/Semantics/separate-mp06.f90
@@ -0,0 +1,98 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Structural equivalence of derived type definitions
+module m
+ interface
+ module subroutine s1(x)
+ type :: nonseq
+ integer :: n
+ end type
+ type(nonseq), intent(in) :: x
+ end subroutine
+ module subroutine s2(x)
+ type :: seq
+ sequence
+ integer :: n
+ end type
+ type(seq), intent(in) :: x
+ end subroutine
+ module subroutine s3(x)
+ type :: chlen
+ sequence
+ character(2) :: s
+ end type
+ type(chlen), intent(in) :: x
+ end subroutine
+ module subroutine s4(x)
+ !ERROR: A sequence type may not have type parameters
+ type :: pdt(k)
+ integer, kind :: k
+ sequence
+ real(k) :: a
+ end type
+ type(pdt(4)), intent(in) :: x
+ end subroutine
+ end interface
+end module
+
+submodule(m) sm
+ contains
+ module subroutine s1(x)
+ type :: nonseq
+ integer :: n
+ end type
+ !ERROR: Dummy argument 'x' has type nonseq; the corresponding argument in the interface body has distinct type nonseq
+ type(nonseq), intent(in) :: x
+ end subroutine
+ module subroutine s2(x) ! ok
+ type :: seq
+ sequence
+ integer :: n
+ end type
+ type(seq), intent(in) :: x
+ end subroutine
+ module subroutine s3(x)
+ type :: chlen
+ sequence
+ character(3) :: s ! note: length is 3, not 2
+ end type
+ !ERROR: Dummy argument 'x' has type chlen; the corresponding argument in the interface body has distinct type chlen
+ type(chlen), intent(in) :: x
+ end subroutine
+ module subroutine s4(x)
+ !ERROR: A sequence type may not have type parameters
+ type :: pdt(k)
+ integer, kind :: k
+ sequence
+ real(k) :: a
+ end type
+ !ERROR: Dummy argument 'x' has type pdt(k=4_4); the corresponding argument in the interface body has distinct type pdt(k=4_4)
+ type(pdt(4)), intent(in) :: x
+ end subroutine
+end submodule
+
+program main
+ use m
+ type :: nonseq
+ integer :: n
+ end type
+ type :: seq
+ sequence
+ integer :: n
+ end type
+ type :: chlen
+ sequence
+ character(2) :: s
+ end type
+ !ERROR: A sequence type may not have type parameters
+ type :: pdt(k)
+ integer, kind :: k
+ sequence
+ real(k) :: a
+ end type
+ !ERROR: Actual argument type 'nonseq' is not compatible with dummy argument type 'nonseq'
+ call s1(nonseq(1))
+ call s2(seq(1)) ! ok
+ call s3(chlen('ab')) ! ok, matches interface
+ !ERROR: Actual argument type 'pdt(k=4_4)' is not compatible with dummy argument type 'pdt(k=4_4)'
+ call s4(pdt(4)(3.14159))
+end program
|
F'202X 7.5.2.4 describes conditions under which two derived type definitions are to be considered equivalent. These rules are already implemented in Evaluate/type.cpp but not exposed for general use; rearrange the code a little so that the compatibility checking of separate module procedure interfaces and explicit definitions can use it to avoid emitting a bogus error message. Fixes llvm#67946.
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
F'202X 7.5.2.4 describes conditions under which two derived type definitions are to be considered equivalent. These rules are already implemented in Evaluate/type.cpp but not exposed for general use; rearrange the code a little so that the compatibility checking of separate module procedure interfaces and explicit definitions can use it to avoid emitting a bogus error message.
Fixes #67946.