[flang/flang-rt] Implement show_descriptor intrinsic, a non-standard extension. (#170389)
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: ``` 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 ```
This commit is contained in:
Valery Dmitriev
GitHub
parent
87ccc55df4
commit
4b2714f12f
@ -510,7 +510,9 @@ public:
|
||||
|
||||
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;
|
||||
|
||||
@ -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()));
|
||||
|
||||
@ -467,6 +467,14 @@ 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 {
|
||||
|
||||
@ -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,124 @@ 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{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__)
|
||||
|
||||
@ -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
|
||||
```
|
||||
|
||||
@ -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>);
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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_
|
||||
|
||||
@ -1715,6 +1715,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,
|
||||
|
||||
@ -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) {
|
||||
|
||||
@ -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);
|
||||
}
|
||||
|
||||
@ -28,6 +28,9 @@ module __fortran_builtins
|
||||
intrinsic :: __builtin_c_f_pointer
|
||||
public :: __builtin_c_f_pointer
|
||||
|
||||
intrinsic :: __builtin_show_descriptor
|
||||
public :: __builtin_show_descriptor
|
||||
|
||||
intrinsic :: sizeof ! extension
|
||||
public :: sizeof
|
||||
|
||||
|
||||
14
flang/module/flang_debug.f90
Normal file
14
flang/module/flang_debug.f90
Normal file
@ -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
|
||||
241
flang/test/Lower/Intrinsics/show_descriptor.f90
Normal file
241
flang/test/Lower/Intrinsics/show_descriptor.f90
Normal file
@ -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]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QMtest_show_descriptorFtest_intEa"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
|
||||
! 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<i32>) -> !fir.ref<i32>
|
||||
! CHECK: fir.store %[[C5]] to %[[DECLARE_1]] : !fir.ref<i32>
|
||||
! CHECK: %[[LOAD_0:.*]] = fir.load %[[DECLARE_1]] : !fir.ref<i32>
|
||||
! 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<?xi32>, %[[SELECT_0]] {fir.must_be_heap = true, uniq_name = "_QMtest_show_descriptorFtest_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.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
|
||||
! CHECK: fir.store %[[EMBOX_1]] to %[[DECLARE_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
|
||||
! CHECK: %[[LOAD_1:.*]] = fir.load %[[DECLARE_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[LOAD_1]]) fastmath<contract> : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> ()
|
||||
|
||||
call show_descriptor(a(1:3))
|
||||
! CHECK: %[[LOAD_2:.*]] = fir.load %[[DECLARE_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
|
||||
! CHECK: %[[SHAPE_2:.*]] = fir.shape %[[C3]] : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[BOX_ADDR_0:.*]] = fir.box_addr %[[LOAD_2]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
|
||||
! CHECK: %[[CONSTANT_4:.*]] = arith.constant 0 : index
|
||||
! CHECK: %[[BOX_DIMS_0:.*]]:3 = fir.box_dims %[[LOAD_2]], %[[CONSTANT_4]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>, 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.array<?xi32>>, !fir.shapeshift<1>, index) -> !fir.ref<i32>
|
||||
! CHECK: %[[CONVERT_1:.*]] = fir.convert %[[ARRAY_COOR_0]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<3xi32>>
|
||||
! CHECK: %[[EMBOX_2:.*]] = fir.embox %[[CONVERT_1]](%[[SHAPE_2]]) : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<3xi32>>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_2]]) fastmath<contract> : (!fir.box<!fir.array<3xi32>>) -> ()
|
||||
deallocate(a)
|
||||
end subroutine test_int
|
||||
|
||||
subroutine test_char
|
||||
! CHECK-LABEL: func.func @_QMtest_show_descriptorPtest_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(@_QMtest_show_descriptorFtest_charEc) : !fir.ref<!fir.char<1,9>>
|
||||
! CHECK: %[[DECLARE_0:.*]] = fir.declare %[[ADDRESS_OF_0]] typeparams %[[C9]] {uniq_name = "_QMtest_show_descriptorFtest_charEc"} : (!fir.ref<!fir.char<1,9>>, index) -> !fir.ref<!fir.char<1,9>>
|
||||
! CHECK: %[[EMBOX_0:.*]] = fir.embox %[[DECLARE_0]] : (!fir.ref<!fir.char<1,9>>) -> !fir.box<!fir.char<1,9>>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_0]]) fastmath<contract> : (!fir.box<!fir.char<1,9>>) -> ()
|
||||
|
||||
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.char<1,9>>) -> !fir.ref<!fir.array<9x!fir.char<1>>>
|
||||
! CHECK: %[[COORDINATE_OF_0:.*]] = fir.coordinate_of %[[CONVERT_0]], %[[SUBI_0]] : (!fir.ref<!fir.array<9x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
|
||||
! CHECK: %[[CONVERT_1:.*]] = fir.convert %[[COORDINATE_OF_0]] : (!fir.ref<!fir.char<1>>) -> !fir.ref<!fir.char<1,3>>
|
||||
! CHECK: %[[EMBOX_1:.*]] = fir.embox %[[CONVERT_1]] : (!fir.ref<!fir.char<1,3>>) -> !fir.box<!fir.char<1,3>>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_1]]) fastmath<contract> : (!fir.box<!fir.char<1,3>>) -> ()
|
||||
! CHECK: return
|
||||
end subroutine test_char
|
||||
|
||||
subroutine test_logical
|
||||
! CHECK-LABEL: func.func @_QMtest_show_descriptorPtest_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(@_QMtest_show_descriptorFtest_logicalEl1) : !fir.ref<!fir.logical<1>>
|
||||
! CHECK: %[[DECLARE_0:.*]] = fir.declare %[[ADDRESS_OF_0]] {uniq_name = "_QMtest_show_descriptorFtest_logicalEl1"} : (!fir.ref<!fir.logical<1>>) -> !fir.ref<!fir.logical<1>>
|
||||
! CHECK: %[[ADDRESS_OF_1:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_logicalEl2) : !fir.ref<!fir.logical<2>>
|
||||
! CHECK: %[[DECLARE_1:.*]] = fir.declare %[[ADDRESS_OF_1]] {uniq_name = "_QMtest_show_descriptorFtest_logicalEl2"} : (!fir.ref<!fir.logical<2>>) -> !fir.ref<!fir.logical<2>>
|
||||
! CHECK: %[[ADDRESS_OF_2:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_logicalEla2) : !fir.ref<!fir.array<2x!fir.logical<2>>>
|
||||
! 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<target>, uniq_name = "_QMtest_show_descriptorFtest_logicalEla2"} : (!fir.ref<!fir.array<2x!fir.logical<2>>>, !fir.shape<1>) -> !fir.ref<!fir.array<2x!fir.logical<2>>>
|
||||
! CHECK: %[[ALLOCA_0:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x!fir.logical<2>>>> {bindc_name = "pla2", uniq_name = "_QMtest_show_descriptorFtest_logicalEpla2"}
|
||||
! CHECK: %[[ZERO_BITS_0:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x!fir.logical<2>>>
|
||||
! CHECK: %[[SHAPE_1:.*]] = fir.shape %[[C0]] : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[EMBOX_0:.*]] = fir.embox %[[ZERO_BITS_0]](%[[SHAPE_1]]) : (!fir.ptr<!fir.array<?x!fir.logical<2>>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.logical<2>>>>
|
||||
! CHECK: fir.store %[[EMBOX_0]] to %[[ALLOCA_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.logical<2>>>>>
|
||||
|
||||
call show_descriptor(l1)
|
||||
call show_descriptor(l2)
|
||||
pla2 => la2
|
||||
! CHECK: %[[DECLARE_3:.*]] = fir.declare %[[ALLOCA_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QMtest_show_descriptorFtest_logicalEpla2"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.logical<2>>>>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.logical<2>>>>>
|
||||
! CHECK: %[[EMBOX_1:.*]] = fir.embox %[[DECLARE_0]] : (!fir.ref<!fir.logical<1>>) -> !fir.box<!fir.logical<1>>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_1]]) fastmath<contract> : (!fir.box<!fir.logical<1>>) -> ()
|
||||
! CHECK: %[[EMBOX_2:.*]] = fir.embox %[[DECLARE_1]] : (!fir.ref<!fir.logical<2>>) -> !fir.box<!fir.logical<2>>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_2]]) fastmath<contract> : (!fir.box<!fir.logical<2>>) -> ()
|
||||
|
||||
call show_descriptor(la2)
|
||||
call show_descriptor(pla2)
|
||||
! CHECK: %[[CONVERT_0:.*]] = fir.convert %[[DECLARE_2]] : (!fir.ref<!fir.array<2x!fir.logical<2>>>) -> !fir.ref<!fir.array<?x!fir.logical<2>>>
|
||||
! CHECK: %[[EMBOX_3:.*]] = fir.embox %[[CONVERT_0]](%[[SHAPE_0]]) : (!fir.ref<!fir.array<?x!fir.logical<2>>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.logical<2>>>>
|
||||
! CHECK: fir.store %[[EMBOX_3]] to %[[DECLARE_3]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.logical<2>>>>>
|
||||
! CHECK: %[[EMBOX_4:.*]] = fir.embox %[[DECLARE_2]](%[[SHAPE_0]]) : (!fir.ref<!fir.array<2x!fir.logical<2>>>, !fir.shape<1>) -> !fir.box<!fir.array<2x!fir.logical<2>>>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_4]]) fastmath<contract> : (!fir.box<!fir.array<2x!fir.logical<2>>>) -> ()
|
||||
! CHECK: %[[LOAD_0:.*]] = fir.load %[[DECLARE_3]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.logical<2>>>>>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[LOAD_0]]) fastmath<contract> : (!fir.box<!fir.ptr<!fir.array<?x!fir.logical<2>>>>) -> ()
|
||||
! CHECK: return
|
||||
end subroutine test_logical
|
||||
|
||||
subroutine test_real
|
||||
! CHECK-LABEL: func.func @_QMtest_show_descriptorPtest_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(@_QMtest_show_descriptorFtest_realEhalf) : !fir.ref<f32>
|
||||
! CHECK: %[[DECLARE_5:.*]] = fir.declare %[[ADDRESS_OF_4]] {uniq_name = "_QMtest_show_descriptorFtest_realEhalf"} : (!fir.ref<f32>) -> !fir.ref<f32>
|
||||
! CHECK: %[[ADDRESS_OF_5:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_realErow) : !fir.ref<!fir.array<3xf32>>
|
||||
! CHECK: %[[SHAPE_2:.*]] = fir.shape %[[C3]] : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[DECLARE_6:.*]] = fir.declare %[[ADDRESS_OF_5]](%[[SHAPE_2]]) {uniq_name = "_QMtest_show_descriptorFtest_realErow"} : (!fir.ref<!fir.array<3xf32>>, !fir.shape<1>) -> !fir.ref<!fir.array<3xf32>>
|
||||
! CHECK: %[[ADDRESS_OF_6:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_realEw) : !fir.ref<!fir.array<4xf64>>
|
||||
! CHECK: %[[SHAPE_3:.*]] = fir.shape %[[C4]] : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[DECLARE_7:.*]] = fir.declare %[[ADDRESS_OF_6]](%[[SHAPE_3]]) {uniq_name = "_QMtest_show_descriptorFtest_realEw"} : (!fir.ref<!fir.array<4xf64>>, !fir.shape<1>) -> !fir.ref<!fir.array<4xf64>>
|
||||
|
||||
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<f32>) -> !fir.box<f32>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_7]]) fastmath<contract> : (!fir.box<f32>) -> ()
|
||||
! CHECK: %[[EMBOX_8:.*]] = fir.embox %[[DECLARE_6]](%[[SHAPE_2]]) : (!fir.ref<!fir.array<3xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<3xf32>>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_8]]) fastmath<contract> : (!fir.box<!fir.array<3xf32>>) -> ()
|
||||
! CHECK: %[[EMBOX_9:.*]] = fir.embox %[[DECLARE_7]](%[[SHAPE_3]]) : (!fir.ref<!fir.array<4xf64>>, !fir.shape<1>) -> !fir.box<!fir.array<4xf64>>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_9]]) fastmath<contract> : (!fir.box<!fir.array<4xf64>>) -> ()
|
||||
! 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.array<4xf64>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<2xf64>>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_10]]) fastmath<contract> : (!fir.box<!fir.array<2xf64>>) -> ()
|
||||
! CHECK: return
|
||||
end subroutine test_real
|
||||
|
||||
subroutine test_complex
|
||||
! CHECK-LABEL: func.func @_QMtest_show_descriptorPtest_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<f32>
|
||||
! CHECK: %[[ALLOCA_2:.*]] = fir.alloca complex<f32>
|
||||
! CHECK: %[[DUMMY_SCOPE_3:.*]] = fir.dummy_scope : !fir.dscope
|
||||
! CHECK: %[[ADDRESS_OF_7:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_complexEa2) : !fir.ref<!fir.array<2xcomplex<f32>>>
|
||||
! CHECK: %[[SHAPE_5:.*]] = fir.shape %[[C2]] : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[DECLARE_8:.*]] = fir.declare %[[ADDRESS_OF_7]](%[[SHAPE_5]]) {uniq_name = "_QMtest_show_descriptorFtest_complexEa2"} : (!fir.ref<!fir.array<2xcomplex<f32>>>, !fir.shape<1>) -> !fir.ref<!fir.array<2xcomplex<f32>>>
|
||||
! CHECK: %[[ADDRESS_OF_8:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_complexEc1) : !fir.ref<complex<f32>>
|
||||
! CHECK: %[[DECLARE_9:.*]] = fir.declare %[[ADDRESS_OF_8]] {uniq_name = "_QMtest_show_descriptorFtest_complexEc1"} : (!fir.ref<complex<f32>>) -> !fir.ref<complex<f32>>
|
||||
! CHECK: %[[ADDRESS_OF_9:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_complexEc2) : !fir.ref<complex<f32>>
|
||||
! CHECK: %[[DECLARE_10:.*]] = fir.declare %[[ADDRESS_OF_9]] {uniq_name = "_QMtest_show_descriptorFtest_complexEc2"} : (!fir.ref<complex<f32>>) -> !fir.ref<complex<f32>>
|
||||
! CHECK: %[[ADDRESS_OF_10:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_complexEChi) : !fir.ref<complex<f32>>
|
||||
! CHECK: %[[DECLARE_11:.*]] = fir.declare %[[ADDRESS_OF_10]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QMtest_show_descriptorFtest_complexEChi"} : (!fir.ref<complex<f32>>) -> !fir.ref<complex<f32>>
|
||||
! CHECK: %[[ADDRESS_OF_11:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_complexEChr) : !fir.ref<complex<f32>>
|
||||
! CHECK: %[[DECLARE_12:.*]] = fir.declare %[[ADDRESS_OF_11]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QMtest_show_descriptorFtest_complexEChr"} : (!fir.ref<complex<f32>>) -> !fir.ref<complex<f32>>
|
||||
! CHECK: %[[UNDEFINED_1:.*]] = fir.undefined complex<f32>
|
||||
! CHECK: %[[INSERT_VALUE_0:.*]] = fir.insert_value %[[UNDEFINED_1]], %[[CST_1]], [0 : index] : (complex<f32>, f32) -> complex<f32>
|
||||
! CHECK: %[[INSERT_VALUE_1:.*]] = fir.insert_value %[[INSERT_VALUE_0]], %[[CST_0]], [1 : index] : (complex<f32>, f32) -> complex<f32>
|
||||
! CHECK: fir.store %[[INSERT_VALUE_1]] to %[[ALLOCA_2]] : !fir.ref<complex<f32>>
|
||||
|
||||
call show_descriptor(hr)
|
||||
! CHECK: %[[EMBOX_11:.*]] = fir.embox %[[ALLOCA_2]] : (!fir.ref<complex<f32>>) -> !fir.box<complex<f32>>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_11]]) fastmath<contract> : (!fir.box<complex<f32>>) -> ()
|
||||
|
||||
call show_descriptor(hi)
|
||||
! CHECK: %[[INSERT_VALUE_2:.*]] = fir.insert_value %[[UNDEFINED_1]], %[[CST_0]], [0 : index] : (complex<f32>, f32) -> complex<f32>
|
||||
! CHECK: %[[INSERT_VALUE_3:.*]] = fir.insert_value %[[INSERT_VALUE_2]], %[[CST_1]], [1 : index] : (complex<f32>, f32) -> complex<f32>
|
||||
! CHECK: fir.store %[[INSERT_VALUE_3]] to %[[ALLOCA_1]] : !fir.ref<complex<f32>>
|
||||
! CHECK: %[[EMBOX_12:.*]] = fir.embox %[[ALLOCA_1]] : (!fir.ref<complex<f32>>) -> !fir.box<complex<f32>>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_12]]) fastmath<contract> : (!fir.box<complex<f32>>) -> ()
|
||||
|
||||
call show_descriptor(a2)
|
||||
! CHECK: %[[EMBOX_13:.*]] = fir.embox %[[DECLARE_8]](%[[SHAPE_5]]) : (!fir.ref<!fir.array<2xcomplex<f32>>>, !fir.shape<1>) -> !fir.box<!fir.array<2xcomplex<f32>>>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_13]]) fastmath<contract> : (!fir.box<!fir.array<2xcomplex<f32>>>) -> ()
|
||||
! CHECK: return
|
||||
end subroutine test_complex
|
||||
|
||||
subroutine test_derived
|
||||
! CHECK-LABEL: func.func @_QMtest_show_descriptorPtest_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(@_QMtest_show_descriptorFtest_derivedE.n.a) : !fir.ref<!fir.char<1>>
|
||||
! CHECK: %[[DECLARE_13:.*]] = fir.declare %[[ADDRESS_OF_12]] typeparams %[[C1]] {fortran_attrs = #fir.var_attrs<target>, uniq_name = "_QMtest_show_descriptorFtest_derivedE.n.a"} : (!fir.ref<!fir.char<1>>, index) -> !fir.ref<!fir.char<1>>
|
||||
! CHECK: %[[ADDRESS_OF_13:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_derivedE.n.b) : !fir.ref<!fir.char<1>>
|
||||
! CHECK: %[[DECLARE_14:.*]] = fir.declare %[[ADDRESS_OF_13]] typeparams %[[C1]] {fortran_attrs = #fir.var_attrs<target>, uniq_name = "_QMtest_show_descriptorFtest_derivedE.n.b"} : (!fir.ref<!fir.char<1>>, index) -> !fir.ref<!fir.char<1>>
|
||||
! CHECK: %[[ADDRESS_OF_14:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_derivedE.n.t1) : !fir.ref<!fir.char<1,2>>
|
||||
! CHECK: %[[DECLARE_15:.*]] = fir.declare %[[ADDRESS_OF_14]] typeparams %[[C2]] {fortran_attrs = #fir.var_attrs<target>, uniq_name = "_QMtest_show_descriptorFtest_derivedE.n.t1"} : (!fir.ref<!fir.char<1,2>>, index) -> !fir.ref<!fir.char<1,2>>
|
||||
! CHECK: %[[ADDRESS_OF_15:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_derivedE.n.c) : !fir.ref<!fir.char<1>>
|
||||
! CHECK: %[[DECLARE_16:.*]] = fir.declare %[[ADDRESS_OF_15]] typeparams %[[C1]] {fortran_attrs = #fir.var_attrs<target>, uniq_name = "_QMtest_show_descriptorFtest_derivedE.n.c"} : (!fir.ref<!fir.char<1>>, index) -> !fir.ref<!fir.char<1>>
|
||||
! CHECK: %[[ADDRESS_OF_16:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_derivedE.n.t2) : !fir.ref<!fir.char<1,2>>
|
||||
! CHECK: %[[DECLARE_17:.*]] = fir.declare %[[ADDRESS_OF_16]] typeparams %[[C2]] {fortran_attrs = #fir.var_attrs<target>, uniq_name = "_QMtest_show_descriptorFtest_derivedE.n.t2"} : (!fir.ref<!fir.char<1,2>>, index) -> !fir.ref<!fir.char<1,2>>
|
||||
! CHECK: %[[ADDRESS_OF_17:.*]] = fir.address_of(@_QMtest_show_descriptorFtest_derivedEvt2) : !fir.ref<!fir.type<_QMtest_show_descriptorFtest_derivedTt2{t1:!fir.type<_QMtest_show_descriptorFtest_derivedTt1{a:i32,b:i32}>,c:i32}>>
|
||||
! CHECK: %[[DECLARE_18:.*]] = fir.declare %[[ADDRESS_OF_17]] {uniq_name = "_QMtest_show_descriptorFtest_derivedEvt2"} : (!fir.ref<!fir.type<_QMtest_show_descriptorFtest_derivedTt2{t1:!fir.type<_QMtest_show_descriptorFtest_derivedTt1{a:i32,b:i32}>,c:i32}>>) -> !fir.ref<!fir.type<_QMtest_show_descriptorFtest_derivedTt2{t1:!fir.type<_QMtest_show_descriptorFtest_derivedTt1{a:i32,b:i32}>,c:i32}>>
|
||||
|
||||
call show_descriptor(vt2)
|
||||
! CHECK: %[[EMBOX_16:.*]] = fir.embox %[[DECLARE_18]] : (!fir.ref<!fir.type<_QMtest_show_descriptorFtest_derivedTt2{t1:!fir.type<_QMtest_show_descriptorFtest_derivedTt1{a:i32,b:i32}>,c:i32}>>) -> !fir.box<!fir.type<_QMtest_show_descriptorFtest_derivedTt2{t1:!fir.type<_QMtest_show_descriptorFtest_derivedTt1{a:i32,b:i32}>,c:i32}>>
|
||||
! CHECK: fir.call @_FortranAShowDescriptor(%[[EMBOX_16]]) fastmath<contract> : (!fir.box<!fir.type<_QMtest_show_descriptorFtest_derivedTt2{t1:!fir.type<_QMtest_show_descriptorFtest_derivedTt1{a:i32,b:i32}>,c:i32}>>) -> ()
|
||||
! CHECK: return
|
||||
end subroutine test_derived
|
||||
end module test_show_descriptor
|
||||
@ -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.
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user