Skip to content

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

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 7 commits into from
Oct 16, 2025
Merged

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

Show file tree
Hide file tree
Changes from 6 commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
f9d0ef9
initial commit
akuhlens Oct 9, 2025
84851cd
initial commit
akuhlens Oct 10, 2025
3044c06
remove mistakenly added files
akuhlens Oct 10, 2025
176c64c
fix whitespace in test
akuhlens Oct 10, 2025
0202c5e
address feedback
akuhlens Oct 15, 2025
cf1d47f
simplify checks of logical value
akuhlens Oct 15, 2025
e6feea5
simplify error string creation
akuhlens Oct 15, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
28 changes: 25 additions & 3 deletions flang/lib/Evaluate/intrinsics.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 {
Expand Down Expand Up @@ -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.)
Expand Down Expand Up @@ -2103,9 +2105,18 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
}
return std::nullopt;
} else if (!d.typePattern.categorySet.test(type->category())) {
std::string expectedText;
switch (d.typePattern.kindCode) {
case KindCode::extensibleOrUnlimitedType:
expectedText = "extensible derived or unlimited polymorphic type";
break;
default:
break;
}
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(),
expectedText.empty() ? "" : ", expected " + expectedText);
return std::nullopt; // argument has invalid type category
}
bool argOk{false};
Expand Down Expand Up @@ -2244,6 +2255,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 derived or unlimited polymorphic type"_err_en_US,
d.keyword, type->AsFortran());
return std::nullopt;
}
break;
default:
CRASH_NO_CASE;
}
Expand Down
73 changes: 73 additions & 0 deletions flang/test/Semantics/dynamic-type-intrinsics.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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 derived 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 derived 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 derived or unlimited polymorphic type
logical :: t1_10 = same_type_as(x1, x5)
!ERROR: Actual argument for 'a=' has bad type 'INTEGER(4)', expected extensible derived or unlimited polymorphic type
logical :: t1_11 = same_type_as(i, i)
!ERROR: Actual argument for 'a=' has bad type 'REAL(4)', expected extensible derived or unlimited polymorphic type
logical :: t1_12 = same_type_as(r, r)
!ERROR: Actual argument for 'a=' has bad type 'INTEGER(4)', expected extensible derived 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 derived 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 derived 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 derived or unlimited polymorphic type
logical :: t2_11 = extends_type_of(x1, x5)
end module