diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index fcfe98ef90ac6..342f34164f176 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -3595,7 +3595,8 @@ const Symbol *ArgumentAnalyzer::FindBoundOp( void ArgumentAnalyzer::AddAssignmentConversion( const DynamicType &lhsType, const DynamicType &rhsType) { if (lhsType.category() == rhsType.category() && - lhsType.kind() == rhsType.kind()) { + (lhsType.category() == TypeCategory::Derived || + lhsType.kind() == rhsType.kind())) { // no conversion necessary } else if (auto rhsExpr{evaluate::ConvertToType(lhsType, MoveExpr(1))}) { std::optional source; @@ -3684,7 +3685,10 @@ std::string ArgumentAnalyzer::TypeAsFortran(std::size_t i) { if (i >= actuals_.size() || !actuals_[i]) { return "missing argument"; } else if (std::optional type{GetType(i)}) { - return type->category() == TypeCategory::Derived + return type->IsAssumedType() ? "TYPE(*)"s + : type->IsUnlimitedPolymorphic() ? "CLASS(*)"s + : type->IsPolymorphic() ? "CLASS("s + type->AsFortran() + ')' + : type->category() == TypeCategory::Derived ? "TYPE("s + type->AsFortran() + ')' : type->category() == TypeCategory::Character ? "CHARACTER(KIND="s + std::to_string(type->kind()) + ')' diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index 1a2d931825bf4..9bad51dd4371b 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -103,6 +103,9 @@ Tristate IsDefinedAssignment( if (!lhsType || !rhsType) { return Tristate::No; // error or rhs is untyped } + if (lhsType->IsUnlimitedPolymorphic() || rhsType->IsUnlimitedPolymorphic()) { + return Tristate::No; + } TypeCategory lhsCat{lhsType->category()}; TypeCategory rhsCat{rhsType->category()}; if (rhsRank > 0 && lhsRank != rhsRank) { diff --git a/flang/test/Semantics/resolve63.f90 b/flang/test/Semantics/resolve63.f90 index fa3ab84fc0b99..af6c2e4d94d16 100644 --- a/flang/test/Semantics/resolve63.f90 +++ b/flang/test/Semantics/resolve63.f90 @@ -265,9 +265,9 @@ subroutine test(x, y, z) i = x + y i = x + i i = y + i - !ERROR: No intrinsic or user-defined OPERATOR(+) matches operand types TYPE(t2) and TYPE(t1) + !ERROR: No intrinsic or user-defined OPERATOR(+) matches operand types CLASS(t2) and CLASS(t1) i = y + x - !ERROR: No intrinsic or user-defined OPERATOR(+) matches operand types INTEGER(4) and TYPE(t1) + !ERROR: No intrinsic or user-defined OPERATOR(+) matches operand types INTEGER(4) and CLASS(t1) i = i + x end end @@ -344,3 +344,18 @@ subroutine test call generic(null(), null()) end subroutine end + +! Ensure no bogus errors for assignments to CLASS(*) allocatable +module m10 + type :: t1 + integer :: n + end type + contains + subroutine test + class(*), allocatable :: poly + poly = 1 + poly = 3.14159 + poly = 'Il faut imaginer Sisyphe heureux' + poly = t1(1) + end subroutine +end module diff --git a/flang/test/Semantics/selecttype03.f90 b/flang/test/Semantics/selecttype03.f90 index 73274e214e47d..45ecf51164fe9 100644 --- a/flang/test/Semantics/selecttype03.f90 +++ b/flang/test/Semantics/selecttype03.f90 @@ -99,11 +99,11 @@ function foo(i) integer :: i class(t1),DIMENSION(:),allocatable :: foo integer, dimension(2) :: U - U = (/ 1,2 /) + U = (/ 1,2 /) if (i>0) then foo = array1(2,U) else if (i<0) then - !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(t1) and TYPE(t2) + !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types CLASS(t1) and CLASS(t2) foo = array2(2,U) end if end function