Skip to content

Commit 9291487

Browse files
MeinersburMeinersbur
committed
Merge commit '4b2714f12f592ef3237056759dbe735d43fbeec1' into users/meinersbur/flang_builtin-mods_2
2 parents ba29454 + 4b2714f commit 9291487

File tree

15 files changed

+623
-7
lines changed

15 files changed

+623
-7
lines changed

‎flang-rt/include/flang-rt/runtime/descriptor.h‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -510,7 +510,9 @@ class Descriptor {
510510

511511
RT_API_ATTRS void Check() const;
512512

513-
void Dump(FILE * = stdout) const;
513+
// When dumpRawType, dumps stringified CFI_type_*, otherwise
514+
// try to canonicalize and print as a Fortran type.
515+
void Dump(FILE * = stdout, bool dumpRawType = true) const;
514516

515517
RT_API_ATTRS inline bool HasAddendum() const {
516518
return raw_.extra & _CFI_ADDENDUM_FLAG;

‎flang-rt/lib/runtime/CMakeLists.txt‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ set(intrinsics_sources
2222
set(module_sources
2323
__fortran_ieee_exceptions.f90
2424
__fortran_type_info.f90
25+
flang_debug.f90
2526
iso_fortran_env.f90
2627
ieee_arithmetic.f90
2728
ieee_exceptions.f90

‎flang-rt/lib/runtime/__fortran_builtins.f90‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,9 @@
2828
intrinsic :: __builtin_c_f_pointer
2929
public :: __builtin_c_f_pointer
3030

31+
intrinsic :: __builtin_show_descriptor
32+
public :: __builtin_show_descriptor
33+
3134
intrinsic :: sizeof ! extension
3235
public :: sizeof
3336

‎flang-rt/lib/runtime/descriptor.cpp‎

Lines changed: 152 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -292,14 +292,161 @@ RT_API_ATTRS void Descriptor::Check() const {
292292
// TODO
293293
}
294294

295-
void Descriptor::Dump(FILE *f) const {
295+
static const char *GetTypeStr(ISO::CFI_type_t type, bool dumpRawType) {
296+
if (dumpRawType) {
297+
#define CASE(x) \
298+
case (x): \
299+
return #x;
300+
switch (type) {
301+
CASE(CFI_type_signed_char)
302+
CASE(CFI_type_short)
303+
CASE(CFI_type_int)
304+
CASE(CFI_type_long)
305+
CASE(CFI_type_long_long)
306+
CASE(CFI_type_size_t)
307+
CASE(CFI_type_int8_t)
308+
CASE(CFI_type_int16_t)
309+
CASE(CFI_type_int32_t)
310+
CASE(CFI_type_int64_t)
311+
CASE(CFI_type_int128_t)
312+
CASE(CFI_type_int_least8_t)
313+
CASE(CFI_type_int_least16_t)
314+
CASE(CFI_type_int_least32_t)
315+
CASE(CFI_type_int_least64_t)
316+
CASE(CFI_type_int_least128_t)
317+
CASE(CFI_type_int_fast8_t)
318+
CASE(CFI_type_int_fast16_t)
319+
CASE(CFI_type_int_fast32_t)
320+
CASE(CFI_type_int_fast64_t)
321+
CASE(CFI_type_int_fast128_t)
322+
CASE(CFI_type_intmax_t)
323+
CASE(CFI_type_intptr_t)
324+
CASE(CFI_type_ptrdiff_t)
325+
CASE(CFI_type_half_float)
326+
CASE(CFI_type_bfloat)
327+
CASE(CFI_type_float)
328+
CASE(CFI_type_double)
329+
CASE(CFI_type_extended_double)
330+
CASE(CFI_type_long_double)
331+
CASE(CFI_type_float128)
332+
CASE(CFI_type_half_float_Complex)
333+
CASE(CFI_type_bfloat_Complex)
334+
CASE(CFI_type_float_Complex)
335+
CASE(CFI_type_double_Complex)
336+
CASE(CFI_type_extended_double_Complex)
337+
CASE(CFI_type_long_double_Complex)
338+
CASE(CFI_type_float128_Complex)
339+
CASE(CFI_type_Bool)
340+
CASE(CFI_type_char)
341+
CASE(CFI_type_cptr)
342+
CASE(CFI_type_struct)
343+
CASE(CFI_type_char16_t)
344+
CASE(CFI_type_char32_t)
345+
CASE(CFI_type_uint8_t)
346+
CASE(CFI_type_uint16_t)
347+
CASE(CFI_type_uint32_t)
348+
CASE(CFI_type_uint64_t)
349+
CASE(CFI_type_uint128_t)
350+
default:
351+
return nullptr;
352+
}
353+
#undef CASE
354+
}
355+
TypeCode code{type};
356+
if (!code.IsValid()) {
357+
return "invalid";
358+
}
359+
auto categoryAndKind{code.GetCategoryAndKind()};
360+
if (!categoryAndKind) {
361+
return nullptr;
362+
}
363+
TypeCategory tcat{categoryAndKind->first};
364+
int kind{categoryAndKind->second};
365+
366+
#define CASE(cat, k) \
367+
case (k): \
368+
return #cat "(kind=" #k ")";
369+
switch (tcat) {
370+
case TypeCategory::Integer:
371+
switch (kind) {
372+
CASE(INTEGER, 1)
373+
CASE(INTEGER, 2)
374+
CASE(INTEGER, 4)
375+
CASE(INTEGER, 8)
376+
CASE(INTEGER, 16)
377+
}
378+
break;
379+
case TypeCategory::Unsigned:
380+
switch (kind) {
381+
CASE(UNSIGNED, 1)
382+
CASE(UNSIGNED, 2)
383+
CASE(UNSIGNED, 4)
384+
CASE(UNSIGNED, 8)
385+
CASE(UNSIGNED, 16)
386+
}
387+
break;
388+
case TypeCategory::Real:
389+
switch (kind) {
390+
CASE(REAL, 2)
391+
CASE(REAL, 3)
392+
CASE(REAL, 4)
393+
CASE(REAL, 8)
394+
CASE(REAL, 10)
395+
CASE(REAL, 16)
396+
}
397+
break;
398+
case TypeCategory::Complex:
399+
switch (kind) {
400+
CASE(COMPLEX, 2)
401+
CASE(COMPLEX, 3)
402+
CASE(COMPLEX, 4)
403+
CASE(COMPLEX, 8)
404+
CASE(COMPLEX, 10)
405+
CASE(COMPLEX, 16)
406+
}
407+
break;
408+
case TypeCategory::Character:
409+
switch (kind) {
410+
CASE(CHARACTER, 1)
411+
CASE(CHARACTER, 2)
412+
CASE(CHARACTER, 4)
413+
}
414+
break;
415+
case TypeCategory::Logical:
416+
switch (kind) {
417+
CASE(LOGICAL, 1)
418+
CASE(LOGICAL, 2)
419+
CASE(LOGICAL, 4)
420+
CASE(LOGICAL, 8)
421+
}
422+
break;
423+
case TypeCategory::Derived:
424+
return "DERIVED";
425+
}
426+
#undef CASE
427+
return nullptr;
428+
}
429+
430+
void Descriptor::Dump(FILE *f, bool dumpRawType) const {
296431
std::fprintf(f, "Descriptor @ %p:\n", reinterpret_cast<const void *>(this));
297432
std::fprintf(f, " base_addr %p\n", raw_.base_addr);
298-
std::fprintf(f, " elem_len %zd\n", static_cast<std::size_t>(raw_.elem_len));
433+
std::fprintf(f, " elem_len %zd\n", ElementBytes());
299434
std::fprintf(f, " version %d\n", static_cast<int>(raw_.version));
300-
std::fprintf(f, " rank %d\n", static_cast<int>(raw_.rank));
301-
std::fprintf(f, " type %d\n", static_cast<int>(raw_.type));
302-
std::fprintf(f, " attribute %d\n", static_cast<int>(raw_.attribute));
435+
std::fprintf(f, " rank %d%s\n", rank(), rank() ? "" : " (scalar)");
436+
int ty{static_cast<int>(raw_.type)};
437+
if (const char *tyStr{GetTypeStr(raw_.type, dumpRawType)}) {
438+
std::fprintf(f, " type %d \"%s\"\n", ty, tyStr);
439+
} else {
440+
std::fprintf(f, " type %d\n", ty);
441+
}
442+
int attr{static_cast<int>(raw_.attribute)};
443+
if (IsPointer()) {
444+
std::fprintf(f, " attribute %d (pointer) \n", attr);
445+
} else if (IsAllocatable()) {
446+
std::fprintf(f, " attribute %d (allocatable)\n", attr);
447+
} else {
448+
std::fprintf(f, " attribute %d\n", attr);
449+
}
303450
std::fprintf(f, " extra %d\n", static_cast<int>(raw_.extra));
304451
std::fprintf(f, " addendum %d\n", static_cast<int>(HasAddendum()));
305452
std::fprintf(f, " alloc_idx %d\n", static_cast<int>(GetAllocIdx()));

‎flang-rt/lib/runtime/extensions.cpp‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -467,6 +467,14 @@ void FORTRAN_PROCEDURE_NAME(srand)(int *seed) {
467467
rand_seed_lock.Drop();
468468
}
469469

470+
void RTNAME(ShowDescriptor)(const Fortran::runtime::Descriptor *descr) {
471+
if (descr) {
472+
descr->Dump(stderr, /*dumpRawType=*/false);
473+
} else {
474+
std::fprintf(stderr, "NULL\n");
475+
}
476+
}
477+
470478
// Extension procedures related to I/O
471479

472480
namespace io {

‎flang-rt/lib/runtime/flang_debug.f90‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
!===-- module/flang_debug.f90 ----------------------------------------------===!
2+
!
3+
! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4+
! See https://llvm.org/LICENSE.txt for license information.
5+
! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6+
!
7+
!===------------------------------------------------------------------------===!
8+
9+
module flang_debug
10+
11+
use __fortran_builtins, only: &
12+
show_descriptor => __builtin_show_descriptor
13+
14+
end module flang_debug

‎flang-rt/unittests/Runtime/Descriptor.cpp‎

Lines changed: 122 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@
99
#include "flang-rt/runtime/descriptor.h"
1010
#include "tools.h"
1111
#include "gtest/gtest.h"
12+
#include <regex>
1213

1314
using namespace Fortran::runtime;
1415

@@ -158,3 +159,124 @@ TEST(Descriptor, FixedStride) {
158159
EXPECT_TRUE(descriptor.IsContiguous());
159160
EXPECT_EQ(descriptor.FixedStride().value_or(-666), 0);
160161
}
162+
163+
// The test below uses file operations that have nuances across multiple
164+
// platforms. Hence limit coverage by linux only unless wider coverage
165+
// should be required.
166+
#if defined(__linux__) && !defined(__ANDROID__)
167+
TEST(Descriptor, Dump) {
168+
StaticDescriptor<4> staticDesc[2];
169+
Descriptor &descriptor{staticDesc[0].descriptor()};
170+
using Type = std::int32_t;
171+
Type data[8][8][8];
172+
constexpr int four{static_cast<int>(sizeof data[0][0][0])};
173+
TypeCode integer{TypeCategory::Integer, four};
174+
// Scalar
175+
descriptor.Establish(integer, four, data, 0);
176+
FILE *tmpf{tmpfile()};
177+
ASSERT_TRUE(tmpf) << "tmpfile returned NULL";
178+
auto resetTmpFile = [tmpf]() {
179+
fflush(tmpf);
180+
rewind(tmpf);
181+
ftruncate(fileno(tmpf), 0);
182+
};
183+
184+
auto getAddrFilteredContent = [tmpf]() -> std::string {
185+
rewind(tmpf);
186+
std::ostringstream content;
187+
char buffer[1024];
188+
size_t bytes_read;
189+
while ((bytes_read = fread(buffer, 1, sizeof(buffer), tmpf)) > 0) {
190+
content.write(buffer, bytes_read);
191+
}
192+
193+
return std::regex_replace(
194+
std::regex_replace(content.str(), std::regex("Descriptor @.*:"),
195+
"Descriptor @ [addr]:"),
196+
std::regex("base_addr .*"), "base_addr [addr]");
197+
};
198+
199+
descriptor.Dump(tmpf, /*dumpRawType=*/false);
200+
// also dump as CFI type
201+
descriptor.Dump(tmpf, /*dumpRawType=*/true);
202+
std::string output{getAddrFilteredContent()};
203+
ASSERT_STREQ(output.c_str(),
204+
"Descriptor @ [addr]:\n"
205+
" base_addr [addr]\n"
206+
" elem_len 4\n"
207+
" version 20240719\n"
208+
" rank 0 (scalar)\n"
209+
" type 9 \"INTEGER(kind=4)\"\n"
210+
" attribute 0\n"
211+
" extra 0\n"
212+
" addendum 0\n"
213+
" alloc_idx 0\n"
214+
"Descriptor @ [addr]:\n"
215+
" base_addr [addr]\n"
216+
" elem_len 4\n"
217+
" version 20240719\n"
218+
" rank 0 (scalar)\n"
219+
" type 9 \"CFI_type_int32_t\"\n"
220+
" attribute 0\n"
221+
" extra 0\n"
222+
" addendum 0\n"
223+
" alloc_idx 0\n");
224+
225+
// Contiguous matrix (0:7, 0:7)
226+
SubscriptValue extent[3]{8, 8, 8};
227+
descriptor.Establish(integer, four, data, 2, extent);
228+
resetTmpFile();
229+
descriptor.Dump(tmpf, /*dumpRawType=*/false);
230+
output = getAddrFilteredContent();
231+
ASSERT_STREQ(output.c_str(),
232+
"Descriptor @ [addr]:\n"
233+
" base_addr [addr]\n"
234+
" elem_len 4\n"
235+
" version 20240719\n"
236+
" rank 2\n"
237+
" type 9 \"INTEGER(kind=4)\"\n"
238+
" attribute 0\n"
239+
" extra 0\n"
240+
" addendum 0\n"
241+
" alloc_idx 0\n"
242+
" dim[0] lower_bound 0\n"
243+
" extent 8\n"
244+
" sm 4\n"
245+
" dim[1] lower_bound 0\n"
246+
" extent 8\n"
247+
" sm 32\n");
248+
249+
TypeCode real{TypeCategory::Real, four};
250+
// Discontiguous real 3-D array (0:7, 0:6:2, 0:6:2)
251+
descriptor.Establish(real, four, data, 3, extent);
252+
descriptor.GetDimension(1).SetExtent(4);
253+
descriptor.GetDimension(1).SetByteStride(8 * 2 * four);
254+
descriptor.GetDimension(2).SetExtent(4);
255+
descriptor.GetDimension(2).SetByteStride(8 * 8 * 2 * four);
256+
257+
resetTmpFile();
258+
descriptor.Dump(tmpf, /*dumpRawType=*/false);
259+
output = getAddrFilteredContent();
260+
ASSERT_STREQ(output.c_str(),
261+
"Descriptor @ [addr]:\n"
262+
" base_addr [addr]\n"
263+
" elem_len 4\n"
264+
" version 20240719\n"
265+
" rank 3\n"
266+
" type 27 \"REAL(kind=4)\"\n"
267+
" attribute 0\n"
268+
" extra 0\n"
269+
" addendum 0\n"
270+
" alloc_idx 0\n"
271+
" dim[0] lower_bound 0\n"
272+
" extent 8\n"
273+
" sm 4\n"
274+
" dim[1] lower_bound 0\n"
275+
" extent 4\n"
276+
" sm 64\n"
277+
" dim[2] lower_bound 0\n"
278+
" extent 4\n"
279+
" sm 512\n");
280+
fclose(tmpf);
281+
}
282+
#endif // defined(__linux__) && !defined(__ANDROID__)

0 commit comments

Comments
 (0)