From e690b765debab0fd0889568b9dee2609797888ce Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Fri, 21 Nov 2025 16:29:03 -0800 Subject: [PATCH 01/10] [flang] implement show_descriptor intrinsic, a non-standard extension --- .../include/flang-rt/runtime/descriptor.h | 4 +- flang-rt/lib/runtime/descriptor.cpp | 162 +++++++++++- flang-rt/lib/runtime/extensions.cpp | 9 + .../flang/Optimizer/Builder/IntrinsicCall.h | 1 + .../Optimizer/Builder/Runtime/Intrinsics.h | 3 + flang/include/flang/Runtime/extensions.h | 3 + flang/lib/Evaluate/intrinsics.cpp | 2 + flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 16 ++ .../Optimizer/Builder/Runtime/Intrinsics.cpp | 7 + .../test/Lower/Intrinsics/show_descriptor.f90 | 236 ++++++++++++++++++ 10 files changed, 437 insertions(+), 6 deletions(-) create mode 100644 flang/test/Lower/Intrinsics/show_descriptor.f90 diff --git a/flang-rt/include/flang-rt/runtime/descriptor.h b/flang-rt/include/flang-rt/runtime/descriptor.h index ff7ec050d32c7..9ee5c1ac71db0 100644 --- a/flang-rt/include/flang-rt/runtime/descriptor.h +++ b/flang-rt/include/flang-rt/runtime/descriptor.h @@ -510,7 +510,9 @@ class Descriptor { RT_API_ATTRS void Check() const; - void Dump(FILE * = stdout) const; + // When dumpRawType, dumps stringified CFI_type_*, otherwise + // try to canonicalize and pront as a Fortran type. + void Dump(FILE * = stdout, bool dumpRawType = true) const; RT_API_ATTRS inline bool HasAddendum() const { return raw_.extra & _CFI_ADDENDUM_FLAG; diff --git a/flang-rt/lib/runtime/descriptor.cpp b/flang-rt/lib/runtime/descriptor.cpp index 5ede5f9d9f9ed..5a35ea8e2a11b 100644 --- a/flang-rt/lib/runtime/descriptor.cpp +++ b/flang-rt/lib/runtime/descriptor.cpp @@ -292,14 +292,166 @@ RT_API_ATTRS void Descriptor::Check() const { // TODO } -void Descriptor::Dump(FILE *f) const { +static const char *GetTypeStr(ISO::CFI_type_t type, bool dumpRawType) { + if (dumpRawType) { +#define CASE(x) case (x): return #x; + switch (type) { + CASE(CFI_type_signed_char) + CASE(CFI_type_short) + CASE(CFI_type_int) + CASE(CFI_type_long) + CASE(CFI_type_long_long) + CASE(CFI_type_size_t) + CASE(CFI_type_int8_t) + CASE(CFI_type_int16_t) + CASE(CFI_type_int32_t) + CASE(CFI_type_int64_t) + CASE(CFI_type_int128_t) + CASE(CFI_type_int_least8_t) + CASE(CFI_type_int_least16_t) + CASE(CFI_type_int_least32_t) + CASE(CFI_type_int_least64_t) + CASE(CFI_type_int_least128_t) + CASE(CFI_type_int_fast8_t) + CASE(CFI_type_int_fast16_t) + CASE(CFI_type_int_fast32_t) + CASE(CFI_type_int_fast64_t) + CASE(CFI_type_int_fast128_t) + CASE(CFI_type_intmax_t) + CASE(CFI_type_intptr_t) + CASE(CFI_type_ptrdiff_t) + CASE(CFI_type_half_float) + CASE(CFI_type_bfloat) + CASE(CFI_type_float) + CASE(CFI_type_double) + CASE(CFI_type_extended_double) + CASE(CFI_type_long_double) + CASE(CFI_type_float128) + CASE(CFI_type_half_float_Complex) + CASE(CFI_type_bfloat_Complex) + CASE(CFI_type_float_Complex) + CASE(CFI_type_double_Complex) + CASE(CFI_type_extended_double_Complex) + CASE(CFI_type_long_double_Complex) + CASE(CFI_type_float128_Complex) + CASE(CFI_type_Bool) + CASE(CFI_type_char) + CASE(CFI_type_cptr) + CASE(CFI_type_struct) + CASE(CFI_type_char16_t) + CASE(CFI_type_char32_t) + CASE(CFI_type_uint8_t) + CASE(CFI_type_uint16_t) + CASE(CFI_type_uint32_t) + CASE(CFI_type_uint64_t) + CASE(CFI_type_uint128_t) + } +#undef CASE + return nullptr; + } + TypeCode code{type}; + + if (!code.IsValid()) + return "invalid"; + + common::optional> categoryAndKind = + code.GetCategoryAndKind(); + if (!categoryAndKind) + return nullptr; + + TypeCategory tcat; + int kind; + std::tie(tcat, kind) = *categoryAndKind; + +#define CASE(cat, k) \ + case (k): \ + return #cat "(kind=" #k ")"; + switch (tcat) { + case TypeCategory::Integer: + switch (kind) { + CASE(INTEGER, 1) + CASE(INTEGER, 2) + CASE(INTEGER, 4) + CASE(INTEGER, 8) + CASE(INTEGER, 16) + } + break; + case TypeCategory::Unsigned: + switch (kind) { + CASE(UNSIGNED, 1) + CASE(UNSIGNED, 2) + CASE(UNSIGNED, 4) + CASE(UNSIGNED, 8) + CASE(UNSIGNED, 16) + } + break; + case TypeCategory::Real: + switch (kind) { + CASE(REAL, 2) + CASE(REAL, 3) + CASE(REAL, 4) + CASE(REAL, 8) + CASE(REAL, 10) + CASE(REAL, 16) + } + break; + case TypeCategory::Complex: + switch (kind) { + CASE(COMPLEX, 2) + CASE(COMPLEX, 3) + CASE(COMPLEX, 4) + CASE(COMPLEX, 8) + CASE(COMPLEX, 10) + CASE(COMPLEX, 16) + } + break; + case TypeCategory::Character: + switch (kind) { + CASE(CHARACTER, 1) + CASE(CHARACTER, 2) + CASE(CHARACTER, 4) + } + break; + case TypeCategory::Logical: + switch (kind) { + CASE(LOGICAL, 1) + CASE(LOGICAL, 2) + CASE(LOGICAL, 4) + CASE(LOGICAL, 8) + } + break; + case TypeCategory::Derived: + return "DERIVED"; + } +#undef CASE + return nullptr; +} + +void Descriptor::Dump(FILE *f, bool dumpRawType) const { std::fprintf(f, "Descriptor @ %p:\n", reinterpret_cast(this)); std::fprintf(f, " base_addr %p\n", raw_.base_addr); - std::fprintf(f, " elem_len %zd\n", static_cast(raw_.elem_len)); + std::fprintf(f, " elem_len %zd\n", ElementBytes()); std::fprintf(f, " version %d\n", static_cast(raw_.version)); - std::fprintf(f, " rank %d\n", static_cast(raw_.rank)); - std::fprintf(f, " type %d\n", static_cast(raw_.type)); - std::fprintf(f, " attribute %d\n", static_cast(raw_.attribute)); + if (rank() > 0) { + std::fprintf(f, " rank %d\n", rank()); + } else { + std::fprintf(f, " scalar\n"); + } + int ty = static_cast(raw_.type); + if (const char *tyStr = GetTypeStr(raw_.type, dumpRawType)) { + std::fprintf(f, " type %d \"%s\"\n", ty, tyStr); + } else { + std::fprintf(f, " type %d\n", ty); + } + int attr = static_cast(raw_.attribute); + if (IsPointer()) { + std::fprintf(f, " attribute %d (pointer) \n", attr); + } else if (IsAllocatable()) { + std::fprintf(f, " attribute %d (allocatable)\n", attr); + } else { + std::fprintf(f, " attribute %d\n", attr); + } + std::fprintf(f, " extra %d\n", static_cast(raw_.extra)); std::fprintf(f, " addendum %d\n", static_cast(HasAddendum())); std::fprintf(f, " alloc_idx %d\n", static_cast(GetAllocIdx())); diff --git a/flang-rt/lib/runtime/extensions.cpp b/flang-rt/lib/runtime/extensions.cpp index 19e75143705ab..29bccc50aa7e9 100644 --- a/flang-rt/lib/runtime/extensions.cpp +++ b/flang-rt/lib/runtime/extensions.cpp @@ -398,6 +398,15 @@ std::int64_t RTNAME(time)() { return time(nullptr); } // MCLOCK: returns accumulated CPU time in ticks std::int32_t FORTRAN_PROCEDURE_NAME(mclock)() { return std::clock(); } +void RTNAME(ShowDescriptor)(const char *descr) { + if (descr) { + reinterpret_cast(descr)->Dump( + stderr, /*dumpRawType=*/false); + } else { + std::fprintf(stderr, "NULL\n"); + } +} + // Extension procedures related to I/O namespace io { diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h index ce0b26c868701..31ebb15b40f04 100644 --- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h +++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h @@ -408,6 +408,7 @@ struct IntrinsicLibrary { template mlir::Value genShift(mlir::Type resultType, llvm::ArrayRef); mlir::Value genShiftA(mlir::Type resultType, llvm::ArrayRef); + void genShowDescriptor(llvm::ArrayRef); mlir::Value genSign(mlir::Type, llvm::ArrayRef); mlir::Value genSind(mlir::Type, llvm::ArrayRef); mlir::Value genSinpi(mlir::Type, llvm::ArrayRef); diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h index 7a97172cfbb9a..b4bedc36ca88e 100644 --- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h @@ -109,6 +109,9 @@ void genSleep(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value genChdir(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value name); +/// generate dump of a descriptor +void genShowDescriptor(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value descriptor); } // namespace runtime } // namespace fir diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h index 9fd3e118a0f22..5788ea2aa7606 100644 --- a/flang/include/flang/Runtime/extensions.h +++ b/flang/include/flang/Runtime/extensions.h @@ -101,5 +101,8 @@ int FORTRAN_PROCEDURE_NAME(mclock)(); float FORTRAN_PROCEDURE_NAME(secnds)(float *refTime); float RTNAME(Secnds)(float *refTime, const char *sourceFile, int line); +// Extension subroutine SHOW_DESCRIPTOR(D) +void RTNAME(ShowDescriptor)(const char* descr); + } // extern "C" #endif // FORTRAN_RUNTIME_EXTENSIONS_H_ diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index 8f4204b1f9afe..45432ca01fec9 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -1701,6 +1701,8 @@ static const IntrinsicInterface intrinsicSubroutine[]{ {}, Rank::scalar, IntrinsicClass::impureSubroutine}, {"second", {{"time", DefaultReal, Rank::scalar}}, {}, Rank::scalar, IntrinsicClass::impureSubroutine}, + {"show_descriptor", {{"d", AnyData, Rank::anyOrAssumedRank}}, {}, + Rank::elemental, IntrinsicClass::impureSubroutine}, {"system", {{"command", DefaultChar, Rank::scalar}, {"exitstat", DefaultInt, Rank::scalar, Optionality::optional, diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index 60dc02474faf6..660877bbfd34b 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -710,6 +710,10 @@ static constexpr IntrinsicHandler handlers[]{ {"shifta", &I::genShiftA}, {"shiftl", &I::genShift}, {"shiftr", &I::genShift}, + {"show_descriptor", + &I::genShowDescriptor, + {{{"d", asBox}}}, + /*isElemental=*/false}, {"sign", &I::genSign}, {"signal", &I::genSignalSubroutine, @@ -7814,6 +7818,18 @@ mlir::Value IntrinsicLibrary::genShiftA(mlir::Type resultType, return result; } +void +IntrinsicLibrary::genShowDescriptor( + llvm::ArrayRef args) { + assert(args.size() == 1); + const mlir::Value descriptor = fir::getBase(args[0]); + + assert(fir::isa_box_type(descriptor.getType()) && + "argument must have been lowered to box type"); + // mlir::Value descrAddr = fir::BoxAddrOp::create(builder, loc, descriptor); + fir::runtime::genShowDescriptor(builder, loc, descriptor); +} + // SIGNAL void IntrinsicLibrary::genSignalSubroutine( llvm::ArrayRef args) { diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp index 110b1b20898c7..0317bc35c978f 100644 --- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp @@ -461,3 +461,10 @@ mlir::Value fir::runtime::genChdir(fir::FirOpBuilder &builder, fir::runtime::createArguments(builder, loc, func.getFunctionType(), name); return fir::CallOp::create(builder, loc, func, args).getResult(0); } + +void fir::runtime::genShowDescriptor(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value descAddr) { + mlir::func::FuncOp func{ + fir::runtime::getRuntimeFunc(loc, builder)}; + fir::CallOp::create(builder, loc, func, descAddr); +} diff --git a/flang/test/Lower/Intrinsics/show_descriptor.f90 b/flang/test/Lower/Intrinsics/show_descriptor.f90 new file mode 100644 index 0000000000000..2eb648526582a --- /dev/null +++ b/flang/test/Lower/Intrinsics/show_descriptor.f90 @@ -0,0 +1,236 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +subroutine test_int +! CHECK-LABEL: func.func @_QPtest_int() { + implicit none + integer :: n + integer,allocatable :: a(:) + n = 5 + allocate(a(n)) +! CHECK: %[[C3:.*]] = arith.constant 3 : index +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[C5:.*]] = arith.constant 5 : i32 +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[DUMMY_SCOPE_0:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[ALLOCA_0:.*]] = fir.alloca !fir.box>> {bindc_name = "a", uniq_name = "_QFtest_intEa"} +! CHECK: %[[ZERO_BITS_0:.*]] = fir.zero_bits !fir.heap> +! CHECK: %[[SHAPE_0:.*]] = fir.shape %[[C0]] : (index) -> !fir.shape<1> +! CHECK: %[[EMBOX_0:.*]] = fir.embox %[[ZERO_BITS_0]](%[[SHAPE_0]]) : (!fir.heap>, !fir.shape<1>) -> !fir.box>> +! CHECK: fir.store %[[EMBOX_0]] to %[[ALLOCA_0]] : !fir.ref>>> +! CHECK: %[[DECLARE_0:.*]] = fir.declare %[[ALLOCA_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_intEa"} : (!fir.ref>>>) -> !fir.ref>>> +! CHECK: %[[ALLOCA_1:.*]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFtest_intEn"} +! CHECK: %[[DECLARE_1:.*]] = fir.declare %[[ALLOCA_1]] {uniq_name = "_QFtest_intEn"} : (!fir.ref) -> !fir.ref +! CHECK: fir.store %[[C5]] to %[[DECLARE_1]] : !fir.ref +! CHECK: %[[LOAD_0:.*]] = fir.load %[[DECLARE_1]] : !fir.ref +! CHECK: %[[CONVERT_0:.*]] = fir.convert %[[LOAD_0]] : (i32) -> index +! CHECK: %[[CMPI_0:.*]] = arith.cmpi sgt, %[[CONVERT_0]], %[[C0]] : index +! CHECK: %[[SELECT_0:.*]] = arith.select %[[CMPI_0]], %[[CONVERT_0]], %[[C0]] : index +! CHECK: %[[ALLOCMEM_0:.*]] = fir.allocmem !fir.array, %[[SELECT_0]] {fir.must_be_heap = true, uniq_name = "_QFtest_intEa.alloc"} + + call show_descriptor(a) +! CHECK: %[[SHAPE_1:.*]] = fir.shape %[[SELECT_0]] : (index) -> !fir.shape<1> +! CHECK: %[[EMBOX_1:.*]] = fir.embox %[[ALLOCMEM_0]](%[[SHAPE_1]]) : (!fir.heap>, !fir.shape<1>) -> !fir.box>> +! CHECK: fir.store %[[EMBOX_1]] to %[[DECLARE_0]] : !fir.ref>>> +! CHECK: %[[LOAD_1:.*]] = fir.load %[[DECLARE_0]] : !fir.ref>>> +! CHECK: fir.call @_FortranAShowDescriptor(%[[LOAD_1]]) fastmath : (!fir.box>>) -> () + + call show_descriptor(a(1:3)) +! CHECK: %[[LOAD_2:.*]] = fir.load %[[DECLARE_0]] : !fir.ref>>> +! CHECK: %[[SHAPE_2:.*]] = fir.shape %[[C3]] : (index) -> !fir.shape<1> +! CHECK: %[[BOX_ADDR_0:.*]] = fir.box_addr %[[LOAD_2]] : (!fir.box>>) -> !fir.heap> +! CHECK: %[[CONSTANT_4:.*]] = arith.constant 0 : index +! CHECK: %[[BOX_DIMS_0:.*]]:3 = fir.box_dims %[[LOAD_2]], %[[CONSTANT_4]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[SHAPE_SHIFT_0:.*]] = fir.shape_shift %[[BOX_DIMS_0]]#0, %[[BOX_DIMS_0]]#1 : (index, index) -> !fir.shapeshift<1> +! CHECK: %[[ARRAY_COOR_0:.*]] = fir.array_coor %[[BOX_ADDR_0]](%[[SHAPE_SHIFT_0]]) %[[C1]] : (!fir.heap>, !fir.shapeshift<1>, index) -> !fir.ref +! CHECK: %[[CONVERT_1:.*]] = fir.convert %[[ARRAY_COOR_0]] : (!fir.ref) -> !fir.ref> +! CHECK: %[[EMBOX_2:.*]] = fir.embox %[[CONVERT_1]](%[[SHAPE_2]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box> +! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_2]]) fastmath : (!fir.box>) -> () + deallocate(a) +end subroutine test_int + +subroutine test_char +! CHECK-LABEL: func.func @_QPtest_char() { + implicit none + character(len=9) :: c = 'Hey buddy' + call show_descriptor(c) +! CHECK: %[[C3:.*]] = arith.constant 3 : index +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[C9:.*]] = arith.constant 9 : index +! CHECK: %[[DUMMY_SCOPE_0:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[ADDRESS_OF_0:.*]] = fir.address_of(@_QFtest_charEc) : !fir.ref> +! CHECK: %[[DECLARE_0:.*]] = fir.declare %[[ADDRESS_OF_0]] typeparams %[[C9]] {uniq_name = "_QFtest_charEc"} : (!fir.ref>, index) -> !fir.ref> +! CHECK: %[[EMBOX_0:.*]] = fir.embox %[[DECLARE_0]] : (!fir.ref>) -> !fir.box> +! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_0]]) fastmath : (!fir.box>) -> () + + call show_descriptor(c(1:3)) +! CHECK: %[[C1_0:.*]] = arith.constant 1 : index +! CHECK: %[[SUBI_0:.*]] = arith.subi %[[C1]], %[[C1_0]] : index +! CHECK: %[[CONVERT_0:.*]] = fir.convert %[[DECLARE_0]] : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[COORDINATE_OF_0:.*]] = fir.coordinate_of %[[CONVERT_0]], %[[SUBI_0]] : (!fir.ref>>, index) -> !fir.ref> +! CHECK: %[[CONVERT_1:.*]] = fir.convert %[[COORDINATE_OF_0]] : (!fir.ref>) -> !fir.ref> +! CHECK: %[[EMBOX_1:.*]] = fir.embox %[[CONVERT_1]] : (!fir.ref>) -> !fir.box> +! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_1]]) fastmath : (!fir.box>) -> () +! CHECK: return +end subroutine test_char + +subroutine test_logical +! CHECK-LABEL: func.func @_QPtest_logical() { + implicit none + logical(kind=1) :: l1 = .false. + logical(kind=2) :: l2 = .true. + logical(kind=2), dimension(2), target :: la2 = (/ .true., .false. /) + logical(kind=2), dimension(:), pointer :: pla2 +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[C2:.*]] = arith.constant 2 : index +! CHECK: %[[DUMMY_SCOPE_0:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[ADDRESS_OF_0:.*]] = fir.address_of(@_QFtest_logicalEl1) : !fir.ref> +! CHECK: %[[DECLARE_0:.*]] = fir.declare %[[ADDRESS_OF_0]] {uniq_name = "_QFtest_logicalEl1"} : (!fir.ref>) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_1:.*]] = fir.address_of(@_QFtest_logicalEl2) : !fir.ref> +! CHECK: %[[DECLARE_1:.*]] = fir.declare %[[ADDRESS_OF_1]] {uniq_name = "_QFtest_logicalEl2"} : (!fir.ref>) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_2:.*]] = fir.address_of(@_QFtest_logicalEla2) : !fir.ref>> +! CHECK: %[[SHAPE_0:.*]] = fir.shape %[[C2]] : (index) -> !fir.shape<1> +! CHECK: %[[DECLARE_2:.*]] = fir.declare %[[ADDRESS_OF_2]](%[[SHAPE_0]]) {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_logicalEla2"} : (!fir.ref>>, !fir.shape<1>) -> !fir.ref>> +! CHECK: %[[ALLOCA_0:.*]] = fir.alloca !fir.box>>> {bindc_name = "pla2", uniq_name = "_QFtest_logicalEpla2"} +! CHECK: %[[ZERO_BITS_0:.*]] = fir.zero_bits !fir.ptr>> +! CHECK: %[[SHAPE_1:.*]] = fir.shape %[[C0]] : (index) -> !fir.shape<1> +! CHECK: %[[EMBOX_0:.*]] = fir.embox %[[ZERO_BITS_0]](%[[SHAPE_1]]) : (!fir.ptr>>, !fir.shape<1>) -> !fir.box>>> +! CHECK: fir.store %[[EMBOX_0]] to %[[ALLOCA_0]] : !fir.ref>>>> + + call show_descriptor(l1) + call show_descriptor(l2) + pla2 => la2 +! CHECK: %[[DECLARE_3:.*]] = fir.declare %[[ALLOCA_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_logicalEpla2"} : (!fir.ref>>>>) -> !fir.ref>>>> +! CHECK: %[[EMBOX_1:.*]] = fir.embox %[[DECLARE_0]] : (!fir.ref>) -> !fir.box> +! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_1]]) fastmath : (!fir.box>) -> () +! CHECK: %[[EMBOX_2:.*]] = fir.embox %[[DECLARE_1]] : (!fir.ref>) -> !fir.box> +! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_2]]) fastmath : (!fir.box>) -> () + + call show_descriptor(la2) + call show_descriptor(pla2) +! CHECK: %[[EMBOX_3:.*]] = fir.embox %[[DECLARE_2]](%[[SHAPE_0]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>>> +! CHECK: fir.store %[[EMBOX_3]] to %[[DECLARE_3]] : !fir.ref>>>> +! CHECK: %[[EMBOX_4:.*]] = fir.embox %[[DECLARE_2]](%[[SHAPE_0]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> +! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_4]]) fastmath : (!fir.box>>) -> () +! CHECK: %[[LOAD_0:.*]] = fir.load %[[DECLARE_3]] : !fir.ref>>>> +! CHECK: fir.call @_FortranAShowDescriptor(%[[LOAD_0]]) fastmath : (!fir.box>>>) -> () +! CHECK: return +end subroutine test_logical + +subroutine test_real +! CHECK-LABEL: func.func @_QPtest_real() { + implicit none + real :: half = 0.5 + real :: row(3) = (/ 1 , 2, 3 /) + real(kind=8) :: w(4) = (/ .00011_8 , .00012_8, .00013_8, .00014_8 /) +! CHECK: %[[C2:.*]] = arith.constant 2 : index +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[C4:.*]] = arith.constant 4 : index +! CHECK: %[[C3:.*]] = arith.constant 3 : index +! CHECK: %[[DUMMY_SCOPE_2:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[ADDRESS_OF_4:.*]] = fir.address_of(@_QFtest_realEhalf) : !fir.ref +! CHECK: %[[DECLARE_5:.*]] = fir.declare %[[ADDRESS_OF_4]] {uniq_name = "_QFtest_realEhalf"} : (!fir.ref) -> !fir.ref +! CHECK: %[[ADDRESS_OF_5:.*]] = fir.address_of(@_QFtest_realErow) : !fir.ref> +! CHECK: %[[SHAPE_2:.*]] = fir.shape %[[C3]] : (index) -> !fir.shape<1> +! CHECK: %[[DECLARE_6:.*]] = fir.declare %[[ADDRESS_OF_5]](%[[SHAPE_2]]) {uniq_name = "_QFtest_realErow"} : (!fir.ref>, !fir.shape<1>) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_6:.*]] = fir.address_of(@_QFtest_realEw) : !fir.ref> +! CHECK: %[[SHAPE_3:.*]] = fir.shape %[[C4]] : (index) -> !fir.shape<1> +! CHECK: %[[DECLARE_7:.*]] = fir.declare %[[ADDRESS_OF_6]](%[[SHAPE_3]]) {uniq_name = "_QFtest_realEw"} : (!fir.ref>, !fir.shape<1>) -> !fir.ref> + + call show_descriptor(half) + call show_descriptor(row) + call show_descriptor(w) + call show_descriptor(w(1:4:2)) +! CHECK: %[[EMBOX_7:.*]] = fir.embox %[[DECLARE_5]] : (!fir.ref) -> !fir.box +! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_7]]) fastmath : (!fir.box) -> () +! CHECK: %[[EMBOX_8:.*]] = fir.embox %[[DECLARE_6]](%[[SHAPE_2]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box> +! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_8]]) fastmath : (!fir.box>) -> () +! CHECK: %[[EMBOX_9:.*]] = fir.embox %[[DECLARE_7]](%[[SHAPE_3]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box> +! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_9]]) fastmath : (!fir.box>) -> () +! CHECK: %[[SHAPE_4:.*]] = fir.shape %[[C2]] : (index) -> !fir.shape<1> +! CHECK: %[[UNDEFINED_0:.*]] = fir.undefined index +! CHECK: %[[SLICE_0:.*]] = fir.slice %[[C1]], %[[C4]], %[[C2]] : (index, index, index) -> !fir.slice<1> +! CHECK: %[[EMBOX_10:.*]] = fir.embox %[[DECLARE_7]](%[[SHAPE_3]]) {{\[}}%[[SLICE_0]]] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>) -> !fir.box> +! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_10]]) fastmath : (!fir.box>) -> () +! CHECK: return +end subroutine test_real + +subroutine test_complex +! CHECK-LABEL: func.func @_QPtest_complex() { + implicit none + complex, parameter :: hr = 0.5 + complex, parameter :: hi = (0, 0.5) + complex :: c1 = hr + complex :: c2 = hi + complex :: a2(2) = (/ hr, hi /) +! CHECK: %[[CST_0:.*]] = arith.constant 0.000000e+00 : f32 +! CHECK: %[[CST_1:.*]] = arith.constant 5.000000e-01 : f32 +! CHECK: %[[C2:.*]] = arith.constant 2 : index +! CHECK: %[[ALLOCA_1:.*]] = fir.alloca complex +! CHECK: %[[ALLOCA_2:.*]] = fir.alloca complex +! CHECK: %[[DUMMY_SCOPE_3:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[ADDRESS_OF_7:.*]] = fir.address_of(@_QFtest_complexEa2) : !fir.ref>> +! CHECK: %[[SHAPE_5:.*]] = fir.shape %[[C2]] : (index) -> !fir.shape<1> +! CHECK: %[[DECLARE_8:.*]] = fir.declare %[[ADDRESS_OF_7]](%[[SHAPE_5]]) {uniq_name = "_QFtest_complexEa2"} : (!fir.ref>>, !fir.shape<1>) -> !fir.ref>> +! CHECK: %[[ADDRESS_OF_8:.*]] = fir.address_of(@_QFtest_complexEc1) : !fir.ref> +! CHECK: %[[DECLARE_9:.*]] = fir.declare %[[ADDRESS_OF_8]] {uniq_name = "_QFtest_complexEc1"} : (!fir.ref>) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_9:.*]] = fir.address_of(@_QFtest_complexEc2) : !fir.ref> +! CHECK: %[[DECLARE_10:.*]] = fir.declare %[[ADDRESS_OF_9]] {uniq_name = "_QFtest_complexEc2"} : (!fir.ref>) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_10:.*]] = fir.address_of(@_QFtest_complexEChi) : !fir.ref> +! CHECK: %[[DECLARE_11:.*]] = fir.declare %[[ADDRESS_OF_10]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_complexEChi"} : (!fir.ref>) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_11:.*]] = fir.address_of(@_QFtest_complexEChr) : !fir.ref> +! CHECK: %[[DECLARE_12:.*]] = fir.declare %[[ADDRESS_OF_11]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_complexEChr"} : (!fir.ref>) -> !fir.ref> +! CHECK: %[[UNDEFINED_1:.*]] = fir.undefined complex +! CHECK: %[[INSERT_VALUE_0:.*]] = fir.insert_value %[[UNDEFINED_1]], %[[CST_1]], [0 : index] : (complex, f32) -> complex +! CHECK: %[[INSERT_VALUE_1:.*]] = fir.insert_value %[[INSERT_VALUE_0]], %[[CST_0]], [1 : index] : (complex, f32) -> complex +! CHECK: fir.store %[[INSERT_VALUE_1]] to %[[ALLOCA_2]] : !fir.ref> + + call show_descriptor(hr) +! CHECK: %[[EMBOX_11:.*]] = fir.embox %[[ALLOCA_2]] : (!fir.ref>) -> !fir.box> +! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_11]]) fastmath : (!fir.box>) -> () + + call show_descriptor(hi) +! CHECK: %[[INSERT_VALUE_2:.*]] = fir.insert_value %[[UNDEFINED_1]], %[[CST_0]], [0 : index] : (complex, f32) -> complex +! CHECK: %[[INSERT_VALUE_3:.*]] = fir.insert_value %[[INSERT_VALUE_2]], %[[CST_1]], [1 : index] : (complex, f32) -> complex +! CHECK: fir.store %[[INSERT_VALUE_3]] to %[[ALLOCA_1]] : !fir.ref> +! CHECK: %[[EMBOX_12:.*]] = fir.embox %[[ALLOCA_1]] : (!fir.ref>) -> !fir.box> +! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_12]]) fastmath : (!fir.box>) -> () + + call show_descriptor(a2) +! CHECK: %[[EMBOX_13:.*]] = fir.embox %[[DECLARE_8]](%[[SHAPE_5]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> +! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_13]]) fastmath : (!fir.box>>) -> () +! CHECK: return +end subroutine test_complex + +subroutine test_derived +! CHECK-LABEL: func.func @_QPtest_derived() { + implicit none + type :: t1 + integer :: a + integer :: b + end type t1 + type, extends (t1) :: t2 + integer :: c + end type t2 + type(t2) :: vt2 = t2(7,5,3) +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[C2:.*]] = arith.constant 2 : index +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[DUMMY_SCOPE_4:.*]] = fir.dummy_scope : !fir.dscope +! CHECK: %[[ADDRESS_OF_12:.*]] = fir.address_of(@_QFtest_derivedE.n.a) : !fir.ref> +! CHECK: %[[DECLARE_13:.*]] = fir.declare %[[ADDRESS_OF_12]] typeparams %[[C1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_derivedE.n.a"} : (!fir.ref>, index) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_13:.*]] = fir.address_of(@_QFtest_derivedE.n.b) : !fir.ref> +! CHECK: %[[DECLARE_14:.*]] = fir.declare %[[ADDRESS_OF_13]] typeparams %[[C1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_derivedE.n.b"} : (!fir.ref>, index) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_14:.*]] = fir.address_of(@_QFtest_derivedE.n.t1) : !fir.ref> +! CHECK: %[[DECLARE_15:.*]] = fir.declare %[[ADDRESS_OF_14]] typeparams %[[C2]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_derivedE.n.t1"} : (!fir.ref>, index) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_15:.*]] = fir.address_of(@_QFtest_derivedE.n.c) : !fir.ref> +! CHECK: %[[DECLARE_16:.*]] = fir.declare %[[ADDRESS_OF_15]] typeparams %[[C1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_derivedE.n.c"} : (!fir.ref>, index) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_16:.*]] = fir.address_of(@_QFtest_derivedE.n.t2) : !fir.ref> +! CHECK: %[[DECLARE_17:.*]] = fir.declare %[[ADDRESS_OF_16]] typeparams %[[C2]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_derivedE.n.t2"} : (!fir.ref>, index) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_17:.*]] = fir.address_of(@_QFtest_derivedEvt2) : !fir.ref,c:i32}>> +! CHECK: %[[DECLARE_18:.*]] = fir.declare %[[ADDRESS_OF_17]] {uniq_name = "_QFtest_derivedEvt2"} : (!fir.ref,c:i32}>>) -> !fir.ref,c:i32}>> + + call show_descriptor(vt2) +! CHECK: %[[EMBOX_16:.*]] = fir.embox %[[DECLARE_18]] : (!fir.ref,c:i32}>>) -> !fir.box,c:i32}>> +! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_16]]) fastmath : (!fir.box,c:i32}>>) -> () +! CHECK: return +end subroutine test_derived From 3c485e9427311eb4b6494539e8d3de783c2eca6f Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Fri, 21 Nov 2025 17:06:14 -0800 Subject: [PATCH 02/10] fix formatting --- flang-rt/lib/runtime/descriptor.cpp | 108 +++++++++--------- .../Optimizer/Builder/Runtime/Intrinsics.h | 2 +- flang/include/flang/Runtime/extensions.h | 2 +- flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 6 +- .../Optimizer/Builder/Runtime/Intrinsics.cpp | 4 +- 5 files changed, 61 insertions(+), 61 deletions(-) diff --git a/flang-rt/lib/runtime/descriptor.cpp b/flang-rt/lib/runtime/descriptor.cpp index 5a35ea8e2a11b..066e94232c003 100644 --- a/flang-rt/lib/runtime/descriptor.cpp +++ b/flang-rt/lib/runtime/descriptor.cpp @@ -294,60 +294,62 @@ RT_API_ATTRS void Descriptor::Check() const { static const char *GetTypeStr(ISO::CFI_type_t type, bool dumpRawType) { if (dumpRawType) { -#define CASE(x) case (x): return #x; - switch (type) { - CASE(CFI_type_signed_char) - CASE(CFI_type_short) - CASE(CFI_type_int) - CASE(CFI_type_long) - CASE(CFI_type_long_long) - CASE(CFI_type_size_t) - CASE(CFI_type_int8_t) - CASE(CFI_type_int16_t) - CASE(CFI_type_int32_t) - CASE(CFI_type_int64_t) - CASE(CFI_type_int128_t) - CASE(CFI_type_int_least8_t) - CASE(CFI_type_int_least16_t) - CASE(CFI_type_int_least32_t) - CASE(CFI_type_int_least64_t) - CASE(CFI_type_int_least128_t) - CASE(CFI_type_int_fast8_t) - CASE(CFI_type_int_fast16_t) - CASE(CFI_type_int_fast32_t) - CASE(CFI_type_int_fast64_t) - CASE(CFI_type_int_fast128_t) - CASE(CFI_type_intmax_t) - CASE(CFI_type_intptr_t) - CASE(CFI_type_ptrdiff_t) - CASE(CFI_type_half_float) - CASE(CFI_type_bfloat) - CASE(CFI_type_float) - CASE(CFI_type_double) - CASE(CFI_type_extended_double) - CASE(CFI_type_long_double) - CASE(CFI_type_float128) - CASE(CFI_type_half_float_Complex) - CASE(CFI_type_bfloat_Complex) - CASE(CFI_type_float_Complex) - CASE(CFI_type_double_Complex) - CASE(CFI_type_extended_double_Complex) - CASE(CFI_type_long_double_Complex) - CASE(CFI_type_float128_Complex) - CASE(CFI_type_Bool) - CASE(CFI_type_char) - CASE(CFI_type_cptr) - CASE(CFI_type_struct) - CASE(CFI_type_char16_t) - CASE(CFI_type_char32_t) - CASE(CFI_type_uint8_t) - CASE(CFI_type_uint16_t) - CASE(CFI_type_uint32_t) - CASE(CFI_type_uint64_t) - CASE(CFI_type_uint128_t) - } +#define CASE(x) \ + case (x): \ + return #x; + switch (type) { + CASE(CFI_type_signed_char) + CASE(CFI_type_short) + CASE(CFI_type_int) + CASE(CFI_type_long) + CASE(CFI_type_long_long) + CASE(CFI_type_size_t) + CASE(CFI_type_int8_t) + CASE(CFI_type_int16_t) + CASE(CFI_type_int32_t) + CASE(CFI_type_int64_t) + CASE(CFI_type_int128_t) + CASE(CFI_type_int_least8_t) + CASE(CFI_type_int_least16_t) + CASE(CFI_type_int_least32_t) + CASE(CFI_type_int_least64_t) + CASE(CFI_type_int_least128_t) + CASE(CFI_type_int_fast8_t) + CASE(CFI_type_int_fast16_t) + CASE(CFI_type_int_fast32_t) + CASE(CFI_type_int_fast64_t) + CASE(CFI_type_int_fast128_t) + CASE(CFI_type_intmax_t) + CASE(CFI_type_intptr_t) + CASE(CFI_type_ptrdiff_t) + CASE(CFI_type_half_float) + CASE(CFI_type_bfloat) + CASE(CFI_type_float) + CASE(CFI_type_double) + CASE(CFI_type_extended_double) + CASE(CFI_type_long_double) + CASE(CFI_type_float128) + CASE(CFI_type_half_float_Complex) + CASE(CFI_type_bfloat_Complex) + CASE(CFI_type_float_Complex) + CASE(CFI_type_double_Complex) + CASE(CFI_type_extended_double_Complex) + CASE(CFI_type_long_double_Complex) + CASE(CFI_type_float128_Complex) + CASE(CFI_type_Bool) + CASE(CFI_type_char) + CASE(CFI_type_cptr) + CASE(CFI_type_struct) + CASE(CFI_type_char16_t) + CASE(CFI_type_char32_t) + CASE(CFI_type_uint8_t) + CASE(CFI_type_uint16_t) + CASE(CFI_type_uint32_t) + CASE(CFI_type_uint64_t) + CASE(CFI_type_uint128_t) + } #undef CASE - return nullptr; + return nullptr; } TypeCode code{type}; diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h index b4bedc36ca88e..ae02a4f460334 100644 --- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h @@ -111,7 +111,7 @@ mlir::Value genChdir(fir::FirOpBuilder &builder, mlir::Location loc, /// generate dump of a descriptor void genShowDescriptor(fir::FirOpBuilder &builder, mlir::Location loc, - mlir::Value descriptor); + mlir::Value descriptor); } // namespace runtime } // namespace fir diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h index 5788ea2aa7606..66a91e9756ba2 100644 --- a/flang/include/flang/Runtime/extensions.h +++ b/flang/include/flang/Runtime/extensions.h @@ -102,7 +102,7 @@ float FORTRAN_PROCEDURE_NAME(secnds)(float *refTime); float RTNAME(Secnds)(float *refTime, const char *sourceFile, int line); // Extension subroutine SHOW_DESCRIPTOR(D) -void RTNAME(ShowDescriptor)(const char* descr); +void RTNAME(ShowDescriptor)(const char *descr); } // extern "C" #endif // FORTRAN_RUNTIME_EXTENSIONS_H_ diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index 660877bbfd34b..88574d78d72ef 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -7818,15 +7818,13 @@ mlir::Value IntrinsicLibrary::genShiftA(mlir::Type resultType, return result; } -void -IntrinsicLibrary::genShowDescriptor( - llvm::ArrayRef args) { +void IntrinsicLibrary::genShowDescriptor( + llvm::ArrayRef args) { assert(args.size() == 1); const mlir::Value descriptor = fir::getBase(args[0]); assert(fir::isa_box_type(descriptor.getType()) && "argument must have been lowered to box type"); - // mlir::Value descrAddr = fir::BoxAddrOp::create(builder, loc, descriptor); fir::runtime::genShowDescriptor(builder, loc, descriptor); } diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp index 0317bc35c978f..737ee171843d7 100644 --- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp @@ -462,8 +462,8 @@ mlir::Value fir::runtime::genChdir(fir::FirOpBuilder &builder, return fir::CallOp::create(builder, loc, func, args).getResult(0); } -void fir::runtime::genShowDescriptor(fir::FirOpBuilder &builder, mlir::Location loc, - mlir::Value descAddr) { +void fir::runtime::genShowDescriptor(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Value descAddr) { mlir::func::FuncOp func{ fir::runtime::getRuntimeFunc(loc, builder)}; fir::CallOp::create(builder, loc, func, descAddr); From 49f10928c253ed01d46c71cf7d944b511aaf2c36 Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Fri, 21 Nov 2025 18:05:47 -0800 Subject: [PATCH 03/10] adjust test checks --- flang/test/Lower/Intrinsics/show_descriptor.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/flang/test/Lower/Intrinsics/show_descriptor.f90 b/flang/test/Lower/Intrinsics/show_descriptor.f90 index 2eb648526582a..39c45d6f51d8a 100644 --- a/flang/test/Lower/Intrinsics/show_descriptor.f90 +++ b/flang/test/Lower/Intrinsics/show_descriptor.f90 @@ -107,7 +107,8 @@ subroutine test_logical call show_descriptor(la2) call show_descriptor(pla2) -! CHECK: %[[EMBOX_3:.*]] = fir.embox %[[DECLARE_2]](%[[SHAPE_0]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>>> +! CHECK: %[[CONVERT_0:.*]] = fir.convert %[[DECLARE_2]] : (!fir.ref>>) -> !fir.ref>> +! CHECK: %[[EMBOX_3:.*]] = fir.embox %[[CONVERT_0]](%[[SHAPE_0]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>>> ! CHECK: fir.store %[[EMBOX_3]] to %[[DECLARE_3]] : !fir.ref>>>> ! CHECK: %[[EMBOX_4:.*]] = fir.embox %[[DECLARE_2]](%[[SHAPE_0]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> ! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_4]]) fastmath : (!fir.box>>) -> () From 885e8d8c565caf377e8840e3a9c6371933866298 Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Mon, 24 Nov 2025 11:24:12 -0800 Subject: [PATCH 04/10] address review comments --- flang-rt/include/flang-rt/runtime/descriptor.h | 2 +- flang-rt/lib/runtime/extensions.cpp | 5 ++--- flang/include/flang/Runtime/extensions.h | 7 ++++++- flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 2 +- 4 files changed, 10 insertions(+), 6 deletions(-) diff --git a/flang-rt/include/flang-rt/runtime/descriptor.h b/flang-rt/include/flang-rt/runtime/descriptor.h index 9ee5c1ac71db0..40e30e3bf783f 100644 --- a/flang-rt/include/flang-rt/runtime/descriptor.h +++ b/flang-rt/include/flang-rt/runtime/descriptor.h @@ -511,7 +511,7 @@ class Descriptor { RT_API_ATTRS void Check() const; // When dumpRawType, dumps stringified CFI_type_*, otherwise - // try to canonicalize and pront as a Fortran type. + // try to canonicalize and print as a Fortran type. void Dump(FILE * = stdout, bool dumpRawType = true) const; RT_API_ATTRS inline bool HasAddendum() const { diff --git a/flang-rt/lib/runtime/extensions.cpp b/flang-rt/lib/runtime/extensions.cpp index 29bccc50aa7e9..6b4002ecfa586 100644 --- a/flang-rt/lib/runtime/extensions.cpp +++ b/flang-rt/lib/runtime/extensions.cpp @@ -398,10 +398,9 @@ std::int64_t RTNAME(time)() { return time(nullptr); } // MCLOCK: returns accumulated CPU time in ticks std::int32_t FORTRAN_PROCEDURE_NAME(mclock)() { return std::clock(); } -void RTNAME(ShowDescriptor)(const char *descr) { +void RTNAME(ShowDescriptor)(const Fortran::runtime::Descriptor *descr) { if (descr) { - reinterpret_cast(descr)->Dump( - stderr, /*dumpRawType=*/false); + descr->Dump(stderr, /*dumpRawType=*/false); } else { std::fprintf(stderr, "NULL\n"); } diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h index 66a91e9756ba2..07d0224d2977c 100644 --- a/flang/include/flang/Runtime/extensions.h +++ b/flang/include/flang/Runtime/extensions.h @@ -25,6 +25,11 @@ typedef std::uint32_t gid_t; #else #include "sys/types.h" //pid_t #endif +namespace Fortran { +namespace runtime { +class Descriptor; +} +} // namespace Fortran extern "C" { @@ -102,7 +107,7 @@ float FORTRAN_PROCEDURE_NAME(secnds)(float *refTime); float RTNAME(Secnds)(float *refTime, const char *sourceFile, int line); // Extension subroutine SHOW_DESCRIPTOR(D) -void RTNAME(ShowDescriptor)(const char *descr); +void RTNAME(ShowDescriptor)(const Fortran::runtime::Descriptor* descr); } // extern "C" #endif // FORTRAN_RUNTIME_EXTENSIONS_H_ diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index 88574d78d72ef..7d5b06f9c7042 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -7820,7 +7820,7 @@ mlir::Value IntrinsicLibrary::genShiftA(mlir::Type resultType, void IntrinsicLibrary::genShowDescriptor( llvm::ArrayRef args) { - assert(args.size() == 1); + assert(args.size() == 1 && "expected single argument for show_descriptor"); const mlir::Value descriptor = fir::getBase(args[0]); assert(fir::isa_box_type(descriptor.getType()) && From f7c1135767a4cf082fe7f08cf56fd6c007a4b799 Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Mon, 24 Nov 2025 12:29:00 -0800 Subject: [PATCH 05/10] format --- flang/include/flang/Runtime/extensions.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h index 07d0224d2977c..a8ade13e8d4ef 100644 --- a/flang/include/flang/Runtime/extensions.h +++ b/flang/include/flang/Runtime/extensions.h @@ -107,7 +107,7 @@ float FORTRAN_PROCEDURE_NAME(secnds)(float *refTime); float RTNAME(Secnds)(float *refTime, const char *sourceFile, int line); // Extension subroutine SHOW_DESCRIPTOR(D) -void RTNAME(ShowDescriptor)(const Fortran::runtime::Descriptor* descr); +void RTNAME(ShowDescriptor)(const Fortran::runtime::Descriptor *descr); } // extern "C" #endif // FORTRAN_RUNTIME_EXTENSIONS_H_ From b58c119e7ad8300568b32c9bc4eb7b222e8e967e Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Tue, 25 Nov 2025 09:21:51 -0800 Subject: [PATCH 06/10] extend flang-rt/unittests with descriptor's dump --- flang-rt/unittests/Runtime/Descriptor.cpp | 113 ++++++++++++++++++++++ 1 file changed, 113 insertions(+) diff --git a/flang-rt/unittests/Runtime/Descriptor.cpp b/flang-rt/unittests/Runtime/Descriptor.cpp index 4a7bb43a492af..4a8e99119aada 100644 --- a/flang-rt/unittests/Runtime/Descriptor.cpp +++ b/flang-rt/unittests/Runtime/Descriptor.cpp @@ -9,6 +9,7 @@ #include "flang-rt/runtime/descriptor.h" #include "tools.h" #include "gtest/gtest.h" +#include using namespace Fortran::runtime; @@ -158,3 +159,115 @@ TEST(Descriptor, FixedStride) { EXPECT_TRUE(descriptor.IsContiguous()); EXPECT_EQ(descriptor.FixedStride().value_or(-666), 0); } + +static std::string getAddrFilteredContent(FILE *fin) { + rewind(fin); + std::ostringstream content; + char buffer[1024]; + size_t bytes_read; + while ((bytes_read = fread(buffer, 1, sizeof(buffer), fin)) > 0) { + content.write(buffer, bytes_read); + } + return std::regex_replace( + content.str(), std::regex("(0x[0-9a-fA-F]*)"), "[address]"); +} + +TEST(Descriptor, Dump) { + StaticDescriptor<4> staticDesc[2]; + Descriptor &descriptor{staticDesc[0].descriptor()}; + using Type = std::int32_t; + Type data[8][8][8]; + constexpr int four{static_cast(sizeof data[0][0][0])}; + TypeCode integer{TypeCategory::Integer, four}; + // Scalar + descriptor.Establish(integer, four, data, 0); + FILE* tmpf = tmpfile(); + ASSERT_TRUE(tmpf) << "tmpfile returned NULL"; + auto resetTmpFile = [tmpf]() { + rewind(tmpf); + ftruncate(fileno(tmpf), 0); + }; + + descriptor.Dump(tmpf, /*dumpRawType=*/false); + // also dump as CFI type + descriptor.Dump(tmpf, /*dumpRawType=*/true); + std::string output = getAddrFilteredContent(tmpf); + ASSERT_STREQ(output.c_str(), + "Descriptor @ [address]:\n" + " base_addr [address]\n" + " elem_len 4\n" + " version 20240719\n" + " scalar\n" + " type 9 \"INTEGER(kind=4)\"\n" + " attribute 0\n" + " extra 0\n" + " addendum 0\n" + " alloc_idx 0\n" + "Descriptor @ [address]:\n" + " base_addr [address]\n" + " elem_len 4\n" + " version 20240719\n" + " scalar\n" + " type 9 \"CFI_type_int32_t\"\n" + " attribute 0\n" + " extra 0\n" + " addendum 0\n" + " alloc_idx 0\n"); + + // Contiguous matrix (0:7, 0:7) + SubscriptValue extent[3]{8, 8, 8}; + descriptor.Establish(integer, four, data, 2, extent); + resetTmpFile(); + descriptor.Dump(tmpf, /*dumpRawType=*/false); + output = getAddrFilteredContent(tmpf); + ASSERT_STREQ(output.c_str(), + "Descriptor @ [address]:\n" + " base_addr [address]\n" + " elem_len 4\n" + " version 20240719\n" + " rank 2\n" + " type 9 \"INTEGER(kind=4)\"\n" + " attribute 0\n" + " extra 0\n" + " addendum 0\n" + " alloc_idx 0\n" + " dim[0] lower_bound 0\n" + " extent 8\n" + " sm 4\n" + " dim[1] lower_bound 0\n" + " extent 8\n" + " sm 32\n"); + + TypeCode real{TypeCategory::Real, four}; + // Discontiguous real 3-D array (0:7, 0:6:2, 0:6:2) + descriptor.Establish(real, four, data, 3, extent); + descriptor.GetDimension(1).SetExtent(4); + descriptor.GetDimension(1).SetByteStride(8 * 2 * four); + descriptor.GetDimension(2).SetExtent(4); + descriptor.GetDimension(2).SetByteStride(8 * 8 * 2 * four); + + resetTmpFile(); + descriptor.Dump(tmpf, /*dumpRawType=*/false); + output = getAddrFilteredContent(tmpf); + ASSERT_STREQ(output.c_str(), + "Descriptor @ [address]:\n" + " base_addr [address]\n" + " elem_len 4\n" + " version 20240719\n" + " rank 3\n" + " type 27 \"REAL(kind=4)\"\n" + " attribute 0\n" + " extra 0\n" + " addendum 0\n" + " alloc_idx 0\n" + " dim[0] lower_bound 0\n" + " extent 8\n" + " sm 4\n" + " dim[1] lower_bound 0\n" + " extent 4\n" + " sm 64\n" + " dim[2] lower_bound 0\n" + " extent 4\n" + " sm 512\n"); + fclose(tmpf); +} From 685e3a18d9468afbeb3b48a8b56d410b9f33c72a Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Tue, 25 Nov 2025 11:32:25 -0800 Subject: [PATCH 07/10] Rename show_descriptor into __builtin_show_descriptor. Add flang_debug module to allows using show_descriptor name by a user. --- flang/lib/Evaluate/intrinsics.cpp | 2 +- flang/module/__fortran_builtins.f90 | 3 ++ flang/module/flang_debug.f90 | 14 ++++++++ .../test/Lower/Intrinsics/show_descriptor.f90 | 32 +++++++++---------- flang/tools/f18/CMakeLists.txt | 1 + 5 files changed, 35 insertions(+), 17 deletions(-) create mode 100644 flang/module/flang_debug.f90 diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index 45432ca01fec9..5fd13ea64fc72 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -1701,7 +1701,7 @@ static const IntrinsicInterface intrinsicSubroutine[]{ {}, Rank::scalar, IntrinsicClass::impureSubroutine}, {"second", {{"time", DefaultReal, Rank::scalar}}, {}, Rank::scalar, IntrinsicClass::impureSubroutine}, - {"show_descriptor", {{"d", AnyData, Rank::anyOrAssumedRank}}, {}, + {"__builtin_show_descriptor", {{"d", AnyData, Rank::anyOrAssumedRank}}, {}, Rank::elemental, IntrinsicClass::impureSubroutine}, {"system", {{"command", DefaultChar, Rank::scalar}, diff --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90 index 4d134fa4b62b1..a9b60508785db 100644 --- a/flang/module/__fortran_builtins.f90 +++ b/flang/module/__fortran_builtins.f90 @@ -28,6 +28,9 @@ intrinsic :: __builtin_c_f_pointer public :: __builtin_c_f_pointer + intrinsic :: __builtin_show_descriptor + public :: __builtin_show_descriptor + intrinsic :: sizeof ! extension public :: sizeof diff --git a/flang/module/flang_debug.f90 b/flang/module/flang_debug.f90 new file mode 100644 index 0000000000000..baab3b2477f49 --- /dev/null +++ b/flang/module/flang_debug.f90 @@ -0,0 +1,14 @@ +!===-- module/flang_debug.f90 ----------------------------------------------===! +! +! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +! See https://llvm.org/LICENSE.txt for license information. +! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +! +!===------------------------------------------------------------------------===! + +module flang_debug + + use __fortran_builtins, only: & + show_descriptor => __builtin_show_descriptor + +end module flang_debug diff --git a/flang/test/Lower/Intrinsics/show_descriptor.f90 b/flang/test/Lower/Intrinsics/show_descriptor.f90 index 39c45d6f51d8a..640f499dd0a70 100644 --- a/flang/test/Lower/Intrinsics/show_descriptor.f90 +++ b/flang/test/Lower/Intrinsics/show_descriptor.f90 @@ -27,14 +27,14 @@ subroutine test_int ! CHECK: %[[SELECT_0:.*]] = arith.select %[[CMPI_0]], %[[CONVERT_0]], %[[C0]] : index ! CHECK: %[[ALLOCMEM_0:.*]] = fir.allocmem !fir.array, %[[SELECT_0]] {fir.must_be_heap = true, uniq_name = "_QFtest_intEa.alloc"} - call show_descriptor(a) + call __builtin_show_descriptor(a) ! CHECK: %[[SHAPE_1:.*]] = fir.shape %[[SELECT_0]] : (index) -> !fir.shape<1> ! CHECK: %[[EMBOX_1:.*]] = fir.embox %[[ALLOCMEM_0]](%[[SHAPE_1]]) : (!fir.heap>, !fir.shape<1>) -> !fir.box>> ! CHECK: fir.store %[[EMBOX_1]] to %[[DECLARE_0]] : !fir.ref>>> ! CHECK: %[[LOAD_1:.*]] = fir.load %[[DECLARE_0]] : !fir.ref>>> ! CHECK: fir.call @_FortranAShowDescriptor(%[[LOAD_1]]) fastmath : (!fir.box>>) -> () - call show_descriptor(a(1:3)) + call __builtin_show_descriptor(a(1:3)) ! CHECK: %[[LOAD_2:.*]] = fir.load %[[DECLARE_0]] : !fir.ref>>> ! CHECK: %[[SHAPE_2:.*]] = fir.shape %[[C3]] : (index) -> !fir.shape<1> ! CHECK: %[[BOX_ADDR_0:.*]] = fir.box_addr %[[LOAD_2]] : (!fir.box>>) -> !fir.heap> @@ -52,7 +52,7 @@ subroutine test_char ! CHECK-LABEL: func.func @_QPtest_char() { implicit none character(len=9) :: c = 'Hey buddy' - call show_descriptor(c) + call __builtin_show_descriptor(c) ! CHECK: %[[C3:.*]] = arith.constant 3 : index ! CHECK: %[[C1:.*]] = arith.constant 1 : index ! CHECK: %[[C9:.*]] = arith.constant 9 : index @@ -62,7 +62,7 @@ subroutine test_char ! CHECK: %[[EMBOX_0:.*]] = fir.embox %[[DECLARE_0]] : (!fir.ref>) -> !fir.box> ! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_0]]) fastmath : (!fir.box>) -> () - call show_descriptor(c(1:3)) + call __builtin_show_descriptor(c(1:3)) ! CHECK: %[[C1_0:.*]] = arith.constant 1 : index ! CHECK: %[[SUBI_0:.*]] = arith.subi %[[C1]], %[[C1_0]] : index ! CHECK: %[[CONVERT_0:.*]] = fir.convert %[[DECLARE_0]] : (!fir.ref>) -> !fir.ref>> @@ -96,8 +96,8 @@ subroutine test_logical ! CHECK: %[[EMBOX_0:.*]] = fir.embox %[[ZERO_BITS_0]](%[[SHAPE_1]]) : (!fir.ptr>>, !fir.shape<1>) -> !fir.box>>> ! CHECK: fir.store %[[EMBOX_0]] to %[[ALLOCA_0]] : !fir.ref>>>> - call show_descriptor(l1) - call show_descriptor(l2) + call __builtin_show_descriptor(l1) + call __builtin_show_descriptor(l2) pla2 => la2 ! CHECK: %[[DECLARE_3:.*]] = fir.declare %[[ALLOCA_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_logicalEpla2"} : (!fir.ref>>>>) -> !fir.ref>>>> ! CHECK: %[[EMBOX_1:.*]] = fir.embox %[[DECLARE_0]] : (!fir.ref>) -> !fir.box> @@ -105,8 +105,8 @@ subroutine test_logical ! CHECK: %[[EMBOX_2:.*]] = fir.embox %[[DECLARE_1]] : (!fir.ref>) -> !fir.box> ! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_2]]) fastmath : (!fir.box>) -> () - call show_descriptor(la2) - call show_descriptor(pla2) + call __builtin_show_descriptor(la2) + call __builtin_show_descriptor(pla2) ! CHECK: %[[CONVERT_0:.*]] = fir.convert %[[DECLARE_2]] : (!fir.ref>>) -> !fir.ref>> ! CHECK: %[[EMBOX_3:.*]] = fir.embox %[[CONVERT_0]](%[[SHAPE_0]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>>> ! CHECK: fir.store %[[EMBOX_3]] to %[[DECLARE_3]] : !fir.ref>>>> @@ -137,10 +137,10 @@ subroutine test_real ! CHECK: %[[SHAPE_3:.*]] = fir.shape %[[C4]] : (index) -> !fir.shape<1> ! CHECK: %[[DECLARE_7:.*]] = fir.declare %[[ADDRESS_OF_6]](%[[SHAPE_3]]) {uniq_name = "_QFtest_realEw"} : (!fir.ref>, !fir.shape<1>) -> !fir.ref> - call show_descriptor(half) - call show_descriptor(row) - call show_descriptor(w) - call show_descriptor(w(1:4:2)) + call __builtin_show_descriptor(half) + call __builtin_show_descriptor(row) + call __builtin_show_descriptor(w) + call __builtin_show_descriptor(w(1:4:2)) ! CHECK: %[[EMBOX_7:.*]] = fir.embox %[[DECLARE_5]] : (!fir.ref) -> !fir.box ! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_7]]) fastmath : (!fir.box) -> () ! CHECK: %[[EMBOX_8:.*]] = fir.embox %[[DECLARE_6]](%[[SHAPE_2]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box> @@ -185,18 +185,18 @@ subroutine test_complex ! CHECK: %[[INSERT_VALUE_1:.*]] = fir.insert_value %[[INSERT_VALUE_0]], %[[CST_0]], [1 : index] : (complex, f32) -> complex ! CHECK: fir.store %[[INSERT_VALUE_1]] to %[[ALLOCA_2]] : !fir.ref> - call show_descriptor(hr) + call __builtin_show_descriptor(hr) ! CHECK: %[[EMBOX_11:.*]] = fir.embox %[[ALLOCA_2]] : (!fir.ref>) -> !fir.box> ! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_11]]) fastmath : (!fir.box>) -> () - call show_descriptor(hi) + call __builtin_show_descriptor(hi) ! CHECK: %[[INSERT_VALUE_2:.*]] = fir.insert_value %[[UNDEFINED_1]], %[[CST_0]], [0 : index] : (complex, f32) -> complex ! CHECK: %[[INSERT_VALUE_3:.*]] = fir.insert_value %[[INSERT_VALUE_2]], %[[CST_1]], [1 : index] : (complex, f32) -> complex ! CHECK: fir.store %[[INSERT_VALUE_3]] to %[[ALLOCA_1]] : !fir.ref> ! CHECK: %[[EMBOX_12:.*]] = fir.embox %[[ALLOCA_1]] : (!fir.ref>) -> !fir.box> ! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_12]]) fastmath : (!fir.box>) -> () - call show_descriptor(a2) + call __builtin_show_descriptor(a2) ! CHECK: %[[EMBOX_13:.*]] = fir.embox %[[DECLARE_8]](%[[SHAPE_5]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> ! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_13]]) fastmath : (!fir.box>>) -> () ! CHECK: return @@ -230,7 +230,7 @@ subroutine test_derived ! CHECK: %[[ADDRESS_OF_17:.*]] = fir.address_of(@_QFtest_derivedEvt2) : !fir.ref,c:i32}>> ! CHECK: %[[DECLARE_18:.*]] = fir.declare %[[ADDRESS_OF_17]] {uniq_name = "_QFtest_derivedEvt2"} : (!fir.ref,c:i32}>>) -> !fir.ref,c:i32}>> - call show_descriptor(vt2) + call __builtin_show_descriptor(vt2) ! CHECK: %[[EMBOX_16:.*]] = fir.embox %[[DECLARE_18]] : (!fir.ref,c:i32}>>) -> !fir.box,c:i32}>> ! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_16]]) fastmath : (!fir.box,c:i32}>>) -> () ! CHECK: return diff --git a/flang/tools/f18/CMakeLists.txt b/flang/tools/f18/CMakeLists.txt index 715992c756c4b..58ea782ce213e 100644 --- a/flang/tools/f18/CMakeLists.txt +++ b/flang/tools/f18/CMakeLists.txt @@ -23,6 +23,7 @@ set(MODULES "iso_c_binding" "iso_fortran_env" "iso_fortran_env_impl" + "flang_debug" ) # Check if 128-bit float computations can be done via long double. From f4a754b6f048a7ba10d99af1c67bec86b56d39f9 Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Tue, 25 Nov 2025 13:52:37 -0800 Subject: [PATCH 08/10] document show_descriptor intrinsic --- flang/docs/Intrinsics.md | 42 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md index bfda5f3253a68..09c041092ad9c 100644 --- a/flang/docs/Intrinsics.md +++ b/flang/docs/Intrinsics.md @@ -1379,3 +1379,45 @@ This is prefixed by `STRING`, a colon and a space. - **Standard:** GNU extension - **Class:** subroutine - **Syntax:** `CALL PERROR(STRING)` + +### Non-Standard Intrinsics: SHOW_DESCRIPTOR + +#### Description +`SHOW_DESCRIPTOR(VAR)` prints (on the C stderr stream) a contents of a descriptor for the variable VAR, +which can be of any type and rank, including scalars. +Requires use of flang_debug module. + +Here is an example of its output: +``` +Descriptor @ 0x7ffe506fc368: + base_addr 0x55944caef0f0 + elem_len 4 + version 20240719 + rank 1 + type 9 "INTEGER(kind=4)" + attribute 2 (allocatable) + extra 0 + addendum 0 + alloc_idx 0 + dim[0] lower_bound 1 + extent 5 + sm 4 +``` + +#### Usage and Info +- **Standard:** flang extension +- **Class:** subroutine +- **Syntax:** `CALL show_descriptor(VAR)` + +#### Example +```Fortran +subroutine test + use flang_debug + implicit none + character(len=9) :: c = 'Hey buddy' + integer :: a(5) + call show_descriptor(c) + call show_descriptor(c(1:3)) + call show_descriptor(a) +end subroutine test +``` From 7a71455abe270c674c91e3a94ca16141222ff5db Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Tue, 25 Nov 2025 13:59:40 -0800 Subject: [PATCH 09/10] format --- flang-rt/unittests/Runtime/Descriptor.cpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/flang-rt/unittests/Runtime/Descriptor.cpp b/flang-rt/unittests/Runtime/Descriptor.cpp index 4a8e99119aada..f86ff4cf16a55 100644 --- a/flang-rt/unittests/Runtime/Descriptor.cpp +++ b/flang-rt/unittests/Runtime/Descriptor.cpp @@ -166,7 +166,7 @@ static std::string getAddrFilteredContent(FILE *fin) { char buffer[1024]; size_t bytes_read; while ((bytes_read = fread(buffer, 1, sizeof(buffer), fin)) > 0) { - content.write(buffer, bytes_read); + content.write(buffer, bytes_read); } return std::regex_replace( content.str(), std::regex("(0x[0-9a-fA-F]*)"), "[address]"); @@ -181,7 +181,7 @@ TEST(Descriptor, Dump) { TypeCode integer{TypeCategory::Integer, four}; // Scalar descriptor.Establish(integer, four, data, 0); - FILE* tmpf = tmpfile(); + FILE *tmpf = tmpfile(); ASSERT_TRUE(tmpf) << "tmpfile returned NULL"; auto resetTmpFile = [tmpf]() { rewind(tmpf); From b3e063e3e79a28890c86890e73f4b266a3891a2e Mon Sep 17 00:00:00 2001 From: Valery Dmitriev Date: Wed, 26 Nov 2025 09:04:46 -0800 Subject: [PATCH 10/10] update test to invoke show_descriptor via flang_debug module --- .../test/Lower/Intrinsics/show_descriptor.f90 | 140 +++++++++--------- 1 file changed, 72 insertions(+), 68 deletions(-) diff --git a/flang/test/Lower/Intrinsics/show_descriptor.f90 b/flang/test/Lower/Intrinsics/show_descriptor.f90 index 640f499dd0a70..a0b8d3eb4348f 100644 --- a/flang/test/Lower/Intrinsics/show_descriptor.f90 +++ b/flang/test/Lower/Intrinsics/show_descriptor.f90 @@ -1,7 +1,10 @@ ! RUN: bbc -emit-fir %s -o - | FileCheck %s +module test_show_descriptor +use flang_debug +contains subroutine test_int -! CHECK-LABEL: func.func @_QPtest_int() { +! CHECK-LABEL: func.func @_QMtest_show_descriptorPtest_int() { implicit none integer :: n integer,allocatable :: a(:) @@ -12,29 +15,29 @@ subroutine test_int ! CHECK: %[[C5:.*]] = arith.constant 5 : i32 ! CHECK: %[[C0:.*]] = arith.constant 0 : index ! CHECK: %[[DUMMY_SCOPE_0:.*]] = fir.dummy_scope : !fir.dscope -! CHECK: %[[ALLOCA_0:.*]] = fir.alloca !fir.box>> {bindc_name = "a", uniq_name = "_QFtest_intEa"} +! CHECK: %[[ALLOCA_0:.*]] = fir.alloca !fir.box>> {bindc_name = "a", uniq_name = "_QMtest_show_descriptorFtest_intEa"} ! CHECK: %[[ZERO_BITS_0:.*]] = fir.zero_bits !fir.heap> ! CHECK: %[[SHAPE_0:.*]] = fir.shape %[[C0]] : (index) -> !fir.shape<1> ! CHECK: %[[EMBOX_0:.*]] = fir.embox %[[ZERO_BITS_0]](%[[SHAPE_0]]) : (!fir.heap>, !fir.shape<1>) -> !fir.box>> ! CHECK: fir.store %[[EMBOX_0]] to %[[ALLOCA_0]] : !fir.ref>>> -! CHECK: %[[DECLARE_0:.*]] = fir.declare %[[ALLOCA_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_intEa"} : (!fir.ref>>>) -> !fir.ref>>> -! CHECK: %[[ALLOCA_1:.*]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFtest_intEn"} -! CHECK: %[[DECLARE_1:.*]] = fir.declare %[[ALLOCA_1]] {uniq_name = "_QFtest_intEn"} : (!fir.ref) -> !fir.ref +! CHECK: %[[DECLARE_0:.*]] = fir.declare %[[ALLOCA_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QMtest_show_descriptorFtest_intEa"} : (!fir.ref>>>) -> !fir.ref>>> +! CHECK: %[[ALLOCA_1:.*]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QMtest_show_descriptorFtest_intEn"} +! CHECK: %[[DECLARE_1:.*]] = fir.declare %[[ALLOCA_1]] {uniq_name = "_QMtest_show_descriptorFtest_intEn"} : (!fir.ref) -> !fir.ref ! CHECK: fir.store %[[C5]] to %[[DECLARE_1]] : !fir.ref ! CHECK: %[[LOAD_0:.*]] = fir.load %[[DECLARE_1]] : !fir.ref ! CHECK: %[[CONVERT_0:.*]] = fir.convert %[[LOAD_0]] : (i32) -> index ! CHECK: %[[CMPI_0:.*]] = arith.cmpi sgt, %[[CONVERT_0]], %[[C0]] : index ! CHECK: %[[SELECT_0:.*]] = arith.select %[[CMPI_0]], %[[CONVERT_0]], %[[C0]] : index -! CHECK: %[[ALLOCMEM_0:.*]] = fir.allocmem !fir.array, %[[SELECT_0]] {fir.must_be_heap = true, uniq_name = "_QFtest_intEa.alloc"} +! CHECK: %[[ALLOCMEM_0:.*]] = fir.allocmem !fir.array, %[[SELECT_0]] {fir.must_be_heap = true, uniq_name = "_QMtest_show_descriptorFtest_intEa.alloc"} - call __builtin_show_descriptor(a) + call show_descriptor(a) ! CHECK: %[[SHAPE_1:.*]] = fir.shape %[[SELECT_0]] : (index) -> !fir.shape<1> ! CHECK: %[[EMBOX_1:.*]] = fir.embox %[[ALLOCMEM_0]](%[[SHAPE_1]]) : (!fir.heap>, !fir.shape<1>) -> !fir.box>> ! CHECK: fir.store %[[EMBOX_1]] to %[[DECLARE_0]] : !fir.ref>>> ! CHECK: %[[LOAD_1:.*]] = fir.load %[[DECLARE_0]] : !fir.ref>>> ! CHECK: fir.call @_FortranAShowDescriptor(%[[LOAD_1]]) fastmath : (!fir.box>>) -> () - call __builtin_show_descriptor(a(1:3)) + call show_descriptor(a(1:3)) ! CHECK: %[[LOAD_2:.*]] = fir.load %[[DECLARE_0]] : !fir.ref>>> ! CHECK: %[[SHAPE_2:.*]] = fir.shape %[[C3]] : (index) -> !fir.shape<1> ! CHECK: %[[BOX_ADDR_0:.*]] = fir.box_addr %[[LOAD_2]] : (!fir.box>>) -> !fir.heap> @@ -49,20 +52,20 @@ subroutine test_int end subroutine test_int subroutine test_char -! CHECK-LABEL: func.func @_QPtest_char() { +! CHECK-LABEL: func.func @_QMtest_show_descriptorPtest_char() { implicit none character(len=9) :: c = 'Hey buddy' - call __builtin_show_descriptor(c) + call show_descriptor(c) ! CHECK: %[[C3:.*]] = arith.constant 3 : index ! CHECK: %[[C1:.*]] = arith.constant 1 : index ! CHECK: %[[C9:.*]] = arith.constant 9 : index ! CHECK: %[[DUMMY_SCOPE_0:.*]] = fir.dummy_scope : !fir.dscope -! CHECK: %[[ADDRESS_OF_0:.*]] = fir.address_of(@_QFtest_charEc) : !fir.ref> -! CHECK: %[[DECLARE_0:.*]] = fir.declare %[[ADDRESS_OF_0]] typeparams %[[C9]] {uniq_name = "_QFtest_charEc"} : (!fir.ref>, index) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_0:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_charEc) : !fir.ref> +! CHECK: %[[DECLARE_0:.*]] = fir.declare %[[ADDRESS_OF_0]] typeparams %[[C9]] {uniq_name = "_QMtest_show_descriptorFtest_charEc"} : (!fir.ref>, index) -> !fir.ref> ! CHECK: %[[EMBOX_0:.*]] = fir.embox %[[DECLARE_0]] : (!fir.ref>) -> !fir.box> ! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_0]]) fastmath : (!fir.box>) -> () - call __builtin_show_descriptor(c(1:3)) + call show_descriptor(c(1:3)) ! CHECK: %[[C1_0:.*]] = arith.constant 1 : index ! CHECK: %[[SUBI_0:.*]] = arith.subi %[[C1]], %[[C1_0]] : index ! CHECK: %[[CONVERT_0:.*]] = fir.convert %[[DECLARE_0]] : (!fir.ref>) -> !fir.ref>> @@ -74,7 +77,7 @@ subroutine test_char end subroutine test_char subroutine test_logical -! CHECK-LABEL: func.func @_QPtest_logical() { +! CHECK-LABEL: func.func @_QMtest_show_descriptorPtest_logical() { implicit none logical(kind=1) :: l1 = .false. logical(kind=2) :: l2 = .true. @@ -83,30 +86,30 @@ subroutine test_logical ! CHECK: %[[C0:.*]] = arith.constant 0 : index ! CHECK: %[[C2:.*]] = arith.constant 2 : index ! CHECK: %[[DUMMY_SCOPE_0:.*]] = fir.dummy_scope : !fir.dscope -! CHECK: %[[ADDRESS_OF_0:.*]] = fir.address_of(@_QFtest_logicalEl1) : !fir.ref> -! CHECK: %[[DECLARE_0:.*]] = fir.declare %[[ADDRESS_OF_0]] {uniq_name = "_QFtest_logicalEl1"} : (!fir.ref>) -> !fir.ref> -! CHECK: %[[ADDRESS_OF_1:.*]] = fir.address_of(@_QFtest_logicalEl2) : !fir.ref> -! CHECK: %[[DECLARE_1:.*]] = fir.declare %[[ADDRESS_OF_1]] {uniq_name = "_QFtest_logicalEl2"} : (!fir.ref>) -> !fir.ref> -! CHECK: %[[ADDRESS_OF_2:.*]] = fir.address_of(@_QFtest_logicalEla2) : !fir.ref>> +! CHECK: %[[ADDRESS_OF_0:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_logicalEl1) : !fir.ref> +! CHECK: %[[DECLARE_0:.*]] = fir.declare %[[ADDRESS_OF_0]] {uniq_name = "_QMtest_show_descriptorFtest_logicalEl1"} : (!fir.ref>) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_1:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_logicalEl2) : !fir.ref> +! CHECK: %[[DECLARE_1:.*]] = fir.declare %[[ADDRESS_OF_1]] {uniq_name = "_QMtest_show_descriptorFtest_logicalEl2"} : (!fir.ref>) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_2:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_logicalEla2) : !fir.ref>> ! CHECK: %[[SHAPE_0:.*]] = fir.shape %[[C2]] : (index) -> !fir.shape<1> -! CHECK: %[[DECLARE_2:.*]] = fir.declare %[[ADDRESS_OF_2]](%[[SHAPE_0]]) {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_logicalEla2"} : (!fir.ref>>, !fir.shape<1>) -> !fir.ref>> -! CHECK: %[[ALLOCA_0:.*]] = fir.alloca !fir.box>>> {bindc_name = "pla2", uniq_name = "_QFtest_logicalEpla2"} +! CHECK: %[[DECLARE_2:.*]] = fir.declare %[[ADDRESS_OF_2]](%[[SHAPE_0]]) {fortran_attrs = #fir.var_attrs, uniq_name = "_QMtest_show_descriptorFtest_logicalEla2"} : (!fir.ref>>, !fir.shape<1>) -> !fir.ref>> +! CHECK: %[[ALLOCA_0:.*]] = fir.alloca !fir.box>>> {bindc_name = "pla2", uniq_name = "_QMtest_show_descriptorFtest_logicalEpla2"} ! CHECK: %[[ZERO_BITS_0:.*]] = fir.zero_bits !fir.ptr>> ! CHECK: %[[SHAPE_1:.*]] = fir.shape %[[C0]] : (index) -> !fir.shape<1> ! CHECK: %[[EMBOX_0:.*]] = fir.embox %[[ZERO_BITS_0]](%[[SHAPE_1]]) : (!fir.ptr>>, !fir.shape<1>) -> !fir.box>>> ! CHECK: fir.store %[[EMBOX_0]] to %[[ALLOCA_0]] : !fir.ref>>>> - call __builtin_show_descriptor(l1) - call __builtin_show_descriptor(l2) + call show_descriptor(l1) + call show_descriptor(l2) pla2 => la2 -! CHECK: %[[DECLARE_3:.*]] = fir.declare %[[ALLOCA_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_logicalEpla2"} : (!fir.ref>>>>) -> !fir.ref>>>> +! CHECK: %[[DECLARE_3:.*]] = fir.declare %[[ALLOCA_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QMtest_show_descriptorFtest_logicalEpla2"} : (!fir.ref>>>>) -> !fir.ref>>>> ! CHECK: %[[EMBOX_1:.*]] = fir.embox %[[DECLARE_0]] : (!fir.ref>) -> !fir.box> ! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_1]]) fastmath : (!fir.box>) -> () ! CHECK: %[[EMBOX_2:.*]] = fir.embox %[[DECLARE_1]] : (!fir.ref>) -> !fir.box> ! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_2]]) fastmath : (!fir.box>) -> () - call __builtin_show_descriptor(la2) - call __builtin_show_descriptor(pla2) + call show_descriptor(la2) + call show_descriptor(pla2) ! CHECK: %[[CONVERT_0:.*]] = fir.convert %[[DECLARE_2]] : (!fir.ref>>) -> !fir.ref>> ! CHECK: %[[EMBOX_3:.*]] = fir.embox %[[CONVERT_0]](%[[SHAPE_0]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>>> ! CHECK: fir.store %[[EMBOX_3]] to %[[DECLARE_3]] : !fir.ref>>>> @@ -118,7 +121,7 @@ subroutine test_logical end subroutine test_logical subroutine test_real -! CHECK-LABEL: func.func @_QPtest_real() { +! CHECK-LABEL: func.func @_QMtest_show_descriptorPtest_real() { implicit none real :: half = 0.5 real :: row(3) = (/ 1 , 2, 3 /) @@ -128,19 +131,19 @@ subroutine test_real ! CHECK: %[[C4:.*]] = arith.constant 4 : index ! CHECK: %[[C3:.*]] = arith.constant 3 : index ! CHECK: %[[DUMMY_SCOPE_2:.*]] = fir.dummy_scope : !fir.dscope -! CHECK: %[[ADDRESS_OF_4:.*]] = fir.address_of(@_QFtest_realEhalf) : !fir.ref -! CHECK: %[[DECLARE_5:.*]] = fir.declare %[[ADDRESS_OF_4]] {uniq_name = "_QFtest_realEhalf"} : (!fir.ref) -> !fir.ref -! CHECK: %[[ADDRESS_OF_5:.*]] = fir.address_of(@_QFtest_realErow) : !fir.ref> +! CHECK: %[[ADDRESS_OF_4:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_realEhalf) : !fir.ref +! CHECK: %[[DECLARE_5:.*]] = fir.declare %[[ADDRESS_OF_4]] {uniq_name = "_QMtest_show_descriptorFtest_realEhalf"} : (!fir.ref) -> !fir.ref +! CHECK: %[[ADDRESS_OF_5:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_realErow) : !fir.ref> ! CHECK: %[[SHAPE_2:.*]] = fir.shape %[[C3]] : (index) -> !fir.shape<1> -! CHECK: %[[DECLARE_6:.*]] = fir.declare %[[ADDRESS_OF_5]](%[[SHAPE_2]]) {uniq_name = "_QFtest_realErow"} : (!fir.ref>, !fir.shape<1>) -> !fir.ref> -! CHECK: %[[ADDRESS_OF_6:.*]] = fir.address_of(@_QFtest_realEw) : !fir.ref> +! CHECK: %[[DECLARE_6:.*]] = fir.declare %[[ADDRESS_OF_5]](%[[SHAPE_2]]) {uniq_name = "_QMtest_show_descriptorFtest_realErow"} : (!fir.ref>, !fir.shape<1>) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_6:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_realEw) : !fir.ref> ! CHECK: %[[SHAPE_3:.*]] = fir.shape %[[C4]] : (index) -> !fir.shape<1> -! CHECK: %[[DECLARE_7:.*]] = fir.declare %[[ADDRESS_OF_6]](%[[SHAPE_3]]) {uniq_name = "_QFtest_realEw"} : (!fir.ref>, !fir.shape<1>) -> !fir.ref> +! CHECK: %[[DECLARE_7:.*]] = fir.declare %[[ADDRESS_OF_6]](%[[SHAPE_3]]) {uniq_name = "_QMtest_show_descriptorFtest_realEw"} : (!fir.ref>, !fir.shape<1>) -> !fir.ref> - call __builtin_show_descriptor(half) - call __builtin_show_descriptor(row) - call __builtin_show_descriptor(w) - call __builtin_show_descriptor(w(1:4:2)) + call show_descriptor(half) + call show_descriptor(row) + call show_descriptor(w) + call show_descriptor(w(1:4:2)) ! CHECK: %[[EMBOX_7:.*]] = fir.embox %[[DECLARE_5]] : (!fir.ref) -> !fir.box ! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_7]]) fastmath : (!fir.box) -> () ! CHECK: %[[EMBOX_8:.*]] = fir.embox %[[DECLARE_6]](%[[SHAPE_2]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box> @@ -156,7 +159,7 @@ subroutine test_real end subroutine test_real subroutine test_complex -! CHECK-LABEL: func.func @_QPtest_complex() { +! CHECK-LABEL: func.func @_QMtest_show_descriptorPtest_complex() { implicit none complex, parameter :: hr = 0.5 complex, parameter :: hi = (0, 0.5) @@ -169,41 +172,41 @@ subroutine test_complex ! CHECK: %[[ALLOCA_1:.*]] = fir.alloca complex ! CHECK: %[[ALLOCA_2:.*]] = fir.alloca complex ! CHECK: %[[DUMMY_SCOPE_3:.*]] = fir.dummy_scope : !fir.dscope -! CHECK: %[[ADDRESS_OF_7:.*]] = fir.address_of(@_QFtest_complexEa2) : !fir.ref>> +! CHECK: %[[ADDRESS_OF_7:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_complexEa2) : !fir.ref>> ! CHECK: %[[SHAPE_5:.*]] = fir.shape %[[C2]] : (index) -> !fir.shape<1> -! CHECK: %[[DECLARE_8:.*]] = fir.declare %[[ADDRESS_OF_7]](%[[SHAPE_5]]) {uniq_name = "_QFtest_complexEa2"} : (!fir.ref>>, !fir.shape<1>) -> !fir.ref>> -! CHECK: %[[ADDRESS_OF_8:.*]] = fir.address_of(@_QFtest_complexEc1) : !fir.ref> -! CHECK: %[[DECLARE_9:.*]] = fir.declare %[[ADDRESS_OF_8]] {uniq_name = "_QFtest_complexEc1"} : (!fir.ref>) -> !fir.ref> -! CHECK: %[[ADDRESS_OF_9:.*]] = fir.address_of(@_QFtest_complexEc2) : !fir.ref> -! CHECK: %[[DECLARE_10:.*]] = fir.declare %[[ADDRESS_OF_9]] {uniq_name = "_QFtest_complexEc2"} : (!fir.ref>) -> !fir.ref> -! CHECK: %[[ADDRESS_OF_10:.*]] = fir.address_of(@_QFtest_complexEChi) : !fir.ref> -! CHECK: %[[DECLARE_11:.*]] = fir.declare %[[ADDRESS_OF_10]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_complexEChi"} : (!fir.ref>) -> !fir.ref> -! CHECK: %[[ADDRESS_OF_11:.*]] = fir.address_of(@_QFtest_complexEChr) : !fir.ref> -! CHECK: %[[DECLARE_12:.*]] = fir.declare %[[ADDRESS_OF_11]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_complexEChr"} : (!fir.ref>) -> !fir.ref> +! CHECK: %[[DECLARE_8:.*]] = fir.declare %[[ADDRESS_OF_7]](%[[SHAPE_5]]) {uniq_name = "_QMtest_show_descriptorFtest_complexEa2"} : (!fir.ref>>, !fir.shape<1>) -> !fir.ref>> +! CHECK: %[[ADDRESS_OF_8:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_complexEc1) : !fir.ref> +! CHECK: %[[DECLARE_9:.*]] = fir.declare %[[ADDRESS_OF_8]] {uniq_name = "_QMtest_show_descriptorFtest_complexEc1"} : (!fir.ref>) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_9:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_complexEc2) : !fir.ref> +! CHECK: %[[DECLARE_10:.*]] = fir.declare %[[ADDRESS_OF_9]] {uniq_name = "_QMtest_show_descriptorFtest_complexEc2"} : (!fir.ref>) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_10:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_complexEChi) : !fir.ref> +! CHECK: %[[DECLARE_11:.*]] = fir.declare %[[ADDRESS_OF_10]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QMtest_show_descriptorFtest_complexEChi"} : (!fir.ref>) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_11:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_complexEChr) : !fir.ref> +! CHECK: %[[DECLARE_12:.*]] = fir.declare %[[ADDRESS_OF_11]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QMtest_show_descriptorFtest_complexEChr"} : (!fir.ref>) -> !fir.ref> ! CHECK: %[[UNDEFINED_1:.*]] = fir.undefined complex ! CHECK: %[[INSERT_VALUE_0:.*]] = fir.insert_value %[[UNDEFINED_1]], %[[CST_1]], [0 : index] : (complex, f32) -> complex ! CHECK: %[[INSERT_VALUE_1:.*]] = fir.insert_value %[[INSERT_VALUE_0]], %[[CST_0]], [1 : index] : (complex, f32) -> complex ! CHECK: fir.store %[[INSERT_VALUE_1]] to %[[ALLOCA_2]] : !fir.ref> - call __builtin_show_descriptor(hr) + call show_descriptor(hr) ! CHECK: %[[EMBOX_11:.*]] = fir.embox %[[ALLOCA_2]] : (!fir.ref>) -> !fir.box> ! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_11]]) fastmath : (!fir.box>) -> () - call __builtin_show_descriptor(hi) + call show_descriptor(hi) ! CHECK: %[[INSERT_VALUE_2:.*]] = fir.insert_value %[[UNDEFINED_1]], %[[CST_0]], [0 : index] : (complex, f32) -> complex ! CHECK: %[[INSERT_VALUE_3:.*]] = fir.insert_value %[[INSERT_VALUE_2]], %[[CST_1]], [1 : index] : (complex, f32) -> complex ! CHECK: fir.store %[[INSERT_VALUE_3]] to %[[ALLOCA_1]] : !fir.ref> ! CHECK: %[[EMBOX_12:.*]] = fir.embox %[[ALLOCA_1]] : (!fir.ref>) -> !fir.box> ! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_12]]) fastmath : (!fir.box>) -> () - call __builtin_show_descriptor(a2) + call show_descriptor(a2) ! CHECK: %[[EMBOX_13:.*]] = fir.embox %[[DECLARE_8]](%[[SHAPE_5]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> ! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_13]]) fastmath : (!fir.box>>) -> () ! CHECK: return end subroutine test_complex subroutine test_derived -! CHECK-LABEL: func.func @_QPtest_derived() { +! CHECK-LABEL: func.func @_QMtest_show_descriptorPtest_derived() { implicit none type :: t1 integer :: a @@ -217,21 +220,22 @@ subroutine test_derived ! CHECK: %[[C2:.*]] = arith.constant 2 : index ! CHECK: %[[C1:.*]] = arith.constant 1 : index ! CHECK: %[[DUMMY_SCOPE_4:.*]] = fir.dummy_scope : !fir.dscope -! CHECK: %[[ADDRESS_OF_12:.*]] = fir.address_of(@_QFtest_derivedE.n.a) : !fir.ref> -! CHECK: %[[DECLARE_13:.*]] = fir.declare %[[ADDRESS_OF_12]] typeparams %[[C1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_derivedE.n.a"} : (!fir.ref>, index) -> !fir.ref> -! CHECK: %[[ADDRESS_OF_13:.*]] = fir.address_of(@_QFtest_derivedE.n.b) : !fir.ref> -! CHECK: %[[DECLARE_14:.*]] = fir.declare %[[ADDRESS_OF_13]] typeparams %[[C1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_derivedE.n.b"} : (!fir.ref>, index) -> !fir.ref> -! CHECK: %[[ADDRESS_OF_14:.*]] = fir.address_of(@_QFtest_derivedE.n.t1) : !fir.ref> -! CHECK: %[[DECLARE_15:.*]] = fir.declare %[[ADDRESS_OF_14]] typeparams %[[C2]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_derivedE.n.t1"} : (!fir.ref>, index) -> !fir.ref> -! CHECK: %[[ADDRESS_OF_15:.*]] = fir.address_of(@_QFtest_derivedE.n.c) : !fir.ref> -! CHECK: %[[DECLARE_16:.*]] = fir.declare %[[ADDRESS_OF_15]] typeparams %[[C1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_derivedE.n.c"} : (!fir.ref>, index) -> !fir.ref> -! CHECK: %[[ADDRESS_OF_16:.*]] = fir.address_of(@_QFtest_derivedE.n.t2) : !fir.ref> -! CHECK: %[[DECLARE_17:.*]] = fir.declare %[[ADDRESS_OF_16]] typeparams %[[C2]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_derivedE.n.t2"} : (!fir.ref>, index) -> !fir.ref> -! CHECK: %[[ADDRESS_OF_17:.*]] = fir.address_of(@_QFtest_derivedEvt2) : !fir.ref,c:i32}>> -! CHECK: %[[DECLARE_18:.*]] = fir.declare %[[ADDRESS_OF_17]] {uniq_name = "_QFtest_derivedEvt2"} : (!fir.ref,c:i32}>>) -> !fir.ref,c:i32}>> - - call __builtin_show_descriptor(vt2) -! CHECK: %[[EMBOX_16:.*]] = fir.embox %[[DECLARE_18]] : (!fir.ref,c:i32}>>) -> !fir.box,c:i32}>> -! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_16]]) fastmath : (!fir.box,c:i32}>>) -> () +! CHECK: %[[ADDRESS_OF_12:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_derivedE.n.a) : !fir.ref> +! CHECK: %[[DECLARE_13:.*]] = fir.declare %[[ADDRESS_OF_12]] typeparams %[[C1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QMtest_show_descriptorFtest_derivedE.n.a"} : (!fir.ref>, index) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_13:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_derivedE.n.b) : !fir.ref> +! CHECK: %[[DECLARE_14:.*]] = fir.declare %[[ADDRESS_OF_13]] typeparams %[[C1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QMtest_show_descriptorFtest_derivedE.n.b"} : (!fir.ref>, index) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_14:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_derivedE.n.t1) : !fir.ref> +! CHECK: %[[DECLARE_15:.*]] = fir.declare %[[ADDRESS_OF_14]] typeparams %[[C2]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QMtest_show_descriptorFtest_derivedE.n.t1"} : (!fir.ref>, index) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_15:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_derivedE.n.c) : !fir.ref> +! CHECK: %[[DECLARE_16:.*]] = fir.declare %[[ADDRESS_OF_15]] typeparams %[[C1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QMtest_show_descriptorFtest_derivedE.n.c"} : (!fir.ref>, index) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_16:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_derivedE.n.t2) : !fir.ref> +! CHECK: %[[DECLARE_17:.*]] = fir.declare %[[ADDRESS_OF_16]] typeparams %[[C2]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QMtest_show_descriptorFtest_derivedE.n.t2"} : (!fir.ref>, index) -> !fir.ref> +! CHECK: %[[ADDRESS_OF_17:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_derivedEvt2) : !fir.ref,c:i32}>> +! CHECK: %[[DECLARE_18:.*]] = fir.declare %[[ADDRESS_OF_17]] {uniq_name = "_QMtest_show_descriptorFtest_derivedEvt2"} : (!fir.ref,c:i32}>>) -> !fir.ref,c:i32}>> + + call show_descriptor(vt2) +! CHECK: %[[EMBOX_16:.*]] = fir.embox %[[DECLARE_18]] : (!fir.ref,c:i32}>>) -> !fir.box,c:i32}>> +! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_16]]) fastmath : (!fir.box,c:i32}>>) -> () ! CHECK: return end subroutine test_derived +end module test_show_descriptor