Magic-Mirror/llvm-capstone
1
0
Fork 0
mirror of https://github.com/capstone-engine/llvm-capstone.git synced 2024-12-26 01:39:11 +00:00
Code Issues Actions 2 Packages Projects Releases Wiki Activity

[flang] Fix bogus error from assignment to CLASS(*)

Browse Source 
Assignment semantics was coughing up bad errors and crashes for
intrinsic assignments to unlimited polymorphic entities while
looking for any (impossible) user defined ASSIGNMENT(=) generic
or intrinsic type conversion.

Differential Revision: https://reviews.llvm.org/D122440
This commit is contained in:
Peter Klausler 2022-03-23 16:02:59 -07:00
parent 3784e8ccfb
commit 0363a164b6
4 changed files with 28 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
flang/lib/Semantics/expression.cpp
View File

@ -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<parser::CharBlock> 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<DynamicType> 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()) + ')'

3
flang/lib/Semantics/tools.cpp
View File

@ -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) {

19
flang/test/Semantics/resolve63.f90
View File

@ -265,9 +265,9 @@ contains
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 @@ module m8
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

4
flang/test/Semantics/selecttype03.f90
View File

@ -99,11 +99,11 @@ contains
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