From f9d0ef95e64ab749c5b4899f5784e750e381fcc4 Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Thu, 9 Oct 2025 14:47:40 -0700 Subject: [PATCH 1/7] initial commit --- flang/lib/Semantics/check-declarations.cpp | 2 ++ flang/test/Semantics/io11.f90 | 21 +++++++++++++++++++++ 2 files changed, 23 insertions(+) diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index ea5e2c095d31a..31e246cf0ab03 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -3622,6 +3622,7 @@ void CheckHelper::CheckDioDtvArg(const Symbol &proc, const Symbol &subp, ioKind == common::DefinedIo::ReadUnformatted ? Attr::INTENT_INOUT : Attr::INTENT_IN); + CheckDioDummyIsScalar(subp, *arg); } } @@ -3687,6 +3688,7 @@ void CheckHelper::CheckDioAssumedLenCharacterArg(const Symbol &subp, "Dummy argument '%s' of a defined input/output procedure must be assumed-length CHARACTER of default kind"_err_en_US, arg->name()); } + CheckDioDummyIsScalar(subp, *arg); } } diff --git a/flang/test/Semantics/io11.f90 b/flang/test/Semantics/io11.f90 index c00deede6b516..6bb7a71f0defc 100644 --- a/flang/test/Semantics/io11.f90 +++ b/flang/test/Semantics/io11.f90 @@ -809,3 +809,24 @@ subroutine wf(dtv, unit, iotype, v_list, iostat, iomsg) end end interface end + +module m30 + type base + character(5), allocatable :: data + end type + interface write(formatted) + subroutine formattedRead (dtv, unit, iotype, v_list, iostat, iomsg) + import base + !ERROR: Dummy argument 'dtv' of a defined input/output procedure must be a scalar + class (base), intent(in) :: dtv(10) + integer, intent(in) :: unit + !ERROR: Dummy argument 'iotype' of a defined input/output procedure must be a scalar + character(*), intent(in) :: iotype(2) + integer, intent(in) :: v_list(:) + !ERROR: Dummy argument 'iostat' of a defined input/output procedure must be a scalar + integer, intent(out) :: iostat(*) + !ERROR: Dummy argument 'iomsg' of a defined input/output procedure must be a scalar + character(*), intent(inout) :: iomsg(:) + end subroutine + end interface +end module From 84851cda9a369784e0444ad538183e8d23b40c93 Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Fri, 10 Oct 2025 15:02:42 -0700 Subject: [PATCH 2/7] initial commit --- flang/lib/Evaluate/intrinsics.cpp | 28 +++++++- .../Semantics/dynamic-type-intrinsics.f90 | 71 +++++++++++++++++++ 2 files changed, 96 insertions(+), 3 deletions(-) create mode 100644 flang/test/Semantics/dynamic-type-intrinsics.f90 diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index f204eef54ef84..ec69197937a47 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -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,18 @@ std::optional 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}; @@ -2244,6 +2255,17 @@ std::optional 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 bad type '%s', expected extensible derived or unlimited polymorphic type"_err_en_US, + d.keyword, type->AsFortran()); + return std::nullopt; + } + break; default: CRASH_NO_CASE; } diff --git a/flang/test/Semantics/dynamic-type-intrinsics.f90 b/flang/test/Semantics/dynamic-type-intrinsics.f90 new file mode 100644 index 0000000000000..f63f1ee483637 --- /dev/null +++ b/flang/test/Semantics/dynamic-type-intrinsics.f90 @@ -0,0 +1,71 @@ +! 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 + + + logical :: t1_1 = same_type_as(x1, x1) + logical :: t1_2 = same_type_as(x1, y1) + logical :: t1_3 = same_type_as(x24, x24) + logical :: t1_4 = same_type_as(x24, y24) + logical :: t1_5 = same_type_as(x24, x28) ! ignores parameter + logical :: t1_6 = .not. same_type_as(x1, x3) + logical :: t1_7 = .not. same_type_as(a1, a3) + !ERROR: Actual argument for 'a=' has bad type 't5', expected extensible derived or unlimited polymorphic type + logical :: t1_8 = same_type_as(x5, x5) + !ERROR: Actual argument for 'a=' has bad type 't5', expected extensible derived or unlimited polymorphic type + logical :: t1_9 = same_type_as(x5, x1) + !ERROR: Actual argument for 'b=' has bad type 't5', expected 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) + + logical :: t2_1 = extends_type_of(x1, y1) + logical :: t2_2 = extends_type_of(x24, x24) + logical :: t2_3 = extends_type_of(x24, y24) + logical :: t2_4 = extends_type_of(x24, x28) ! ignores parameter + logical :: t2_5 = .not. extends_type_of(x1, x3) + logical :: t2_6 = .not. extends_type_of(a1, a3) + logical :: t2_7 = .not. extends_type_of(x1, x4) + logical :: t2_8 = extends_type_of(x4, x1) + !ERROR: Actual argument for 'a=' has bad type 't5', expected extensible derived or unlimited polymorphic type + logical :: t2_9 = extends_type_of(x5, x5) + !ERROR: Actual argument for 'a=' has bad type 't5', expected extensible derived or unlimited polymorphic type + logical :: t2_10 = extends_type_of(x5, x1) + !ERROR: Actual argument for 'mold=' has bad type 't5', expected extensible derived or unlimited polymorphic type + logical :: t2_11 = extends_type_of(x1, x5) +end module + \ No newline at end of file From 3044c06fc0db3ca99b3129b205d132db68083774 Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Fri, 10 Oct 2025 15:17:41 -0700 Subject: [PATCH 3/7] remove mistakenly added files --- flang/lib/Semantics/check-declarations.cpp | 2 -- flang/test/Semantics/io11.f90 | 21 --------------------- 2 files changed, 23 deletions(-) diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 31e246cf0ab03..ea5e2c095d31a 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -3622,7 +3622,6 @@ void CheckHelper::CheckDioDtvArg(const Symbol &proc, const Symbol &subp, ioKind == common::DefinedIo::ReadUnformatted ? Attr::INTENT_INOUT : Attr::INTENT_IN); - CheckDioDummyIsScalar(subp, *arg); } } @@ -3688,7 +3687,6 @@ void CheckHelper::CheckDioAssumedLenCharacterArg(const Symbol &subp, "Dummy argument '%s' of a defined input/output procedure must be assumed-length CHARACTER of default kind"_err_en_US, arg->name()); } - CheckDioDummyIsScalar(subp, *arg); } } diff --git a/flang/test/Semantics/io11.f90 b/flang/test/Semantics/io11.f90 index 6bb7a71f0defc..c00deede6b516 100644 --- a/flang/test/Semantics/io11.f90 +++ b/flang/test/Semantics/io11.f90 @@ -809,24 +809,3 @@ subroutine wf(dtv, unit, iotype, v_list, iostat, iomsg) end end interface end - -module m30 - type base - character(5), allocatable :: data - end type - interface write(formatted) - subroutine formattedRead (dtv, unit, iotype, v_list, iostat, iomsg) - import base - !ERROR: Dummy argument 'dtv' of a defined input/output procedure must be a scalar - class (base), intent(in) :: dtv(10) - integer, intent(in) :: unit - !ERROR: Dummy argument 'iotype' of a defined input/output procedure must be a scalar - character(*), intent(in) :: iotype(2) - integer, intent(in) :: v_list(:) - !ERROR: Dummy argument 'iostat' of a defined input/output procedure must be a scalar - integer, intent(out) :: iostat(*) - !ERROR: Dummy argument 'iomsg' of a defined input/output procedure must be a scalar - character(*), intent(inout) :: iomsg(:) - end subroutine - end interface -end module From 176c64c3ec43218d61bc27bedfee69aaf4a896a4 Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Fri, 10 Oct 2025 15:19:55 -0700 Subject: [PATCH 4/7] fix whitespace in test --- flang/test/Semantics/dynamic-type-intrinsics.f90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/flang/test/Semantics/dynamic-type-intrinsics.f90 b/flang/test/Semantics/dynamic-type-intrinsics.f90 index f63f1ee483637..12e87cc1b5793 100644 --- a/flang/test/Semantics/dynamic-type-intrinsics.f90 +++ b/flang/test/Semantics/dynamic-type-intrinsics.f90 @@ -19,8 +19,7 @@ module m integer :: x integer :: y end type - - + integer :: i real :: r type(t1) :: x1, y1 @@ -32,7 +31,6 @@ module m class(t1), allocatable :: a1 class(t3), allocatable :: a3 - logical :: t1_1 = same_type_as(x1, x1) logical :: t1_2 = same_type_as(x1, y1) logical :: t1_3 = same_type_as(x24, x24) @@ -52,7 +50,7 @@ module m 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) - + logical :: t2_1 = extends_type_of(x1, y1) logical :: t2_2 = extends_type_of(x24, x24) logical :: t2_3 = extends_type_of(x24, y24) @@ -68,4 +66,3 @@ module m !ERROR: Actual argument for 'mold=' has bad type 't5', expected extensible derived or unlimited polymorphic type logical :: t2_11 = extends_type_of(x1, x5) end module - \ No newline at end of file From 0202c5e5890b422bf82eba60abaf465ba9c5cb7e Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Wed, 15 Oct 2025 10:31:45 -0700 Subject: [PATCH 5/7] address feedback --- flang/lib/Evaluate/intrinsics.cpp | 10 ++--- .../Semantics/dynamic-type-intrinsics.f90 | 42 +++++++++---------- 2 files changed, 26 insertions(+), 26 deletions(-) diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index ec69197937a47..ff71b119c48e7 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -111,7 +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 + extensibleOrUnlimitedType, // extensible or unlimited polymorphic type ) struct TypePattern { @@ -162,7 +162,7 @@ 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::ExtensibleOrUnlimitedType}; + DerivedType, KindCode::extensibleOrUnlimitedType}; static constexpr TypePattern AnyData{AnyType, KindCode::any}; // Type is irrelevant, but not BOZ (for PRESENT(), OPTIONAL(), &c.) @@ -2107,7 +2107,7 @@ std::optional IntrinsicInterface::Match( } else if (!d.typePattern.categorySet.test(type->category())) { std::string expectedText; switch (d.typePattern.kindCode) { - case KindCode::ExtensibleOrUnlimitedType: + case KindCode::extensibleOrUnlimitedType: expectedText = "extensible derived or unlimited polymorphic type"; break; default: @@ -2255,13 +2255,13 @@ std::optional IntrinsicInterface::Match( return std::nullopt; } break; - case KindCode::ExtensibleOrUnlimitedType: + case KindCode::extensibleOrUnlimitedType: argOk = type->IsUnlimitedPolymorphic() || (type->category() == TypeCategory::Derived && IsExtensibleType(GetDerivedTypeSpec(type))); if (!argOk) { messages.Say(arg->sourceLocation(), - "Actual argument for '%s=' has bad type '%s', expected extensible derived or unlimited polymorphic type"_err_en_US, + "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; } diff --git a/flang/test/Semantics/dynamic-type-intrinsics.f90 b/flang/test/Semantics/dynamic-type-intrinsics.f90 index 12e87cc1b5793..2a0b316f33c99 100644 --- a/flang/test/Semantics/dynamic-type-intrinsics.f90 +++ b/flang/test/Semantics/dynamic-type-intrinsics.f90 @@ -31,18 +31,18 @@ module m class(t1), allocatable :: a1 class(t3), allocatable :: a3 - logical :: t1_1 = same_type_as(x1, x1) - logical :: t1_2 = same_type_as(x1, y1) - logical :: t1_3 = same_type_as(x24, x24) - logical :: t1_4 = same_type_as(x24, y24) - logical :: t1_5 = same_type_as(x24, x28) ! ignores parameter - logical :: t1_6 = .not. same_type_as(x1, x3) - logical :: t1_7 = .not. same_type_as(a1, a3) - !ERROR: Actual argument for 'a=' has bad type 't5', expected extensible derived or unlimited polymorphic type + 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 + integer(kind=merge(-1,kind(1),same_type_as(x1, x3))) same_type_as_x1_x3_false + integer(kind=merge(-1,kind(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 bad type 't5', expected extensible derived or unlimited polymorphic type + !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 bad type 't5', expected extensible derived or unlimited polymorphic type + !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) @@ -51,18 +51,18 @@ module m !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) - logical :: t2_1 = extends_type_of(x1, y1) - logical :: t2_2 = extends_type_of(x24, x24) - logical :: t2_3 = extends_type_of(x24, y24) - logical :: t2_4 = extends_type_of(x24, x28) ! ignores parameter - logical :: t2_5 = .not. extends_type_of(x1, x3) - logical :: t2_6 = .not. extends_type_of(a1, a3) - logical :: t2_7 = .not. extends_type_of(x1, x4) - logical :: t2_8 = extends_type_of(x4, x1) - !ERROR: Actual argument for 'a=' has bad type 't5', expected extensible derived or unlimited polymorphic type + 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 + integer(kind=merge(-1,kind(1),extends_type_of(x1, x3))) extends_type_of_x1_x3_false + integer(kind=merge(-1,kind(1),extends_type_of(a1, a3))) extends_type_of_a1_a3_false + integer(kind=merge(-1,kind(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 bad type 't5', expected extensible derived or unlimited polymorphic type + !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 bad type 't5', expected extensible derived or unlimited polymorphic type + !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 From cf1d47f968ff202032f6f0a9fa3e651f3b7c2847 Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Wed, 15 Oct 2025 10:38:05 -0700 Subject: [PATCH 6/7] simplify checks of logical value --- flang/test/Semantics/dynamic-type-intrinsics.f90 | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/flang/test/Semantics/dynamic-type-intrinsics.f90 b/flang/test/Semantics/dynamic-type-intrinsics.f90 index 2a0b316f33c99..c867a04726fc7 100644 --- a/flang/test/Semantics/dynamic-type-intrinsics.f90 +++ b/flang/test/Semantics/dynamic-type-intrinsics.f90 @@ -36,8 +36,10 @@ module m 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 - integer(kind=merge(-1,kind(1),same_type_as(x1, x3))) same_type_as_x1_x3_false - integer(kind=merge(-1,kind(1),same_type_as(a1, a3))) same_type_as_a1_a3_false + !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 @@ -55,9 +57,12 @@ module m 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 - integer(kind=merge(-1,kind(1),extends_type_of(x1, x3))) extends_type_of_x1_x3_false - integer(kind=merge(-1,kind(1),extends_type_of(a1, a3))) extends_type_of_a1_a3_false - integer(kind=merge(-1,kind(1),extends_type_of(x1, x4))) extends_type_of_x1_x4_false + !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) From e6feea51508e389793d8939fbc6665d43c245c3d Mon Sep 17 00:00:00 2001 From: Andre Kuhlenschmidt Date: Wed, 15 Oct 2025 11:33:43 -0700 Subject: [PATCH 7/7] simplify error string creation --- flang/lib/Evaluate/intrinsics.cpp | 17 ++++++----------- .../test/Semantics/dynamic-type-intrinsics.f90 | 18 +++++++++--------- 2 files changed, 15 insertions(+), 20 deletions(-) diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index ff71b119c48e7..1de5e6b53ba71 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -2105,18 +2105,13 @@ std::optional 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; - } + 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'%s"_err_en_US, d.keyword, - type->AsFortran(), - expectedText.empty() ? "" : ", expected " + expectedText); + type->AsFortran(), expected); return std::nullopt; // argument has invalid type category } bool argOk{false}; @@ -2261,7 +2256,7 @@ std::optional IntrinsicInterface::Match( 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, + "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; } diff --git a/flang/test/Semantics/dynamic-type-intrinsics.f90 b/flang/test/Semantics/dynamic-type-intrinsics.f90 index c867a04726fc7..a4ce3db2532c5 100644 --- a/flang/test/Semantics/dynamic-type-intrinsics.f90 +++ b/flang/test/Semantics/dynamic-type-intrinsics.f90 @@ -40,17 +40,17 @@ module m 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 + !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 derived or unlimited polymorphic type + !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 derived or unlimited polymorphic type + !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 derived or unlimited polymorphic type + !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 derived or unlimited polymorphic type + !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 derived or unlimited polymorphic type + !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 @@ -64,10 +64,10 @@ module m !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 + !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 derived or unlimited polymorphic type + !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 derived or unlimited polymorphic type + !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