Cold-Air-Networks/mirror-llvm-project
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 7

[flang][semantics] make sure dynamic type inquiry functions take extensible or unlimited polymorphic types (#162931)

Browse source 
Adds error message when type is derived but not extensible and more
detailed error message when the type doesn't match.
fixes [#162712](https://github.com/llvm/llvm-project/issues/162712)
This commit is contained in:
Andre Kuhlenschmidt 2025-10-15 18:47:43 -07:00 committed by GitHub
parent 754ebc6ebb
commit 5eba975f58
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
2 changed files with 93 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
flang/lib/Evaluate/intrinsics.cpp
View file

@ -111,6 +111,7 @@ ENUM_CLASS(KindCode, none, defaultIntegerKind,
atomicIntKind, // atomic_int_kind from iso_fortran_env
atomicIntOrLogicalKind, // atomic_int_kind or atomic_logical_kind
sameAtom, // same type and kind as atom
extensibleOrUnlimitedType, // extensible or unlimited polymorphic type
)
struct TypePattern {
@ -160,7 +161,8 @@ static constexpr TypePattern AnyChar{CharType, KindCode::any};
static constexpr TypePattern AnyLogical{LogicalType, KindCode::any};
static constexpr TypePattern AnyRelatable{RelatableType, KindCode::any};
static constexpr TypePattern AnyIntrinsic{IntrinsicType, KindCode::any};
static constexpr TypePattern ExtensibleDerived{DerivedType, KindCode::any};
static constexpr TypePattern ExtensibleDerived{
DerivedType, KindCode::extensibleOrUnlimitedType};
static constexpr TypePattern AnyData{AnyType, KindCode::any};
// Type is irrelevant, but not BOZ (for PRESENT(), OPTIONAL(), &c.)
@ -2103,9 +2105,13 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
}
return std::nullopt;
} else if (!d.typePattern.categorySet.test(type->category())) {
const char *expected{
d.typePattern.kindCode == KindCode::extensibleOrUnlimitedType
? ", expected extensible or unlimited polymorphic type"
: ""};
messages.Say(arg->sourceLocation(),
"Actual argument for '%s=' has bad type '%s'"_err_en_US, d.keyword,
type->AsFortran());
"Actual argument for '%s=' has bad type '%s'%s"_err_en_US, d.keyword,
type->AsFortran(), expected);
return std::nullopt; // argument has invalid type category
}
bool argOk{false};
@ -2244,6 +2250,17 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
return std::nullopt;
}
break;
case KindCode::extensibleOrUnlimitedType:
argOk = type->IsUnlimitedPolymorphic() ||
(type->category() == TypeCategory::Derived &&
IsExtensibleType(GetDerivedTypeSpec(type)));
if (!argOk) {
messages.Say(arg->sourceLocation(),
"Actual argument for '%s=' has type '%s', but was expected to be an extensible or unlimited polymorphic type"_err_en_US,
d.keyword, type->AsFortran());
return std::nullopt;
}
break;
default:
CRASH_NO_CASE;
}

73
flang/test/Semantics/dynamic-type-intrinsics.f90 Normal file
View file

@ -0,0 +1,73 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
module m
type :: t1
real :: x
end type
type :: t2(k)
integer, kind :: k
real(kind=k) :: x
end type
type :: t3
real :: x
end type
type, extends(t1) :: t4
integer :: y
end type
type :: t5
sequence
integer :: x
integer :: y
end type
integer :: i
real :: r
type(t1) :: x1, y1
type(t2(4)) :: x24, y24
type(t2(8)) :: x28
type(t3) :: x3
type(t4) :: x4
type(t5) :: x5
class(t1), allocatable :: a1
class(t3), allocatable :: a3
integer(kind=merge(kind(1),-1,same_type_as(x1, x1))) same_type_as_x1_x1_true
integer(kind=merge(kind(1),-1,same_type_as(x1, y1))) same_type_as_x1_y1_true
integer(kind=merge(kind(1),-1,same_type_as(x24, x24))) same_type_as_x24_x24_true
integer(kind=merge(kind(1),-1,same_type_as(x24, y24))) same_type_as_x24_y24_true
integer(kind=merge(kind(1),-1,same_type_as(x24, x28))) same_type_as_x24_x28_true
!ERROR: INTEGER(KIND=-1) is not a supported type
integer(kind=merge(kind(1),-1,same_type_as(x1, x3))) same_type_as_x1_x3_false
!ERROR: INTEGER(KIND=-1) is not a supported type
integer(kind=merge(kind(1),-1,same_type_as(a1, a3))) same_type_as_a1_a3_false
!ERROR: Actual argument for 'a=' has type 't5', but was expected to be an extensible or unlimited polymorphic type
logical :: t1_8 = same_type_as(x5, x5)
!ERROR: Actual argument for 'a=' has type 't5', but was expected to be an extensible or unlimited polymorphic type
logical :: t1_9 = same_type_as(x5, x1)
!ERROR: Actual argument for 'b=' has type 't5', but was expected to be an extensible or unlimited polymorphic type
logical :: t1_10 = same_type_as(x1, x5)
!ERROR: Actual argument for 'a=' has bad type 'INTEGER(4)', expected extensible or unlimited polymorphic type
logical :: t1_11 = same_type_as(i, i)
!ERROR: Actual argument for 'a=' has bad type 'REAL(4)', expected extensible or unlimited polymorphic type
logical :: t1_12 = same_type_as(r, r)
!ERROR: Actual argument for 'a=' has bad type 'INTEGER(4)', expected extensible or unlimited polymorphic type
logical :: t1_13 = same_type_as(i, t)
integer(kind=merge(kind(1),-1,extends_type_of(x1, y1))) extends_type_of_x1_y1_true
integer(kind=merge(kind(1),-1,extends_type_of(x24, x24))) extends_type_of_x24_x24_true
integer(kind=merge(kind(1),-1,extends_type_of(x24, y24))) extends_type_of_x24_y24_true
integer(kind=merge(kind(1),-1,extends_type_of(x24, x28))) extends_type_of_x24_x28_true
!ERROR: INTEGER(KIND=-1) is not a supported type
integer(kind=merge(kind(1),-1,extends_type_of(x1, x3))) extends_type_of_x1_x3_false
!ERROR: INTEGER(KIND=-1) is not a supported type
integer(kind=merge(kind(1),-1,extends_type_of(a1, a3))) extends_type_of_a1_a3_false
!ERROR: INTEGER(KIND=-1) is not a supported type
integer(kind=merge(kind(1),-1,extends_type_of(x1, x4))) extends_type_of_x1_x4_false
integer(kind=merge(kind(1),-1,extends_type_of(x4, x1))) extends_type_of_x4_x1_true
!ERROR: Actual argument for 'a=' has type 't5', but was expected to be an extensible or unlimited polymorphic type
logical :: t2_9 = extends_type_of(x5, x5)
!ERROR: Actual argument for 'a=' has type 't5', but was expected to be an extensible or unlimited polymorphic type
logical :: t2_10 = extends_type_of(x5, x1)
!ERROR: Actual argument for 'mold=' has type 't5', but was expected to be an extensible or unlimited polymorphic type
logical :: t2_11 = extends_type_of(x1, x5)
end module