[flang/flang-rt] Implement show_descriptor intrinsic, a non-standard extension. #170389
Conversation
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
… extension
Reapply llvm#169137
show_descriptor intrinsic prints details of a descriptor (extended
Fortran pointer).
It accepts a descriptor for any type and rank, including scalars.
Requires use of flang_debug module.
Example:
program test
use flang_debug
implicit none
integer :: a(4) = (/ 1,3,5,7 /)
call show_descriptor(a(1:3))
end program test
and its output:
Descriptor @ 0x7ffe01ec6a98:
base_addr 0x563b7035103c
elem_len 4
version 20240719
rank 1
type 9 "INTEGER(kind=4)"
attribute 0
extra 0
addendum 0
alloc_idx 0
dim[0] lower_bound 1
extent 3
sm 4
llvmbot
added
flang
Member
|
@llvm/pr-subscribers-flang-fir-hlfir @llvm/pr-subscribers-flang-semantics Author: Valery Dmitriev (valerydmit) ChangesThis is a reapply the original patch (#169137) with the flang-rt unit test changes limiting it to linux platform only. show_descriptor intrinsic prints details of a descriptor (extended Fortran pointer). Example: and its output: Patch is 40.29 KiB, truncated to 20.00 KiB below, full version: https://github.com/llvm/llvm-project/pull/170389.diff 15 Files Affected:
diff --git a/flang-rt/include/flang-rt/runtime/descriptor.h b/flang-rt/include/flang-rt/runtime/descriptor.h
index ff7ec050d32c7..40e30e3bf783f 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 print 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..75bea976e2087 100644
--- a/flang-rt/lib/runtime/descriptor.cpp
+++ b/flang-rt/lib/runtime/descriptor.cpp
@@ -292,14 +292,161 @@ 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)
+ default:
+ return nullptr;
+ }
+#undef CASE
+ }
+ TypeCode code{type};
+ if (!code.IsValid()) {
+ return "invalid";
+ }
+ auto categoryAndKind{code.GetCategoryAndKind()};
+ if (!categoryAndKind) {
+ return nullptr;
+ }
+ TypeCategory tcat{categoryAndKind->first};
+ int kind{categoryAndKind->second};
+
+#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<const void *>(this));
std::fprintf(f, " base_addr %p\n", raw_.base_addr);
- std::fprintf(f, " elem_len %zd\n", static_cast<std::size_t>(raw_.elem_len));
+ std::fprintf(f, " elem_len %zd\n", ElementBytes());
std::fprintf(f, " version %d\n", static_cast<int>(raw_.version));
- std::fprintf(f, " rank %d\n", static_cast<int>(raw_.rank));
- std::fprintf(f, " type %d\n", static_cast<int>(raw_.type));
- std::fprintf(f, " attribute %d\n", static_cast<int>(raw_.attribute));
+ std::fprintf(f, " rank %d%s\n", rank(), rank() ? "" : " (scalar)");
+ int ty{static_cast<int>(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<int>(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<int>(raw_.extra));
std::fprintf(f, " addendum %d\n", static_cast<int>(HasAddendum()));
std::fprintf(f, " alloc_idx %d\n", static_cast<int>(GetAllocIdx()));
diff --git a/flang-rt/lib/runtime/extensions.cpp b/flang-rt/lib/runtime/extensions.cpp
index c110b0381890c..108d7b1923b99 100644
--- a/flang-rt/lib/runtime/extensions.cpp
+++ b/flang-rt/lib/runtime/extensions.cpp
@@ -467,6 +467,15 @@ void FORTRAN_PROCEDURE_NAME(srand)(int *seed) {
rand_seed_lock.Drop();
}
+
+void RTNAME(ShowDescriptor)(const Fortran::runtime::Descriptor *descr) {
+ if (descr) {
+ descr->Dump(stderr, /*dumpRawType=*/false);
+ } else {
+ std::fprintf(stderr, "NULL\n");
+ }
+}
+
// Extension procedures related to I/O
namespace io {
diff --git a/flang-rt/unittests/Runtime/Descriptor.cpp b/flang-rt/unittests/Runtime/Descriptor.cpp
index 4a7bb43a492af..0f6dd697e1e33 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 <regex>
using namespace Fortran::runtime;
@@ -158,3 +159,125 @@ TEST(Descriptor, FixedStride) {
EXPECT_TRUE(descriptor.IsContiguous());
EXPECT_EQ(descriptor.FixedStride().value_or(-666), 0);
}
+
+// The test below uses file operations that have nuances across multiple
+// platforms. Hence limit coverage by linux only unless wider coverage
+// should be required.
+#if defined(__linux__) && !defined(__ANDROID__)
+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<int>(sizeof data[0][0][0])};
+ TypeCode integer{TypeCategory::Integer, four};
+ // Scalar
+ descriptor.Establish(integer, four, data, 0);
+ FILE *tmpf = nullptr;
+ tmpf = tmpfile();
+ ASSERT_TRUE(tmpf) << "tmpfile returned NULL";
+ auto resetTmpFile = [tmpf]() {
+ fflush(tmpf);
+ rewind(tmpf);
+ ftruncate(fileno(tmpf), 0);
+ };
+
+ auto getAddrFilteredContent = [tmpf]() -> std::string {
+ rewind(tmpf);
+ std::ostringstream content;
+ char buffer[1024];
+ size_t bytes_read;
+ while ((bytes_read = fread(buffer, 1, sizeof(buffer), tmpf)) > 0) {
+ content.write(buffer, bytes_read);
+ }
+
+ return std::regex_replace(
+ std::regex_replace(content.str(), std::regex("Descriptor @.*:"),
+ "Descriptor @ [addr]:"),
+ std::regex("base_addr .*"), "base_addr [addr]");
+ };
+
+ descriptor.Dump(tmpf, /*dumpRawType=*/false);
+ // also dump as CFI type
+ descriptor.Dump(tmpf, /*dumpRawType=*/true);
+ std::string output = getAddrFilteredContent();
+ ASSERT_STREQ(output.c_str(),
+ "Descriptor @ [addr]:\n"
+ " base_addr [addr]\n"
+ " elem_len 4\n"
+ " version 20240719\n"
+ " rank 0 (scalar)\n"
+ " type 9 \"INTEGER(kind=4)\"\n"
+ " attribute 0\n"
+ " extra 0\n"
+ " addendum 0\n"
+ " alloc_idx 0\n"
+ "Descriptor @ [addr]:\n"
+ " base_addr [addr]\n"
+ " elem_len 4\n"
+ " version 20240719\n"
+ " rank 0 (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();
+ ASSERT_STREQ(output.c_str(),
+ "Descriptor @ [addr]:\n"
+ " base_addr [addr]\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();
+ ASSERT_STREQ(output.c_str(),
+ "Descriptor @ [addr]:\n"
+ " base_addr [addr]\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);
+}
+#endif // defined(__linux__) && !defined(__ANDROID__)
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 31bead9f8bfdc..6451fc48fc6a2 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -1414,6 +1414,7 @@ This is prefixed by `STRING`, a colon and a space.
- **Class:** subroutine
- **Syntax:** `CALL PERROR(STRING)`
+<<<<<<< HEAD
### Non-Standard Intrinsics: SRAND
#### Description
@@ -1455,3 +1456,45 @@ The return value is of `REAL` type with the default kind.
- **Standard:** GNU extension
- **Class:** function
- **Syntax:** `RESULT = RAND(I)`
+
+### 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
+```
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 0ae9177f98fd8..b248106b51101 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -413,6 +413,7 @@ struct IntrinsicLibrary {
template <typename Shift>
mlir::Value genShift(mlir::Type resultType, llvm::ArrayRef<mlir::Value>);
mlir::Value genShiftA(mlir::Type resultType, llvm::ArrayRef<mlir::Value>);
+ void genShowDescriptor(llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genSign(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genSind(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genSinpi(mlir::Type, llvm::ArrayRef<mlir::Value>);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
index 30c3189366cec..1f751827309a4 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
@@ -111,12 +111,15 @@ void genSleep(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value genChdir(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value name);
-
mlir::Value genIrand(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value i);
mlir::Value genRand(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value i);
+/// 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 f2765a5987ea1..40ce77112d183 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" {
@@ -111,5 +116,8 @@ float RTNAME(Rand)(int *i, const char *sourceFile, int line);
// GNU extension subroutine SRAND(SEED)
void FORTRAN_PROCEDURE_NAME(srand)(int *seed);
+// flang extension subroutine SHOW_DESCRIPTOR(D)
+void RTNAME(ShowDescriptor)(const Fortran::runtime::Descriptor *descr);
+
} // extern "C"
#endif // FORTRAN_RUNTIME_EXTENSIONS_H_
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index bbcb766274e7f..d69400e0ec188 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1713,6 +1713,8 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{}, Rank::scalar, IntrinsicClass::impureSubroutine},
{"second", {{"time", DefaultReal, Rank::scalar}}, {}, Rank::scalar,
IntrinsicClass::impureSubroutine},
+ {"__builtin_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 3619e5bb942db..75a74eeb18417 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -727,6 +727,10 @@ static constexpr IntrinsicHandler handlers[]{
{"shifta", &I::genShiftA},
{"shiftl", &I::genShift<mlir::arith::ShLIOp>},
{"shiftr", &I::genShift<mlir::arith::ShRUIOp>},
+ {"show_descriptor",
+ &I::genShowDescriptor,
+ {{{"d", asBox}}},
+ /*isElemental=*/false},
{"sign", &I::genSign},
{"signal",
&I::genSignalSubroutine,
@@ -7884,6 +7888,16 @@ mlir::Value IntrinsicLibrary::genShiftA(mlir::Type resultType,
return result;
}
+void IntrinsicLibrary::genShowDescriptor(
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ 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()) &&
+ "argument must have been lowered to box type");
+ fir::runtime::genShowDescriptor(builder, loc, descriptor);
+}
+
// SIGNAL
void IntrinsicLibrary::genSignalSubroutine(
llvm::ArrayRef<fir::ExtendedValue> args) {
diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index 4d366135c305f..a5f16f89b260a 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -494,3 +494,10 @@ mlir::Value fir::runtime::genRand(fir::FirOpBuilder &builder,
builder, loc, runtimeFuncTy, i, sourceFile, sourceLine);
return fir::CallOp::create(builder, loc, runtimeFunc, args).getResult(0);
}
+
+void fir::runtime::genShowDescriptor(fir::FirOpBuilder &builder,
+ mlir::Location loc, mlir::Value descAddr) {
+ mlir::func::FuncOp func{
+ fir::runtime::getRuntimeFunc<mkRTKey(ShowDescriptor)>(loc, builder)};
+ fir::CallOp::create(builder, loc, func, descAddr);
+}
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
new file mode 100644
index 0000000000000..a0b8d3eb4348f
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/show_descriptor.f90
@@ -0,0 +1,241 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+module test_show_descriptor
+use flang_debug
+contains
+subroutine test_int
+! CHECK-LABEL: func.func @_QMtest_show_descriptorPtest_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<!fir.heap<!fir.array<?xi32>>> {bindc_name = "a", uniq_name = "_QMtest_show_descriptorFtest_intEa"}
+! CHECK: %[[ZERO_BITS_0:.*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
+! CHECK: %[[SHAPE_0:.*]] = fir.shape %[[C0]] : (index) -> !fir.shape<1>
+! CHECK: %[[EMBOX_0:.*]] = fir.embox %[[ZERO_BITS_0]](%[[SHAPE_0]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
+! CHECK: fir.store %[[EMBOX_0]] to %[[ALLOCA_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: %[[DECLARE_0:.*]] = fir.declare %[[ALLOCA_0]] {fortr...
[truncated]
|
|
✅ With the latest revision this PR passed the C/C++ code formatter. |
vzakhari
approved these changes
Dec 2, 2025
Contributor
vzakhari
left a comment
vzakhari
left a comment
There was a problem hiding this comment.
Thank you, Valery! LGTM (with two minor style remarks)
jeanPerier
approved these changes
Dec 3, 2025
Collaborator
|
LLVM Buildbot has detected a new failure on builder Full details are available at: https://lab.llvm.org/buildbot/#/builders/157/builds/42742 Here is the relevant piece of the build log for the reference |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
5 participants
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
This is a reapply the original patch (#169137) with the flang-rt unit test changes limiting it to linux platform only.
Additionally accommodated style changes from Peter Klausler (#170227)
show_descriptor intrinsic prints details of a descriptor (extended Fortran pointer).
It accepts a descriptor for any type and rank, including scalars.
Requires use of flang_debug module.
Example:
and its output: