[flang-commits] [flang] d667b96 - [flang] Fix assignment of parameterized derived types
Peter Steinfeld via flang-commits
flang-commits at lists.llvm.org
Tue Apr 20 12:42:09 PDT 2021
Author: Peter Steinfeld
Date: 2021-04-20T12:41:52-07:00
New Revision: d667b96c98438edcc00ec85a3b151ac2dae862f3
URL: https://github.com/llvm/llvm-project/commit/d667b96c98438edcc00ec85a3b151ac2dae862f3
DIFF: https://github.com/llvm/llvm-project/commit/d667b96c98438edcc00ec85a3b151ac2dae862f3.diff
LOG: [flang] Fix assignment of parameterized derived types
We were erroneously emitting error messages for assignments of derived types
where the associated objects were instantiated with non-constant LEN type
parameters.
I fixed this by adding the member function MightBeAssignmentCompatibleWith() to
the class DerivedTypeSpec and calling it to determine whether it's possible
that objects of parameterized derived types can be assigned to each other. Its
implementation first compares the uninstantiated values of the types. If they
are equal, it then compares the values of the constant instantiated type
parameters.
I added tests to assign04.f90 to exercise this new code.
Differential Revision: https://reviews.llvm.org/D100868
Added:
Modified:
flang/include/flang/Semantics/type.h
flang/lib/Semantics/tools.cpp
flang/lib/Semantics/type.cpp
flang/test/Semantics/assign04.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h
index 6840f5b03517..eb506d1661e9 100644
--- a/flang/include/flang/Semantics/type.h
+++ b/flang/include/flang/Semantics/type.h
@@ -279,10 +279,9 @@ class DerivedTypeSpec {
return nullptr;
}
}
+ bool MightBeAssignmentCompatibleWith(const DerivedTypeSpec &) const;
bool operator==(const DerivedTypeSpec &that) const {
- return &typeSymbol_ == &that.typeSymbol_ && cooked_ == that.cooked_ &&
- parameters_ == that.parameters_ &&
- rawParameters_ == that.rawParameters_;
+ return RawEquals(that) && parameters_ == that.parameters_;
}
std::string AsFortran() const;
@@ -295,6 +294,10 @@ class DerivedTypeSpec {
bool instantiated_{false};
RawParameters rawParameters_;
ParameterMapType parameters_;
+ bool RawEquals(const DerivedTypeSpec &that) const {
+ return &typeSymbol_ == &that.typeSymbol_ && cooked_ == that.cooked_ &&
+ rawParameters_ == that.rawParameters_;
+ }
friend llvm::raw_ostream &operator<<(
llvm::raw_ostream &, const DerivedTypeSpec &);
};
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 68db3e186a99..a633ecbe1898 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -84,6 +84,18 @@ const Scope *FindPureProcedureContaining(const Scope &start) {
return IsPureProcedure(scope) ? &scope : nullptr;
}
+static bool MightHaveCompatibleDerivedtypes(
+ const std::optional<evaluate::DynamicType> &lhsType,
+ const std::optional<evaluate::DynamicType> &rhsType) {
+ const DerivedTypeSpec *lhsDerived{evaluate::GetDerivedTypeSpec(lhsType)};
+ const DerivedTypeSpec *rhsDerived{evaluate::GetDerivedTypeSpec(rhsType)};
+ if (!lhsDerived || !rhsDerived) {
+ return false;
+ }
+ return *lhsDerived == *rhsDerived ||
+ lhsDerived->MightBeAssignmentCompatibleWith(*rhsDerived);
+}
+
Tristate IsDefinedAssignment(
const std::optional<evaluate::DynamicType> &lhsType, int lhsRank,
const std::optional<evaluate::DynamicType> &rhsType, int rhsRank) {
@@ -97,15 +109,10 @@ Tristate IsDefinedAssignment(
} else if (lhsCat != TypeCategory::Derived) {
return ToTristate(lhsCat != rhsCat &&
(!IsNumericTypeCategory(lhsCat) || !IsNumericTypeCategory(rhsCat)));
+ } else if (MightHaveCompatibleDerivedtypes(lhsType, rhsType)) {
+ return Tristate::Maybe; // TYPE(t) = TYPE(t) can be defined or intrinsic
} else {
- const auto *lhsDerived{evaluate::GetDerivedTypeSpec(lhsType)};
- const auto *rhsDerived{evaluate::GetDerivedTypeSpec(rhsType)};
- if (lhsDerived && rhsDerived && *lhsDerived == *rhsDerived) {
- return Tristate::Maybe; // TYPE(t) = TYPE(t) can be defined or
- // intrinsic
- } else {
- return Tristate::Yes;
- }
+ return Tristate::Yes;
}
}
diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
index 99c48b36d337..16625c04bcc6 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -189,6 +189,36 @@ ParamValue *DerivedTypeSpec::FindParameter(SourceName target) {
const_cast<const DerivedTypeSpec *>(this)->FindParameter(target));
}
+// Objects of derived types might be assignment compatible if they are equal
+// with respect to everything other than their instantiated type parameters
+// and their constant instantiated type parameters have the same values.
+bool DerivedTypeSpec::MightBeAssignmentCompatibleWith(
+ const DerivedTypeSpec &that) const {
+ if (!RawEquals(that)) {
+ return false;
+ }
+ const std::map<SourceName, ParamValue> &theseParams{this->parameters()};
+ const std::map<SourceName, ParamValue> &thoseParams{that.parameters()};
+ auto thatIter{thoseParams.begin()};
+ for (const auto &[thisName, thisValue] : theseParams) {
+ CHECK(thatIter != thoseParams.end());
+ const ParamValue &thatValue{thatIter->second};
+ if (MaybeIntExpr thisExpr{thisValue.GetExplicit()}) {
+ if (evaluate::IsConstantExpr(*thisExpr)) {
+ if (MaybeIntExpr thatExpr{thatValue.GetExplicit()}) {
+ if (evaluate::IsConstantExpr(*thatExpr)) {
+ if (evaluate::ToInt64(*thisExpr) != evaluate::ToInt64(*thatExpr)) {
+ return false;
+ }
+ }
+ }
+ }
+ }
+ thatIter++;
+ }
+ return true;
+}
+
class InstantiateHelper {
public:
InstantiateHelper(Scope &scope) : scope_{scope} {}
diff --git a/flang/test/Semantics/assign04.f90 b/flang/test/Semantics/assign04.f90
index 8887b4d2dc37..806256f9b9bc 100644
--- a/flang/test/Semantics/assign04.f90
+++ b/flang/test/Semantics/assign04.f90
@@ -141,3 +141,34 @@ subroutine s11
!ERROR: Subroutine name is not allowed here
a = s11
end
+
+subroutine s12()
+ type dType(l1, k1, l2, k2)
+ integer, len :: l1
+ integer, kind :: k1
+ integer, len :: l2
+ integer, kind :: k2
+ end type
+
+ contains
+ subroutine sub(arg1, arg2, arg3)
+ integer :: arg1
+ type(dType(arg1, 2, *, 4)) :: arg2
+ type(dType(*, 2, arg1, 4)) :: arg3
+ type(dType(1, 2, 3, 4)) :: local1
+ type(dType(1, 2, 3, 4)) :: local2
+ type(dType(1, 2, arg1, 4)) :: local3
+ type(dType(9, 2, 3, 4)) :: local4
+ type(dType(1, 9, 3, 4)) :: local5
+
+ arg2 = arg3
+ arg2 = local1
+ arg3 = local1
+ local1 = local2
+ local2 = local3
+ !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(dtype(k1=2_4,k2=4_4,l1=1_4,l2=3_4)) and TYPE(dtype(k1=2_4,k2=4_4,l1=9_4,l2=3_4))
+ local1 = local4 ! mismatched constant KIND type parameter
+ !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(dtype(k1=2_4,k2=4_4,l1=1_4,l2=3_4)) and TYPE(dtype(k1=9_4,k2=4_4,l1=1_4,l2=3_4))
+ local1 = local5 ! mismatched constant LEN type parameter
+ end subroutine sub
+end subroutine s12
More information about the flang-commits
mailing list