From af3b717b464bd0dc6bc4657f3f06573620f91df1 Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Wed, 11 Jun 2025 07:18:37 -0700 Subject: [PATCH] Revert "[flang][runtime] Another try to fix build failure" This reverts commit 13869cac2b5051e453aa96ad71220d9d33404620. Revert "[flang][runtime] Fix build bot flang-runtime-cuda-gcc errors (#143650)" This reverts commit d75e28477af0baa063a4d4cc7b3cf657cfadd758. Revert "[flang][runtime] Replace recursion with iterative work queue (#137727)" This reverts commit 163c67ad3d1bf7af6590930d8f18700d65ad4564. --- .../include/flang-rt/runtime/environment.h | 3 - flang-rt/include/flang-rt/runtime/stat.h | 10 +- flang-rt/include/flang-rt/runtime/type-info.h | 2 - .../include/flang-rt/runtime/work-queue.h | 552 --------------- flang-rt/lib/runtime/CMakeLists.txt | 2 - flang-rt/lib/runtime/assign.cpp | 623 ++++++----------- flang-rt/lib/runtime/derived.cpp | 517 +++++++------- flang-rt/lib/runtime/descriptor-io.cpp | 651 +----------------- flang-rt/lib/runtime/descriptor-io.h | 620 ++++++++++++++++- flang-rt/lib/runtime/environment.cpp | 4 - flang-rt/lib/runtime/namelist.cpp | 1 - flang-rt/lib/runtime/tools.cpp | 4 +- flang-rt/lib/runtime/type-info.cpp | 6 +- flang-rt/lib/runtime/work-queue.cpp | 161 ----- flang-rt/unittests/Runtime/ExternalIOTest.cpp | 2 +- flang/docs/Extensions.md | 10 - flang/include/flang/Runtime/assign.h | 2 +- flang/include/flang/Semantics/tools.h | 7 +- flang/lib/Semantics/runtime-type-info.cpp | 4 - flang/lib/Semantics/tools.cpp | 32 - flang/module/__fortran_type_info.f90 | 3 +- flang/test/Lower/volatile-openmp.f90 | 8 +- flang/test/Semantics/typeinfo01.f90 | 30 +- flang/test/Semantics/typeinfo03.f90 | 2 +- flang/test/Semantics/typeinfo04.f90 | 8 +- flang/test/Semantics/typeinfo05.f90 | 4 +- flang/test/Semantics/typeinfo06.f90 | 4 +- flang/test/Semantics/typeinfo07.f90 | 8 +- flang/test/Semantics/typeinfo08.f90 | 2 +- flang/test/Semantics/typeinfo11.f90 | 2 +- flang/test/Semantics/typeinfo12.f90 | 67 -- 31 files changed, 1120 insertions(+), 2231 deletions(-) delete mode 100644 flang-rt/include/flang-rt/runtime/work-queue.h delete mode 100644 flang-rt/lib/runtime/work-queue.cpp delete mode 100644 flang/test/Semantics/typeinfo12.f90 diff --git a/flang-rt/include/flang-rt/runtime/environment.h b/flang-rt/include/flang-rt/runtime/environment.h index e579f6012ce86..16258b3bbba9b 100644 --- a/flang-rt/include/flang-rt/runtime/environment.h +++ b/flang-rt/include/flang-rt/runtime/environment.h @@ -64,9 +64,6 @@ struct ExecutionEnvironment { bool defaultUTF8{false}; // DEFAULT_UTF8 bool checkPointerDeallocation{true}; // FORT_CHECK_POINTER_DEALLOCATION - enum InternalDebugging { WorkQueue = 1 }; - int internalDebugging{0}; // FLANG_RT_DEBUG - // CUDA related variables std::size_t cudaStackLimit{0}; // ACC_OFFLOAD_STACK_SIZE bool cudaDeviceIsManaged{false}; // NV_CUDAFOR_DEVICE_IS_MANAGED diff --git a/flang-rt/include/flang-rt/runtime/stat.h b/flang-rt/include/flang-rt/runtime/stat.h index dc372de53506a..070d0bf8673fb 100644 --- a/flang-rt/include/flang-rt/runtime/stat.h +++ b/flang-rt/include/flang-rt/runtime/stat.h @@ -24,7 +24,7 @@ class Terminator; enum Stat { StatOk = 0, // required to be zero by Fortran - // Interoperable STAT= codes (>= 11) + // Interoperable STAT= codes StatBaseNull = CFI_ERROR_BASE_ADDR_NULL, StatBaseNotNull = CFI_ERROR_BASE_ADDR_NOT_NULL, StatInvalidElemLen = CFI_INVALID_ELEM_LEN, @@ -36,7 +36,7 @@ enum Stat { StatMemAllocation = CFI_ERROR_MEM_ALLOCATION, StatOutOfBounds = CFI_ERROR_OUT_OF_BOUNDS, - // Standard STAT= values (>= 101) + // Standard STAT= values StatFailedImage = FORTRAN_RUNTIME_STAT_FAILED_IMAGE, StatLocked = FORTRAN_RUNTIME_STAT_LOCKED, StatLockedOtherImage = FORTRAN_RUNTIME_STAT_LOCKED_OTHER_IMAGE, @@ -49,14 +49,10 @@ enum Stat { // Additional "processor-defined" STAT= values StatInvalidArgumentNumber = FORTRAN_RUNTIME_STAT_INVALID_ARG_NUMBER, StatMissingArgument = FORTRAN_RUNTIME_STAT_MISSING_ARG, - StatValueTooShort = FORTRAN_RUNTIME_STAT_VALUE_TOO_SHORT, // -1 + StatValueTooShort = FORTRAN_RUNTIME_STAT_VALUE_TOO_SHORT, StatMoveAllocSameAllocatable = FORTRAN_RUNTIME_STAT_MOVE_ALLOC_SAME_ALLOCATABLE, StatBadPointerDeallocation = FORTRAN_RUNTIME_STAT_BAD_POINTER_DEALLOCATION, - - // Dummy status for work queue continuation, declared here to perhaps - // avoid collisions - StatContinue = 201 }; RT_API_ATTRS const char *StatErrorString(int); diff --git a/flang-rt/include/flang-rt/runtime/type-info.h b/flang-rt/include/flang-rt/runtime/type-info.h index 9bde3adba87f5..5e79efde164f2 100644 --- a/flang-rt/include/flang-rt/runtime/type-info.h +++ b/flang-rt/include/flang-rt/runtime/type-info.h @@ -240,7 +240,6 @@ class DerivedType { RT_API_ATTRS bool noFinalizationNeeded() const { return noFinalizationNeeded_; } - RT_API_ATTRS bool noDefinedAssignment() const { return noDefinedAssignment_; } RT_API_ATTRS std::size_t LenParameters() const { return lenParameterKind().Elements(); @@ -323,7 +322,6 @@ class DerivedType { bool noInitializationNeeded_{false}; bool noDestructionNeeded_{false}; bool noFinalizationNeeded_{false}; - bool noDefinedAssignment_{false}; }; } // namespace Fortran::runtime::typeInfo diff --git a/flang-rt/include/flang-rt/runtime/work-queue.h b/flang-rt/include/flang-rt/runtime/work-queue.h deleted file mode 100644 index f8cc820c06ca1..0000000000000 --- a/flang-rt/include/flang-rt/runtime/work-queue.h +++ /dev/null @@ -1,552 +0,0 @@ -//===-- include/flang-rt/runtime/work-queue.h -------------------*- C++ -*-===// -// -// 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 -// -//===----------------------------------------------------------------------===// - -// Internal runtime utilities for work queues that replace the use of recursion -// for better GPU device support. -// -// A work queue comprises a list of tickets. Each ticket class has a Begin() -// member function, which is called once, and a Continue() member function -// that can be called zero or more times. A ticket's execution terminates -// when either of these member functions returns a status other than -// StatContinue. When that status is not StatOk, then the whole queue -// is shut down. -// -// By returning StatContinue from its Continue() member function, -// a ticket suspends its execution so that any nested tickets that it -// may have created can be run to completion. It is the reponsibility -// of each ticket class to maintain resumption information in its state -// and manage its own progress. Most ticket classes inherit from -// class ComponentsOverElements, which implements an outer loop over all -// components of a derived type, and an inner loop over all elements -// of a descriptor, possibly with multiple phases of execution per element. -// -// Tickets are created by WorkQueue::Begin...() member functions. -// There is one of these for each "top level" recursive function in the -// Fortran runtime support library that has been restructured into this -// ticket framework. -// -// When the work queue is running tickets, it always selects the last ticket -// on the list for execution -- "work stack" might have been a more accurate -// name for this framework. This ticket may, while doing its job, create -// new tickets, and since those are pushed after the active one, the first -// such nested ticket will be the next one executed to completion -- i.e., -// the order of nested WorkQueue::Begin...() calls is respected. -// Note that a ticket's Continue() member function won't be called again -// until all nested tickets have run to completion and it is once again -// the last ticket on the queue. -// -// Example for an assignment to a derived type: -// 1. Assign() is called, and its work queue is created. It calls -// WorkQueue::BeginAssign() and then WorkQueue::Run(). -// 2. Run calls AssignTicket::Begin(), which pushes a tickets via -// BeginFinalize() and returns StatContinue. -// 3. FinalizeTicket::Begin() and FinalizeTicket::Continue() are called -// until one of them returns StatOk, which ends the finalization ticket. -// 4. AssignTicket::Continue() is then called; it creates a DerivedAssignTicket -// and then returns StatOk, which ends the ticket. -// 5. At this point, only one ticket remains. DerivedAssignTicket::Begin() -// and ::Continue() are called until they are done (not StatContinue). -// Along the way, it may create nested AssignTickets for components, -// and suspend itself so that they may each run to completion. - -#ifndef FLANG_RT_RUNTIME_WORK_QUEUE_H_ -#define FLANG_RT_RUNTIME_WORK_QUEUE_H_ - -#include "flang-rt/runtime/connection.h" -#include "flang-rt/runtime/descriptor.h" -#include "flang-rt/runtime/stat.h" -#include "flang-rt/runtime/type-info.h" -#include "flang/Common/api-attrs.h" -#include "flang/Runtime/freestanding-tools.h" -#include - -namespace Fortran::runtime::io { -class IoStatementState; -struct NonTbpDefinedIoTable; -} // namespace Fortran::runtime::io - -namespace Fortran::runtime { -class Terminator; -class WorkQueue; - -// Ticket worker base classes - -template class ImmediateTicketRunner { -public: - RT_API_ATTRS explicit ImmediateTicketRunner(TICKET &ticket) - : ticket_{ticket} {} - RT_API_ATTRS int Run(WorkQueue &workQueue) { - int status{ticket_.Begin(workQueue)}; - while (status == StatContinue) { - status = ticket_.Continue(workQueue); - } - return status; - } - -private: - TICKET &ticket_; -}; - -// Base class for ticket workers that operate elementwise over descriptors -class Elementwise { -public: - RT_API_ATTRS Elementwise( - const Descriptor &instance, const Descriptor *from = nullptr) - : instance_{instance}, from_{from} { - instance_.GetLowerBounds(subscripts_); - if (from_) { - from_->GetLowerBounds(fromSubscripts_); - } - } - RT_API_ATTRS bool IsComplete() const { return elementAt_ >= elements_; } - RT_API_ATTRS void Advance() { - ++elementAt_; - instance_.IncrementSubscripts(subscripts_); - if (from_) { - from_->IncrementSubscripts(fromSubscripts_); - } - } - RT_API_ATTRS void SkipToEnd() { elementAt_ = elements_; } - RT_API_ATTRS void Reset() { - elementAt_ = 0; - instance_.GetLowerBounds(subscripts_); - if (from_) { - from_->GetLowerBounds(fromSubscripts_); - } - } - -protected: - const Descriptor &instance_, *from_{nullptr}; - std::size_t elements_{instance_.Elements()}; - std::size_t elementAt_{0}; - SubscriptValue subscripts_[common::maxRank]; - SubscriptValue fromSubscripts_[common::maxRank]; -}; - -// Base class for ticket workers that operate over derived type components. -class Componentwise { -public: - RT_API_ATTRS Componentwise(const typeInfo::DerivedType &); - RT_API_ATTRS bool IsComplete() const { return componentAt_ >= components_; } - RT_API_ATTRS void Advance() { - ++componentAt_; - GetComponent(); - } - RT_API_ATTRS void SkipToEnd() { - component_ = nullptr; - componentAt_ = components_; - } - RT_API_ATTRS void Reset() { - component_ = nullptr; - componentAt_ = 0; - GetComponent(); - } - RT_API_ATTRS void GetComponent(); - -protected: - const typeInfo::DerivedType &derived_; - std::size_t components_{0}, componentAt_{0}; - const typeInfo::Component *component_{nullptr}; - StaticDescriptor componentDescriptor_; -}; - -// Base class for ticket workers that operate over derived type components -// in an outer loop, and elements in an inner loop. -class ComponentsOverElements : public Componentwise, public Elementwise { -public: - RT_API_ATTRS ComponentsOverElements(const Descriptor &instance, - const typeInfo::DerivedType &derived, const Descriptor *from = nullptr) - : Componentwise{derived}, Elementwise{instance, from} { - if (Elementwise::IsComplete()) { - Componentwise::SkipToEnd(); - } - } - RT_API_ATTRS bool IsComplete() const { return Componentwise::IsComplete(); } - RT_API_ATTRS void Advance() { - SkipToNextElement(); - if (Elementwise::IsComplete()) { - Elementwise::Reset(); - Componentwise::Advance(); - } - } - RT_API_ATTRS void SkipToNextElement() { - phase_ = 0; - Elementwise::Advance(); - } - RT_API_ATTRS void SkipToNextComponent() { - phase_ = 0; - Elementwise::Reset(); - Componentwise::Advance(); - } - RT_API_ATTRS void Reset() { - phase_ = 0; - Elementwise::Reset(); - Componentwise::Reset(); - } - -protected: - int phase_{0}; -}; - -// Base class for ticket workers that operate over elements in an outer loop, -// type components in an inner loop. -class ElementsOverComponents : public Elementwise, public Componentwise { -public: - RT_API_ATTRS ElementsOverComponents(const Descriptor &instance, - const typeInfo::DerivedType &derived, const Descriptor *from = nullptr) - : Elementwise{instance, from}, Componentwise{derived} { - if (Componentwise::IsComplete()) { - Elementwise::SkipToEnd(); - } - } - RT_API_ATTRS bool IsComplete() const { return Elementwise::IsComplete(); } - RT_API_ATTRS void Advance() { - SkipToNextComponent(); - if (Componentwise::IsComplete()) { - Componentwise::Reset(); - Elementwise::Advance(); - } - } - RT_API_ATTRS void SkipToNextComponent() { - phase_ = 0; - Componentwise::Advance(); - } - RT_API_ATTRS void SkipToNextElement() { - phase_ = 0; - Componentwise::Reset(); - Elementwise::Advance(); - } - -protected: - int phase_{0}; -}; - -// Ticket worker classes - -// Implements derived type instance initialization -class InitializeTicket : public ImmediateTicketRunner, - private ComponentsOverElements { -public: - RT_API_ATTRS InitializeTicket( - const Descriptor &instance, const typeInfo::DerivedType &derived) - : ImmediateTicketRunner{*this}, - ComponentsOverElements{instance, derived} {} - RT_API_ATTRS int Begin(WorkQueue &); - RT_API_ATTRS int Continue(WorkQueue &); -}; - -// Initializes one derived type instance from the value of another -class InitializeCloneTicket - : public ImmediateTicketRunner, - private ComponentsOverElements { -public: - RT_API_ATTRS InitializeCloneTicket(const Descriptor &clone, - const Descriptor &original, const typeInfo::DerivedType &derived, - bool hasStat, const Descriptor *errMsg) - : ImmediateTicketRunner{*this}, - ComponentsOverElements{original, derived}, clone_{clone}, - hasStat_{hasStat}, errMsg_{errMsg} {} - RT_API_ATTRS int Begin(WorkQueue &) { return StatContinue; } - RT_API_ATTRS int Continue(WorkQueue &); - -private: - const Descriptor &clone_; - bool hasStat_{false}; - const Descriptor *errMsg_{nullptr}; - StaticDescriptor cloneComponentDescriptor_; -}; - -// Implements derived type instance finalization -class FinalizeTicket : public ImmediateTicketRunner, - private ComponentsOverElements { -public: - RT_API_ATTRS FinalizeTicket( - const Descriptor &instance, const typeInfo::DerivedType &derived) - : ImmediateTicketRunner{*this}, - ComponentsOverElements{instance, derived} {} - RT_API_ATTRS int Begin(WorkQueue &); - RT_API_ATTRS int Continue(WorkQueue &); - -private: - const typeInfo::DerivedType *finalizableParentType_{nullptr}; -}; - -// Implements derived type instance destruction -class DestroyTicket : public ImmediateTicketRunner, - private ComponentsOverElements { -public: - RT_API_ATTRS DestroyTicket(const Descriptor &instance, - const typeInfo::DerivedType &derived, bool finalize) - : ImmediateTicketRunner{*this}, - ComponentsOverElements{instance, derived}, finalize_{finalize} {} - RT_API_ATTRS int Begin(WorkQueue &); - RT_API_ATTRS int Continue(WorkQueue &); - -private: - bool finalize_{false}; -}; - -// Implements general intrinsic assignment -class AssignTicket : public ImmediateTicketRunner { -public: - RT_API_ATTRS AssignTicket( - Descriptor &to, const Descriptor &from, int flags, MemmoveFct memmoveFct) - : ImmediateTicketRunner{*this}, to_{to}, from_{&from}, - flags_{flags}, memmoveFct_{memmoveFct} {} - RT_API_ATTRS int Begin(WorkQueue &); - RT_API_ATTRS int Continue(WorkQueue &); - -private: - RT_API_ATTRS bool IsSimpleMemmove() const { - return !toDerived_ && to_.rank() == from_->rank() && to_.IsContiguous() && - from_->IsContiguous() && to_.ElementBytes() == from_->ElementBytes(); - } - RT_API_ATTRS Descriptor &GetTempDescriptor(); - - Descriptor &to_; - const Descriptor *from_{nullptr}; - int flags_{0}; // enum AssignFlags - MemmoveFct memmoveFct_{nullptr}; - StaticDescriptor tempDescriptor_; - const typeInfo::DerivedType *toDerived_{nullptr}; - Descriptor *toDeallocate_{nullptr}; - bool persist_{false}; - bool done_{false}; -}; - -// Implements derived type intrinsic assignment. -template -class DerivedAssignTicket - : public ImmediateTicketRunner>, - private std::conditional_t { -public: - using Base = std::conditional_t; - RT_API_ATTRS DerivedAssignTicket(const Descriptor &to, const Descriptor &from, - const typeInfo::DerivedType &derived, int flags, MemmoveFct memmoveFct, - Descriptor *deallocateAfter) - : ImmediateTicketRunner{*this}, - Base{to, derived, &from}, flags_{flags}, memmoveFct_{memmoveFct}, - deallocateAfter_{deallocateAfter} {} - RT_API_ATTRS int Begin(WorkQueue &); - RT_API_ATTRS int Continue(WorkQueue &); - -private: - static constexpr bool isComponentwise_{IS_COMPONENTWISE}; - bool toIsContiguous_{this->instance_.IsContiguous()}; - bool fromIsContiguous_{this->from_->IsContiguous()}; - int flags_{0}; - MemmoveFct memmoveFct_{nullptr}; - Descriptor *deallocateAfter_{nullptr}; - StaticDescriptor fromComponentDescriptor_; -}; - -namespace io::descr { - -template -class DescriptorIoTicket - : public ImmediateTicketRunner>, - private Elementwise { -public: - RT_API_ATTRS DescriptorIoTicket(io::IoStatementState &io, - const Descriptor &descriptor, const io::NonTbpDefinedIoTable *table, - bool &anyIoTookPlace) - : ImmediateTicketRunner(*this), - Elementwise{descriptor}, io_{io}, table_{table}, - anyIoTookPlace_{anyIoTookPlace} {} - RT_API_ATTRS int Begin(WorkQueue &); - RT_API_ATTRS int Continue(WorkQueue &); - RT_API_ATTRS bool &anyIoTookPlace() { return anyIoTookPlace_; } - -private: - io::IoStatementState &io_; - const io::NonTbpDefinedIoTable *table_{nullptr}; - bool &anyIoTookPlace_; - common::optional nonTbpSpecial_; - const typeInfo::DerivedType *derived_{nullptr}; - const typeInfo::SpecialBinding *special_{nullptr}; - StaticDescriptor elementDescriptor_; -}; - -template -class DerivedIoTicket : public ImmediateTicketRunner>, - private ElementsOverComponents { -public: - RT_API_ATTRS DerivedIoTicket(io::IoStatementState &io, - const Descriptor &descriptor, const typeInfo::DerivedType &derived, - const io::NonTbpDefinedIoTable *table, bool &anyIoTookPlace) - : ImmediateTicketRunner(*this), - ElementsOverComponents{descriptor, derived}, io_{io}, table_{table}, - anyIoTookPlace_{anyIoTookPlace} {} - RT_API_ATTRS int Begin(WorkQueue &) { return StatContinue; } - RT_API_ATTRS int Continue(WorkQueue &); - -private: - io::IoStatementState &io_; - const io::NonTbpDefinedIoTable *table_{nullptr}; - bool &anyIoTookPlace_; -}; - -} // namespace io::descr - -struct NullTicket { - RT_API_ATTRS int Begin(WorkQueue &) const { return StatOk; } - RT_API_ATTRS int Continue(WorkQueue &) const { return StatOk; } -}; - -struct Ticket { - RT_API_ATTRS int Continue(WorkQueue &); - bool begun{false}; - std::variant, - DerivedAssignTicket, - io::descr::DescriptorIoTicket, - io::descr::DescriptorIoTicket, - io::descr::DerivedIoTicket, - io::descr::DerivedIoTicket> - u; -}; - -class WorkQueue { -public: - RT_API_ATTRS explicit WorkQueue(Terminator &terminator) - : terminator_{terminator} { - for (int j{1}; j < numStatic_; ++j) { - static_[j].previous = &static_[j - 1]; - static_[j - 1].next = &static_[j]; - } - } - RT_API_ATTRS ~WorkQueue(); - RT_API_ATTRS Terminator &terminator() { return terminator_; }; - - // APIs for particular tasks. These can return StatOk if the work is - // completed immediately. - RT_API_ATTRS int BeginInitialize( - const Descriptor &descriptor, const typeInfo::DerivedType &derived) { - if (runTicketsImmediately_) { - return InitializeTicket{descriptor, derived}.Run(*this); - } else { - StartTicket().u.emplace(descriptor, derived); - return StatContinue; - } - } - RT_API_ATTRS int BeginInitializeClone(const Descriptor &clone, - const Descriptor &original, const typeInfo::DerivedType &derived, - bool hasStat, const Descriptor *errMsg) { - if (runTicketsImmediately_) { - return InitializeCloneTicket{clone, original, derived, hasStat, errMsg} - .Run(*this); - } else { - StartTicket().u.emplace( - clone, original, derived, hasStat, errMsg); - return StatContinue; - } - } - RT_API_ATTRS int BeginFinalize( - const Descriptor &descriptor, const typeInfo::DerivedType &derived) { - if (runTicketsImmediately_) { - return FinalizeTicket{descriptor, derived}.Run(*this); - } else { - StartTicket().u.emplace(descriptor, derived); - return StatContinue; - } - } - RT_API_ATTRS int BeginDestroy(const Descriptor &descriptor, - const typeInfo::DerivedType &derived, bool finalize) { - if (runTicketsImmediately_) { - return DestroyTicket{descriptor, derived, finalize}.Run(*this); - } else { - StartTicket().u.emplace(descriptor, derived, finalize); - return StatContinue; - } - } - RT_API_ATTRS int BeginAssign(Descriptor &to, const Descriptor &from, - int flags, MemmoveFct memmoveFct) { - if (runTicketsImmediately_) { - return AssignTicket{to, from, flags, memmoveFct}.Run(*this); - } else { - StartTicket().u.emplace(to, from, flags, memmoveFct); - return StatContinue; - } - } - template - RT_API_ATTRS int BeginDerivedAssign(Descriptor &to, const Descriptor &from, - const typeInfo::DerivedType &derived, int flags, MemmoveFct memmoveFct, - Descriptor *deallocateAfter) { - if (runTicketsImmediately_) { - return DerivedAssignTicket{ - to, from, derived, flags, memmoveFct, deallocateAfter} - .Run(*this); - } else { - StartTicket().u.emplace>( - to, from, derived, flags, memmoveFct, deallocateAfter); - return StatContinue; - } - } - template - RT_API_ATTRS int BeginDescriptorIo(io::IoStatementState &io, - const Descriptor &descriptor, const io::NonTbpDefinedIoTable *table, - bool &anyIoTookPlace) { - if (runTicketsImmediately_) { - return io::descr::DescriptorIoTicket{ - io, descriptor, table, anyIoTookPlace} - .Run(*this); - } else { - StartTicket().u.emplace>( - io, descriptor, table, anyIoTookPlace); - return StatContinue; - } - } - template - RT_API_ATTRS int BeginDerivedIo(io::IoStatementState &io, - const Descriptor &descriptor, const typeInfo::DerivedType &derived, - const io::NonTbpDefinedIoTable *table, bool &anyIoTookPlace) { - if (runTicketsImmediately_) { - return io::descr::DerivedIoTicket{ - io, descriptor, derived, table, anyIoTookPlace} - .Run(*this); - } else { - StartTicket().u.emplace>( - io, descriptor, derived, table, anyIoTookPlace); - return StatContinue; - } - } - - RT_API_ATTRS int Run(); - -private: -#if RT_DEVICE_COMPILATION - // Always use the work queue on a GPU device to avoid recursion. - static constexpr bool runTicketsImmediately_{false}; -#else - // Avoid the work queue overhead on the host, unless it needs - // debugging, which is so much easier there. - static constexpr bool runTicketsImmediately_{true}; -#endif - - // Most uses of the work queue won't go very deep. - static constexpr int numStatic_{2}; - - struct TicketList { - bool isStatic{true}; - Ticket ticket; - TicketList *previous{nullptr}, *next{nullptr}; - }; - - RT_API_ATTRS Ticket &StartTicket(); - RT_API_ATTRS void Stop(); - - Terminator &terminator_; - TicketList *first_{nullptr}, *last_{nullptr}, *insertAfter_{nullptr}; - TicketList static_[numStatic_]; - TicketList *firstFree_{static_}; -}; - -} // namespace Fortran::runtime -#endif // FLANG_RT_RUNTIME_WORK_QUEUE_H_ diff --git a/flang-rt/lib/runtime/CMakeLists.txt b/flang-rt/lib/runtime/CMakeLists.txt index 332c0872e065f..a3f63b4315644 100644 --- a/flang-rt/lib/runtime/CMakeLists.txt +++ b/flang-rt/lib/runtime/CMakeLists.txt @@ -68,7 +68,6 @@ set(supported_sources type-info.cpp unit.cpp utf.cpp - work-queue.cpp ) # List of source not used for GPU offloading. @@ -132,7 +131,6 @@ set(gpu_sources type-code.cpp type-info.cpp utf.cpp - work-queue.cpp complex-powi.cpp reduce.cpp reduction.cpp diff --git a/flang-rt/lib/runtime/assign.cpp b/flang-rt/lib/runtime/assign.cpp index 41b130cc8f257..bf67b5dc8b645 100644 --- a/flang-rt/lib/runtime/assign.cpp +++ b/flang-rt/lib/runtime/assign.cpp @@ -14,7 +14,6 @@ #include "flang-rt/runtime/terminator.h" #include "flang-rt/runtime/tools.h" #include "flang-rt/runtime/type-info.h" -#include "flang-rt/runtime/work-queue.h" namespace Fortran::runtime { @@ -103,7 +102,11 @@ static RT_API_ATTRS int AllocateAssignmentLHS( toDim.SetByteStride(stride); stride *= toDim.Extent(); } - return ReturnError(terminator, to.Allocate(kNoAsyncObject)); + int result{ReturnError(terminator, to.Allocate(kNoAsyncObject))}; + if (result == StatOk && derived && !derived->noInitializationNeeded()) { + result = ReturnError(terminator, Initialize(to, *derived, terminator)); + } + return result; } // least <= 0, most >= 0 @@ -228,8 +231,6 @@ static RT_API_ATTRS void BlankPadCharacterAssignment(Descriptor &to, } } -RT_OFFLOAD_API_GROUP_BEGIN - // Common implementation of assignments, both intrinsic assignments and // those cases of polymorphic user-defined ASSIGNMENT(=) TBPs that could not // be resolved in semantics. Most assignment statements do not need any @@ -243,453 +244,275 @@ RT_OFFLOAD_API_GROUP_BEGIN // dealing with array constructors. RT_API_ATTRS void Assign(Descriptor &to, const Descriptor &from, Terminator &terminator, int flags, MemmoveFct memmoveFct) { - WorkQueue workQueue{terminator}; - if (workQueue.BeginAssign(to, from, flags, memmoveFct) == StatContinue) { - workQueue.Run(); - } -} - -RT_API_ATTRS int AssignTicket::Begin(WorkQueue &workQueue) { - bool mustDeallocateLHS{(flags_ & DeallocateLHS) || - MustDeallocateLHS(to_, *from_, workQueue.terminator(), flags_)}; - DescriptorAddendum *toAddendum{to_.Addendum()}; - toDerived_ = toAddendum ? toAddendum->derivedType() : nullptr; - if (toDerived_ && (flags_ & NeedFinalization) && - toDerived_->noFinalizationNeeded()) { - flags_ &= ~NeedFinalization; - } - if (MayAlias(to_, *from_)) { + bool mustDeallocateLHS{(flags & DeallocateLHS) || + MustDeallocateLHS(to, from, terminator, flags)}; + DescriptorAddendum *toAddendum{to.Addendum()}; + const typeInfo::DerivedType *toDerived{ + toAddendum ? toAddendum->derivedType() : nullptr}; + if (toDerived && (flags & NeedFinalization) && + toDerived->noFinalizationNeeded()) { + flags &= ~NeedFinalization; + } + std::size_t toElementBytes{to.ElementBytes()}; + std::size_t fromElementBytes{from.ElementBytes()}; + // The following lambda definition violates the conding style, + // but cuda-11.8 nvcc hits an internal error with the brace initialization. + auto isSimpleMemmove = [&]() { + return !toDerived && to.rank() == from.rank() && to.IsContiguous() && + from.IsContiguous() && toElementBytes == fromElementBytes; + }; + StaticDescriptor deferredDeallocStatDesc; + Descriptor *deferDeallocation{nullptr}; + if (MayAlias(to, from)) { if (mustDeallocateLHS) { - // Convert the LHS into a temporary, then make it look deallocated. - toDeallocate_ = &tempDescriptor_.descriptor(); - persist_ = true; // tempDescriptor_ state must outlive child tickets + deferDeallocation = &deferredDeallocStatDesc.descriptor(); std::memcpy( - reinterpret_cast(toDeallocate_), &to_, to_.SizeInBytes()); - to_.set_base_addr(nullptr); - if (toDerived_ && (flags_ & NeedFinalization)) { - if (int status{workQueue.BeginFinalize(*toDeallocate_, *toDerived_)}; - status != StatOk && status != StatContinue) { - return status; - } - flags_ &= ~NeedFinalization; - } - } else if (!IsSimpleMemmove()) { + reinterpret_cast(deferDeallocation), &to, to.SizeInBytes()); + to.set_base_addr(nullptr); + } else if (!isSimpleMemmove()) { // Handle LHS/RHS aliasing by copying RHS into a temp, then // recursively assigning from that temp. - auto descBytes{from_->SizeInBytes()}; - Descriptor &newFrom{tempDescriptor_.descriptor()}; - persist_ = true; // tempDescriptor_ state must outlive child tickets - std::memcpy(reinterpret_cast(&newFrom), from_, descBytes); + auto descBytes{from.SizeInBytes()}; + StaticDescriptor staticDesc; + Descriptor &newFrom{staticDesc.descriptor()}; + std::memcpy(reinterpret_cast(&newFrom), &from, descBytes); // Pretend the temporary descriptor is for an ALLOCATABLE // entity, otherwise, the Deallocate() below will not // free the descriptor memory. newFrom.raw().attribute = CFI_attribute_allocatable; - if (int stat{ReturnError( - workQueue.terminator(), newFrom.Allocate(kNoAsyncObject))}; - stat != StatOk) { - return stat; - } - if (HasDynamicComponent(*from_)) { - // If 'from' has allocatable/automatic component, we cannot - // just make a shallow copy of the descriptor member. - // This will still leave data overlap in 'to' and 'newFrom'. - // For example: - // type t - // character, allocatable :: c(:) - // end type t - // type(t) :: x(3) - // x(2:3) = x(1:2) - // We have to make a deep copy into 'newFrom' in this case. - if (const DescriptorAddendum *addendum{newFrom.Addendum()}) { - if (const auto *derived{addendum->derivedType()}) { - if (!derived->noInitializationNeeded()) { - if (int status{workQueue.BeginInitialize(newFrom, *derived)}; - status != StatOk && status != StatContinue) { - return status; - } - } - } - } - static constexpr int nestedFlags{MaybeReallocate | PolymorphicLHS}; - if (int status{workQueue.BeginAssign( - newFrom, *from_, nestedFlags, memmoveFct_)}; - status != StatOk && status != StatContinue) { - return status; + auto stat{ReturnError(terminator, newFrom.Allocate(kNoAsyncObject))}; + if (stat == StatOk) { + if (HasDynamicComponent(from)) { + // If 'from' has allocatable/automatic component, we cannot + // just make a shallow copy of the descriptor member. + // This will still leave data overlap in 'to' and 'newFrom'. + // For example: + // type t + // character, allocatable :: c(:) + // end type t + // type(t) :: x(3) + // x(2:3) = x(1:2) + // We have to make a deep copy into 'newFrom' in this case. + RTNAME(AssignTemporary) + (newFrom, from, terminator.sourceFileName(), terminator.sourceLine()); + } else { + ShallowCopy(newFrom, from, true, from.IsContiguous()); } - } else { - ShallowCopy(newFrom, *from_, true, from_->IsContiguous()); + Assign(to, newFrom, terminator, + flags & + (NeedFinalization | ComponentCanBeDefinedAssignment | + ExplicitLengthCharacterLHS | CanBeDefinedAssignment)); + newFrom.Deallocate(); } - from_ = &newFrom; - flags_ &= NeedFinalization | ComponentCanBeDefinedAssignment | - ExplicitLengthCharacterLHS | CanBeDefinedAssignment; - toDeallocate_ = &newFrom; + return; } } - if (to_.IsAllocatable()) { + if (to.IsAllocatable()) { if (mustDeallocateLHS) { - if (!toDeallocate_ && to_.IsAllocated()) { - toDeallocate_ = &to_; + if (deferDeallocation) { + if ((flags & NeedFinalization) && toDerived) { + Finalize(*deferDeallocation, *toDerived, &terminator); + flags &= ~NeedFinalization; + } + } else { + to.Destroy((flags & NeedFinalization) != 0, /*destroyPointers=*/false, + &terminator); + flags &= ~NeedFinalization; } - } else if (to_.rank() != from_->rank() && !to_.IsAllocated()) { - workQueue.terminator().Crash("Assign: mismatched ranks (%d != %d) in " - "assignment to unallocated allocatable", - to_.rank(), from_->rank()); + } else if (to.rank() != from.rank() && !to.IsAllocated()) { + terminator.Crash("Assign: mismatched ranks (%d != %d) in assignment to " + "unallocated allocatable", + to.rank(), from.rank()); } - } else if (!to_.IsAllocated()) { - workQueue.terminator().Crash( - "Assign: left-hand side variable is neither allocated nor allocatable"); - } - if (toDerived_ && to_.IsAllocated()) { - // Schedule finalization or destruction of the LHS. - if (flags_ & NeedFinalization) { - if (int status{workQueue.BeginFinalize(to_, *toDerived_)}; - status != StatOk && status != StatContinue) { - return status; - } - } else if (!toDerived_->noDestructionNeeded()) { - if (int status{ - workQueue.BeginDestroy(to_, *toDerived_, /*finalize=*/false)}; - status != StatOk && status != StatContinue) { - return status; + if (!to.IsAllocated()) { + if (AllocateAssignmentLHS(to, from, terminator, flags) != StatOk) { + return; } + flags &= ~NeedFinalization; + toElementBytes = to.ElementBytes(); // may have changed + toDerived = toAddendum ? toAddendum->derivedType() : nullptr; } } - return StatContinue; -} - -RT_API_ATTRS int AssignTicket::Continue(WorkQueue &workQueue) { - if (done_) { - // All child tickets are complete; can release this ticket's state. - if (toDeallocate_) { - toDeallocate_->Deallocate(); - } - return StatOk; - } - // All necessary finalization or destruction that was initiated by Begin() - // has been completed. Deallocation may be pending, and if it's for the LHS, - // do it now so that the LHS gets reallocated. - if (toDeallocate_ == &to_) { - toDeallocate_ = nullptr; - to_.Deallocate(); - } - // Allocate the LHS if needed - if (!to_.IsAllocated()) { - if (int stat{ - AllocateAssignmentLHS(to_, *from_, workQueue.terminator(), flags_)}; - stat != StatOk) { - return stat; - } - const auto *addendum{to_.Addendum()}; - toDerived_ = addendum ? addendum->derivedType() : nullptr; - if (toDerived_ && !toDerived_->noInitializationNeeded()) { - if (int status{workQueue.BeginInitialize(to_, *toDerived_)}; - status != StatOk) { - return status; - } - } - } - // Check for a user-defined assignment type-bound procedure; - // see 10.2.1.4-5. - // Note that the aliasing and LHS (re)allocation handling above - // needs to run even with CanBeDefinedAssignment flag, since - // Assign() can be invoked recursively for component-wise assignments. - if (toDerived_ && (flags_ & CanBeDefinedAssignment)) { - if (to_.rank() == 0) { - if (const auto *special{toDerived_->FindSpecialBinding( + if (toDerived && (flags & CanBeDefinedAssignment)) { + // Check for a user-defined assignment type-bound procedure; + // see 10.2.1.4-5. A user-defined assignment TBP defines all of + // the semantics, including allocatable (re)allocation and any + // finalization. + // + // Note that the aliasing and LHS (re)allocation handling above + // needs to run even with CanBeDefinedAssignment flag, when + // the Assign() is invoked recursively for component-per-component + // assignments. + if (to.rank() == 0) { + if (const auto *special{toDerived->FindSpecialBinding( typeInfo::SpecialBinding::Which::ScalarAssignment)}) { - DoScalarDefinedAssignment(to_, *from_, *special); - done_ = true; - return StatContinue; + return DoScalarDefinedAssignment(to, from, *special); } } - if (const auto *special{toDerived_->FindSpecialBinding( + if (const auto *special{toDerived->FindSpecialBinding( typeInfo::SpecialBinding::Which::ElementalAssignment)}) { - DoElementalDefinedAssignment(to_, *from_, *toDerived_, *special); - done_ = true; - return StatContinue; + return DoElementalDefinedAssignment(to, from, *toDerived, *special); } } - // Intrinsic assignment - std::size_t toElements{to_.Elements()}; - if (from_->rank() > 0 && toElements != from_->Elements()) { - workQueue.terminator().Crash("Assign: mismatching element counts in array " - "assignment (to %zd, from %zd)", - toElements, from_->Elements()); + SubscriptValue toAt[maxRank]; + to.GetLowerBounds(toAt); + // Scalar expansion of the RHS is implied by using the same empty + // subscript values on each (seemingly) elemental reference into + // "from". + SubscriptValue fromAt[maxRank]; + from.GetLowerBounds(fromAt); + std::size_t toElements{to.Elements()}; + if (from.rank() > 0 && toElements != from.Elements()) { + terminator.Crash("Assign: mismatching element counts in array assignment " + "(to %zd, from %zd)", + toElements, from.Elements()); } - if (to_.type() != from_->type()) { - workQueue.terminator().Crash( - "Assign: mismatching types (to code %d != from code %d)", - to_.type().raw(), from_->type().raw()); + if (to.type() != from.type()) { + terminator.Crash("Assign: mismatching types (to code %d != from code %d)", + to.type().raw(), from.type().raw()); } - std::size_t toElementBytes{to_.ElementBytes()}; - std::size_t fromElementBytes{from_->ElementBytes()}; - if (toElementBytes > fromElementBytes && !to_.type().IsCharacter()) { - workQueue.terminator().Crash("Assign: mismatching non-character element " - "sizes (to %zd bytes != from %zd bytes)", + if (toElementBytes > fromElementBytes && !to.type().IsCharacter()) { + terminator.Crash("Assign: mismatching non-character element sizes (to %zd " + "bytes != from %zd bytes)", toElementBytes, fromElementBytes); } - if (toDerived_) { - if (toDerived_->noDefinedAssignment()) { // componentwise - if (int status{workQueue.BeginDerivedAssign( - to_, *from_, *toDerived_, flags_, memmoveFct_, toDeallocate_)}; - status != StatOk && status != StatContinue) { - return status; + if (const typeInfo::DerivedType * + updatedToDerived{toAddendum ? toAddendum->derivedType() : nullptr}) { + // Derived type intrinsic assignment, which is componentwise and elementwise + // for all components, including parent components (10.2.1.2-3). + // The target is first finalized if still necessary (7.5.6.3(1)) + if (flags & NeedFinalization) { + Finalize(to, *updatedToDerived, &terminator); + } else if (updatedToDerived && !updatedToDerived->noDestructionNeeded()) { + Destroy(to, /*finalize=*/false, *updatedToDerived, &terminator); + } + // Copy the data components (incl. the parent) first. + const Descriptor &componentDesc{updatedToDerived->component()}; + std::size_t numComponents{componentDesc.Elements()}; + for (std::size_t j{0}; j < toElements; + ++j, to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) { + for (std::size_t k{0}; k < numComponents; ++k) { + const auto &comp{ + *componentDesc.ZeroBasedIndexedElement( + k)}; // TODO: exploit contiguity here + // Use PolymorphicLHS for components so that the right things happen + // when the components are polymorphic; when they're not, they're both + // not, and their declared types will match. + int nestedFlags{MaybeReallocate | PolymorphicLHS}; + if (flags & ComponentCanBeDefinedAssignment) { + nestedFlags |= + CanBeDefinedAssignment | ComponentCanBeDefinedAssignment; + } + switch (comp.genre()) { + case typeInfo::Component::Genre::Data: + if (comp.category() == TypeCategory::Derived) { + StaticDescriptor statDesc[2]; + Descriptor &toCompDesc{statDesc[0].descriptor()}; + Descriptor &fromCompDesc{statDesc[1].descriptor()}; + comp.CreatePointerDescriptor(toCompDesc, to, terminator, toAt); + comp.CreatePointerDescriptor( + fromCompDesc, from, terminator, fromAt); + Assign(toCompDesc, fromCompDesc, terminator, nestedFlags); + } else { // Component has intrinsic type; simply copy raw bytes + std::size_t componentByteSize{comp.SizeInBytes(to)}; + memmoveFct(to.Element(toAt) + comp.offset(), + from.Element(fromAt) + comp.offset(), + componentByteSize); + } + break; + case typeInfo::Component::Genre::Pointer: { + std::size_t componentByteSize{comp.SizeInBytes(to)}; + memmoveFct(to.Element(toAt) + comp.offset(), + from.Element(fromAt) + comp.offset(), + componentByteSize); + } break; + case typeInfo::Component::Genre::Allocatable: + case typeInfo::Component::Genre::Automatic: { + auto *toDesc{reinterpret_cast( + to.Element(toAt) + comp.offset())}; + const auto *fromDesc{reinterpret_cast( + from.Element(fromAt) + comp.offset())}; + // Allocatable components of the LHS are unconditionally + // deallocated before assignment (F'2018 10.2.1.3(13)(1)), + // unlike a "top-level" assignment to a variable, where + // deallocation is optional. + // + // Be careful not to destroy/reallocate the LHS, if there is + // overlap between LHS and RHS (it seems that partial overlap + // is not possible, though). + // Invoke Assign() recursively to deal with potential aliasing. + if (toDesc->IsAllocatable()) { + if (!fromDesc->IsAllocated()) { + // No aliasing. + // + // If to is not allocated, the Destroy() call is a no-op. + // This is just a shortcut, because the recursive Assign() + // below would initiate the destruction for to. + // No finalization is required. + toDesc->Destroy( + /*finalize=*/false, /*destroyPointers=*/false, &terminator); + continue; // F'2018 10.2.1.3(13)(2) + } + } + // Force LHS deallocation with DeallocateLHS flag. + // The actual deallocation may be avoided, if the existing + // location can be reoccupied. + Assign(*toDesc, *fromDesc, terminator, nestedFlags | DeallocateLHS); + } break; + } } - } else { // elementwise - if (int status{workQueue.BeginDerivedAssign( - to_, *from_, *toDerived_, flags_, memmoveFct_, toDeallocate_)}; - status != StatOk && status != StatContinue) { - return status; + // Copy procedure pointer components + const Descriptor &procPtrDesc{updatedToDerived->procPtr()}; + std::size_t numProcPtrs{procPtrDesc.Elements()}; + for (std::size_t k{0}; k < numProcPtrs; ++k) { + const auto &procPtr{ + *procPtrDesc.ZeroBasedIndexedElement( + k)}; + memmoveFct(to.Element(toAt) + procPtr.offset, + from.Element(fromAt) + procPtr.offset, + sizeof(typeInfo::ProcedurePointer)); } } - toDeallocate_ = nullptr; - } else if (IsSimpleMemmove()) { - memmoveFct_(to_.raw().base_addr, from_->raw().base_addr, - toElements * toElementBytes); - } else { - // Scalar expansion of the RHS is implied by using the same empty - // subscript values on each (seemingly) elemental reference into - // "from". - SubscriptValue toAt[maxRank]; - to_.GetLowerBounds(toAt); - SubscriptValue fromAt[maxRank]; - from_->GetLowerBounds(fromAt); - if (toElementBytes > fromElementBytes) { // blank padding - switch (to_.type().raw()) { + } else { // intrinsic type, intrinsic assignment + if (isSimpleMemmove()) { + memmoveFct(to.raw().base_addr, from.raw().base_addr, + toElements * toElementBytes); + } else if (toElementBytes > fromElementBytes) { // blank padding + switch (to.type().raw()) { case CFI_type_signed_char: case CFI_type_char: - BlankPadCharacterAssignment(to_, *from_, toAt, fromAt, toElements, + BlankPadCharacterAssignment(to, from, toAt, fromAt, toElements, toElementBytes, fromElementBytes); break; case CFI_type_char16_t: - BlankPadCharacterAssignment(to_, *from_, toAt, fromAt, + BlankPadCharacterAssignment(to, from, toAt, fromAt, toElements, toElementBytes, fromElementBytes); break; case CFI_type_char32_t: - BlankPadCharacterAssignment(to_, *from_, toAt, fromAt, + BlankPadCharacterAssignment(to, from, toAt, fromAt, toElements, toElementBytes, fromElementBytes); break; default: - workQueue.terminator().Crash( - "unexpected type code %d in blank padded Assign()", - to_.type().raw()); + terminator.Crash("unexpected type code %d in blank padded Assign()", + to.type().raw()); } } else { // elemental copies, possibly with character truncation for (std::size_t n{toElements}; n-- > 0; - to_.IncrementSubscripts(toAt), from_->IncrementSubscripts(fromAt)) { - memmoveFct_(to_.Element(toAt), from_->Element(fromAt), + to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) { + memmoveFct(to.Element(toAt), from.Element(fromAt), toElementBytes); } } } - if (persist_) { - done_ = true; - return StatContinue; - } else { - if (toDeallocate_) { - toDeallocate_->Deallocate(); - toDeallocate_ = nullptr; - } - return StatOk; + if (deferDeallocation) { + // deferDeallocation is used only when LHS is an allocatable. + // The finalization has already been run for it. + deferDeallocation->Destroy( + /*finalize=*/false, /*destroyPointers=*/false, &terminator); } } -template -RT_API_ATTRS int DerivedAssignTicket::Begin( - WorkQueue &workQueue) { - if (toIsContiguous_ && fromIsContiguous_ && - this->derived_.noDestructionNeeded() && - this->derived_.noDefinedAssignment() && - this->instance_.rank() == this->from_->rank()) { - if (std::size_t elementBytes{this->instance_.ElementBytes()}; - elementBytes == this->from_->ElementBytes()) { - // Fastest path. Both LHS and RHS are contiguous, RHS is not a scalar - // to be expanded, the types have the same size, and there are no - // allocatable components or defined ASSIGNMENT(=) at any level. - memmoveFct_(this->instance_.template OffsetElement(), - this->from_->template OffsetElement(), - this->instance_.Elements() * elementBytes); - return StatOk; - } - } - // Use PolymorphicLHS for components so that the right things happen - // when the components are polymorphic; when they're not, they're both - // not, and their declared types will match. - int nestedFlags{MaybeReallocate | PolymorphicLHS}; - if (flags_ & ComponentCanBeDefinedAssignment) { - nestedFlags |= CanBeDefinedAssignment | ComponentCanBeDefinedAssignment; - } - flags_ = nestedFlags; - // Copy procedure pointer components - const Descriptor &procPtrDesc{this->derived_.procPtr()}; - bool noDataComponents{this->IsComplete()}; - if (std::size_t numProcPtrs{procPtrDesc.Elements()}) { - for (std::size_t k{0}; k < numProcPtrs; ++k) { - const auto &procPtr{ - *procPtrDesc.ZeroBasedIndexedElement(k)}; - // Loop only over elements - if (noDataComponents) { - Elementwise::Reset(); - } - for (; !Elementwise::IsComplete(); Elementwise::Advance()) { - memmoveFct_(this->instance_.template ElementComponent( - this->subscripts_, procPtr.offset), - this->from_->template ElementComponent( - this->fromSubscripts_, procPtr.offset), - sizeof(typeInfo::ProcedurePointer)); - } - } - if (noDataComponents) { - return StatOk; - } - Elementwise::Reset(); - } - if (noDataComponents) { - return StatOk; - } - return StatContinue; -} -template RT_API_ATTRS int DerivedAssignTicket::Begin(WorkQueue &); -template RT_API_ATTRS int DerivedAssignTicket::Begin(WorkQueue &); - -template -RT_API_ATTRS int DerivedAssignTicket::Continue( - WorkQueue &workQueue) { - while (!this->IsComplete()) { - // Copy the data components (incl. the parent) first. - switch (this->component_->genre()) { - case typeInfo::Component::Genre::Data: - if (this->component_->category() == TypeCategory::Derived) { - Descriptor &toCompDesc{this->componentDescriptor_.descriptor()}; - Descriptor &fromCompDesc{this->fromComponentDescriptor_.descriptor()}; - this->component_->CreatePointerDescriptor(toCompDesc, this->instance_, - workQueue.terminator(), this->subscripts_); - this->component_->CreatePointerDescriptor(fromCompDesc, *this->from_, - workQueue.terminator(), this->fromSubscripts_); - this->Advance(); - if (int status{workQueue.BeginAssign( - toCompDesc, fromCompDesc, flags_, memmoveFct_)}; - status != StatOk) { - return status; - } - } else { // Component has intrinsic type; simply copy raw bytes - std::size_t componentByteSize{ - this->component_->SizeInBytes(this->instance_)}; - if (IS_COMPONENTWISE && toIsContiguous_ && fromIsContiguous_) { - std::size_t offset{this->component_->offset()}; - char *to{this->instance_.template OffsetElement(offset)}; - const char *from{ - this->from_->template OffsetElement(offset)}; - std::size_t toElementStride{this->instance_.ElementBytes()}; - std::size_t fromElementStride{ - this->from_->rank() == 0 ? 0 : this->from_->ElementBytes()}; - if (toElementStride == fromElementStride && - toElementStride == componentByteSize) { - memmoveFct_(to, from, this->elements_ * componentByteSize); - } else { - for (std::size_t n{this->elements_}; n--; - to += toElementStride, from += fromElementStride) { - memmoveFct_(to, from, componentByteSize); - } - } - this->Componentwise::Advance(); - } else { - memmoveFct_( - this->instance_.template Element(this->subscripts_) + - this->component_->offset(), - this->from_->template Element(this->fromSubscripts_) + - this->component_->offset(), - componentByteSize); - this->Advance(); - } - } - break; - case typeInfo::Component::Genre::Pointer: { - std::size_t componentByteSize{ - this->component_->SizeInBytes(this->instance_)}; - if (IS_COMPONENTWISE && toIsContiguous_ && fromIsContiguous_) { - std::size_t offset{this->component_->offset()}; - char *to{this->instance_.template OffsetElement(offset)}; - const char *from{ - this->from_->template OffsetElement(offset)}; - std::size_t toElementStride{this->instance_.ElementBytes()}; - std::size_t fromElementStride{ - this->from_->rank() == 0 ? 0 : this->from_->ElementBytes()}; - if (toElementStride == fromElementStride && - toElementStride == componentByteSize) { - memmoveFct_(to, from, this->elements_ * componentByteSize); - } else { - for (std::size_t n{this->elements_}; n--; - to += toElementStride, from += fromElementStride) { - memmoveFct_(to, from, componentByteSize); - } - } - this->Componentwise::Advance(); - } else { - memmoveFct_(this->instance_.template Element(this->subscripts_) + - this->component_->offset(), - this->from_->template Element(this->fromSubscripts_) + - this->component_->offset(), - componentByteSize); - this->Advance(); - } - } break; - case typeInfo::Component::Genre::Allocatable: - case typeInfo::Component::Genre::Automatic: { - auto *toDesc{reinterpret_cast( - this->instance_.template Element(this->subscripts_) + - this->component_->offset())}; - const auto *fromDesc{reinterpret_cast( - this->from_->template Element(this->fromSubscripts_) + - this->component_->offset())}; - if (toDesc->IsAllocatable() && !fromDesc->IsAllocated()) { - if (toDesc->IsAllocated()) { - if (this->phase_ == 0) { - this->phase_++; - if (const auto *componentDerived{this->component_->derivedType()}; - componentDerived && !componentDerived->noDestructionNeeded()) { - if (int status{workQueue.BeginDestroy( - *toDesc, *componentDerived, /*finalize=*/false)}; - status != StatOk) { - return status; - } - } - } - toDesc->Deallocate(); - } - this->Advance(); - } else { - // Allocatable components of the LHS are unconditionally - // deallocated before assignment (F'2018 10.2.1.3(13)(1)), - // unlike a "top-level" assignment to a variable, where - // deallocation is optional. - this->Advance(); - int nestedFlags{flags_}; - if (this->derived_.noFinalizationNeeded() && - this->derived_.noInitializationNeeded() && - this->derived_.noDestructionNeeded()) { - // The actual deallocation may be avoided, if the existing - // location can be reoccupied. - } else { - // Force LHS deallocation with DeallocateLHS flag. - nestedFlags |= DeallocateLHS; - } - if (int status{workQueue.BeginAssign( - *toDesc, *fromDesc, nestedFlags, memmoveFct_)}; - status != StatOk) { - return status; - } - } - } break; - } - } - if (deallocateAfter_) { - deallocateAfter_->Deallocate(); - } - return StatOk; -} -template RT_API_ATTRS int DerivedAssignTicket::Continue(WorkQueue &); -template RT_API_ATTRS int DerivedAssignTicket::Continue(WorkQueue &); +RT_OFFLOAD_API_GROUP_BEGIN RT_API_ATTRS void DoFromSourceAssign(Descriptor &alloc, const Descriptor &source, Terminator &terminator, MemmoveFct memmoveFct) { @@ -759,6 +582,7 @@ void RTDEF(AssignTemporary)(Descriptor &to, const Descriptor &from, } } } + Assign(to, from, terminator, MaybeReallocate | PolymorphicLHS); } @@ -775,6 +599,7 @@ void RTDEF(CopyInAssign)(Descriptor &temp, const Descriptor &var, void RTDEF(CopyOutAssign)( Descriptor *var, Descriptor &temp, const char *sourceFile, int sourceLine) { Terminator terminator{sourceFile, sourceLine}; + // Copyout from the temporary must not cause any finalizations // for LHS. The variable must be properly initialized already. if (var) { diff --git a/flang-rt/lib/runtime/derived.cpp b/flang-rt/lib/runtime/derived.cpp index 8ab737c701b01..35037036f63e7 100644 --- a/flang-rt/lib/runtime/derived.cpp +++ b/flang-rt/lib/runtime/derived.cpp @@ -12,7 +12,6 @@ #include "flang-rt/runtime/terminator.h" #include "flang-rt/runtime/tools.h" #include "flang-rt/runtime/type-info.h" -#include "flang-rt/runtime/work-queue.h" namespace Fortran::runtime { @@ -31,193 +30,180 @@ static RT_API_ATTRS void GetComponentExtents(SubscriptValue (&extents)[maxRank], } RT_API_ATTRS int Initialize(const Descriptor &instance, - const typeInfo::DerivedType &derived, Terminator &terminator, bool, - const Descriptor *) { - WorkQueue workQueue{terminator}; - int status{workQueue.BeginInitialize(instance, derived)}; - return status == StatContinue ? workQueue.Run() : status; -} - -RT_API_ATTRS int InitializeTicket::Begin(WorkQueue &) { - // Initialize procedure pointer components in each element - const Descriptor &procPtrDesc{derived_.procPtr()}; - if (std::size_t numProcPtrs{procPtrDesc.Elements()}) { - bool noDataComponents{IsComplete()}; - for (std::size_t k{0}; k < numProcPtrs; ++k) { - const auto &comp{ - *procPtrDesc.ZeroBasedIndexedElement(k)}; - // Loop only over elements - if (noDataComponents) { - Elementwise::Reset(); - } - for (; !Elementwise::IsComplete(); Elementwise::Advance()) { - auto &pptr{*instance_.ElementComponent( - subscripts_, comp.offset)}; - pptr = comp.procInitialization; - } - } - if (noDataComponents) { - return StatOk; - } - Elementwise::Reset(); - } - return StatContinue; -} - -RT_API_ATTRS int InitializeTicket::Continue(WorkQueue &workQueue) { - while (!IsComplete()) { - if (component_->genre() == typeInfo::Component::Genre::Allocatable) { - // Establish allocatable descriptors - for (; !Elementwise::IsComplete(); Elementwise::Advance()) { - Descriptor &allocDesc{*instance_.ElementComponent( - subscripts_, component_->offset())}; - component_->EstablishDescriptor( - allocDesc, instance_, workQueue.terminator()); + const typeInfo::DerivedType &derived, Terminator &terminator, bool hasStat, + const Descriptor *errMsg) { + const Descriptor &componentDesc{derived.component()}; + std::size_t elements{instance.Elements()}; + int stat{StatOk}; + // Initialize data components in each element; the per-element iterations + // constitute the inner loops, not the outer ones + std::size_t myComponents{componentDesc.Elements()}; + for (std::size_t k{0}; k < myComponents; ++k) { + const auto &comp{ + *componentDesc.ZeroBasedIndexedElement(k)}; + SubscriptValue at[maxRank]; + instance.GetLowerBounds(at); + if (comp.genre() == typeInfo::Component::Genre::Allocatable || + comp.genre() == typeInfo::Component::Genre::Automatic) { + for (std::size_t j{0}; j++ < elements; instance.IncrementSubscripts(at)) { + Descriptor &allocDesc{ + *instance.ElementComponent(at, comp.offset())}; + comp.EstablishDescriptor(allocDesc, instance, terminator); allocDesc.raw().attribute = CFI_attribute_allocatable; + if (comp.genre() == typeInfo::Component::Genre::Automatic) { + stat = ReturnError( + terminator, allocDesc.Allocate(kNoAsyncObject), errMsg, hasStat); + if (stat == StatOk) { + if (const DescriptorAddendum * addendum{allocDesc.Addendum()}) { + if (const auto *derived{addendum->derivedType()}) { + if (!derived->noInitializationNeeded()) { + stat = Initialize( + allocDesc, *derived, terminator, hasStat, errMsg); + } + } + } + } + if (stat != StatOk) { + break; + } + } } - SkipToNextComponent(); - } else if (const void *init{component_->initialization()}) { + } else if (const void *init{comp.initialization()}) { // Explicit initialization of data pointers and // non-allocatable non-automatic components - std::size_t bytes{component_->SizeInBytes(instance_)}; - for (; !Elementwise::IsComplete(); Elementwise::Advance()) { - char *ptr{instance_.ElementComponent( - subscripts_, component_->offset())}; + std::size_t bytes{comp.SizeInBytes(instance)}; + for (std::size_t j{0}; j++ < elements; instance.IncrementSubscripts(at)) { + char *ptr{instance.ElementComponent(at, comp.offset())}; std::memcpy(ptr, init, bytes); } - SkipToNextComponent(); - } else if (component_->genre() == typeInfo::Component::Genre::Pointer) { + } else if (comp.genre() == typeInfo::Component::Genre::Pointer) { // Data pointers without explicit initialization are established // so that they are valid right-hand side targets of pointer // assignment statements. - for (; !Elementwise::IsComplete(); Elementwise::Advance()) { - Descriptor &ptrDesc{*instance_.ElementComponent( - subscripts_, component_->offset())}; - component_->EstablishDescriptor( - ptrDesc, instance_, workQueue.terminator()); + for (std::size_t j{0}; j++ < elements; instance.IncrementSubscripts(at)) { + Descriptor &ptrDesc{ + *instance.ElementComponent(at, comp.offset())}; + comp.EstablishDescriptor(ptrDesc, instance, terminator); ptrDesc.raw().attribute = CFI_attribute_pointer; } - SkipToNextComponent(); - } else if (component_->genre() == typeInfo::Component::Genre::Data && - component_->derivedType() && - !component_->derivedType()->noInitializationNeeded()) { + } else if (comp.genre() == typeInfo::Component::Genre::Data && + comp.derivedType() && !comp.derivedType()->noInitializationNeeded()) { // Default initialization of non-pointer non-allocatable/automatic - // data component. Handles parent component's elements. + // data component. Handles parent component's elements. Recursive. SubscriptValue extents[maxRank]; - GetComponentExtents(extents, *component_, instance_); - Descriptor &compDesc{componentDescriptor_.descriptor()}; - const typeInfo::DerivedType &compType{*component_->derivedType()}; - compDesc.Establish(compType, - instance_.ElementComponent(subscripts_, component_->offset()), - component_->rank(), extents); - Advance(); - if (int status{workQueue.BeginInitialize(compDesc, compType)}; - status != StatOk) { - return status; + GetComponentExtents(extents, comp, instance); + StaticDescriptor staticDescriptor; + Descriptor &compDesc{staticDescriptor.descriptor()}; + const typeInfo::DerivedType &compType{*comp.derivedType()}; + for (std::size_t j{0}; j++ < elements; instance.IncrementSubscripts(at)) { + compDesc.Establish(compType, + instance.ElementComponent(at, comp.offset()), comp.rank(), + extents); + stat = Initialize(compDesc, compType, terminator, hasStat, errMsg); + if (stat != StatOk) { + break; + } } - } else { - SkipToNextComponent(); } } - return StatOk; + // Initialize procedure pointer components in each element + const Descriptor &procPtrDesc{derived.procPtr()}; + std::size_t myProcPtrs{procPtrDesc.Elements()}; + for (std::size_t k{0}; k < myProcPtrs; ++k) { + const auto &comp{ + *procPtrDesc.ZeroBasedIndexedElement(k)}; + SubscriptValue at[maxRank]; + instance.GetLowerBounds(at); + for (std::size_t j{0}; j++ < elements; instance.IncrementSubscripts(at)) { + auto &pptr{*instance.ElementComponent( + at, comp.offset)}; + pptr = comp.procInitialization; + } + } + return stat; } RT_API_ATTRS int InitializeClone(const Descriptor &clone, - const Descriptor &original, const typeInfo::DerivedType &derived, + const Descriptor &orig, const typeInfo::DerivedType &derived, Terminator &terminator, bool hasStat, const Descriptor *errMsg) { - if (original.IsPointer() || !original.IsAllocated()) { - return StatOk; // nothing to do - } else { - WorkQueue workQueue{terminator}; - int status{workQueue.BeginInitializeClone( - clone, original, derived, hasStat, errMsg)}; - return status == StatContinue ? workQueue.Run() : status; - } -} + const Descriptor &componentDesc{derived.component()}; + std::size_t elements{orig.Elements()}; + int stat{StatOk}; -RT_API_ATTRS int InitializeCloneTicket::Continue(WorkQueue &workQueue) { - while (!IsComplete()) { - if (component_->genre() == typeInfo::Component::Genre::Allocatable) { - Descriptor &origDesc{*instance_.ElementComponent( - subscripts_, component_->offset())}; - if (origDesc.IsAllocated()) { - Descriptor &cloneDesc{*clone_.ElementComponent( - subscripts_, component_->offset())}; - if (phase_ == 0) { - ++phase_; + // Skip pointers and unallocated variables. + if (orig.IsPointer() || !orig.IsAllocated()) { + return stat; + } + // Initialize each data component. + std::size_t components{componentDesc.Elements()}; + for (std::size_t i{0}; i < components; ++i) { + const typeInfo::Component &comp{ + *componentDesc.ZeroBasedIndexedElement(i)}; + SubscriptValue at[maxRank]; + orig.GetLowerBounds(at); + // Allocate allocatable components that are also allocated in the original + // object. + if (comp.genre() == typeInfo::Component::Genre::Allocatable) { + // Initialize each element. + for (std::size_t j{0}; j < elements; ++j, orig.IncrementSubscripts(at)) { + Descriptor &origDesc{ + *orig.ElementComponent(at, comp.offset())}; + Descriptor &cloneDesc{ + *clone.ElementComponent(at, comp.offset())}; + if (origDesc.IsAllocated()) { cloneDesc.ApplyMold(origDesc, origDesc.rank()); - if (int stat{ReturnError(workQueue.terminator(), - cloneDesc.Allocate(kNoAsyncObject), errMsg_, hasStat_)}; - stat != StatOk) { - return stat; - } - if (const DescriptorAddendum *addendum{cloneDesc.Addendum()}) { - if (const typeInfo::DerivedType *derived{addendum->derivedType()}) { - if (!derived->noInitializationNeeded()) { - // Perform default initialization for the allocated element. - if (int status{workQueue.BeginInitialize(cloneDesc, *derived)}; - status != StatOk) { - return status; + stat = ReturnError( + terminator, cloneDesc.Allocate(kNoAsyncObject), errMsg, hasStat); + if (stat == StatOk) { + if (const DescriptorAddendum * addendum{cloneDesc.Addendum()}) { + if (const typeInfo::DerivedType * + derived{addendum->derivedType()}) { + if (!derived->noInitializationNeeded()) { + // Perform default initialization for the allocated element. + stat = Initialize( + cloneDesc, *derived, terminator, hasStat, errMsg); + } + // Initialize derived type's allocatables. + if (stat == StatOk) { + stat = InitializeClone(cloneDesc, origDesc, *derived, + terminator, hasStat, errMsg); } } } } } - if (phase_ == 1) { - ++phase_; - if (const DescriptorAddendum *addendum{cloneDesc.Addendum()}) { - if (const typeInfo::DerivedType *derived{addendum->derivedType()}) { - // Initialize derived type's allocatables. - if (int status{workQueue.BeginInitializeClone( - cloneDesc, origDesc, *derived, hasStat_, errMsg_)}; - status != StatOk) { - return status; - } - } - } + if (stat != StatOk) { + break; } } - Advance(); - } else if (component_->genre() == typeInfo::Component::Genre::Data) { - if (component_->derivedType()) { - // Handle nested derived types. - const typeInfo::DerivedType &compType{*component_->derivedType()}; - SubscriptValue extents[maxRank]; - GetComponentExtents(extents, *component_, instance_); - Descriptor &origDesc{componentDescriptor_.descriptor()}; - Descriptor &cloneDesc{cloneComponentDescriptor_.descriptor()}; + } else if (comp.genre() == typeInfo::Component::Genre::Data && + comp.derivedType()) { + // Handle nested derived types. + const typeInfo::DerivedType &compType{*comp.derivedType()}; + SubscriptValue extents[maxRank]; + GetComponentExtents(extents, comp, orig); + // Data components don't have descriptors, allocate them. + StaticDescriptor origStaticDesc; + StaticDescriptor cloneStaticDesc; + Descriptor &origDesc{origStaticDesc.descriptor()}; + Descriptor &cloneDesc{cloneStaticDesc.descriptor()}; + // Initialize each element. + for (std::size_t j{0}; j < elements; ++j, orig.IncrementSubscripts(at)) { origDesc.Establish(compType, - instance_.ElementComponent(subscripts_, component_->offset()), - component_->rank(), extents); + orig.ElementComponent(at, comp.offset()), comp.rank(), + extents); cloneDesc.Establish(compType, - clone_.ElementComponent(subscripts_, component_->offset()), - component_->rank(), extents); - Advance(); - if (int status{workQueue.BeginInitializeClone( - cloneDesc, origDesc, compType, hasStat_, errMsg_)}; - status != StatOk) { - return status; + clone.ElementComponent(at, comp.offset()), comp.rank(), + extents); + stat = InitializeClone( + cloneDesc, origDesc, compType, terminator, hasStat, errMsg); + if (stat != StatOk) { + break; } - } else { - SkipToNextComponent(); } - } else { - SkipToNextComponent(); - } - } - return StatOk; -} - -// Fortran 2018 subclause 7.5.6.2 -RT_API_ATTRS void Finalize(const Descriptor &descriptor, - const typeInfo::DerivedType &derived, Terminator *terminator) { - if (!derived.noFinalizationNeeded() && descriptor.IsAllocated()) { - Terminator stubTerminator{"Finalize() in Fortran runtime", 0}; - WorkQueue workQueue{terminator ? *terminator : stubTerminator}; - if (workQueue.BeginFinalize(descriptor, derived) == StatContinue) { - workQueue.Run(); } } + return stat; } static RT_API_ATTRS const typeInfo::SpecialBinding *FindFinal( @@ -235,7 +221,7 @@ static RT_API_ATTRS const typeInfo::SpecialBinding *FindFinal( } static RT_API_ATTRS void CallFinalSubroutine(const Descriptor &descriptor, - const typeInfo::DerivedType &derived, Terminator &terminator) { + const typeInfo::DerivedType &derived, Terminator *terminator) { if (const auto *special{FindFinal(derived, descriptor.rank())}) { if (special->which() == typeInfo::SpecialBinding::Which::ElementalFinal) { std::size_t elements{descriptor.Elements()}; @@ -272,7 +258,9 @@ static RT_API_ATTRS void CallFinalSubroutine(const Descriptor &descriptor, copy = descriptor; copy.set_base_addr(nullptr); copy.raw().attribute = CFI_attribute_allocatable; - RUNTIME_CHECK(terminator, copy.Allocate(kNoAsyncObject) == CFI_SUCCESS); + Terminator stubTerminator{"CallFinalProcedure() in Fortran runtime", 0}; + RUNTIME_CHECK(terminator ? *terminator : stubTerminator, + copy.Allocate(kNoAsyncObject) == CFI_SUCCESS); ShallowCopyDiscontiguousToContiguous(copy, descriptor); argDescriptor = © } @@ -296,94 +284,87 @@ static RT_API_ATTRS void CallFinalSubroutine(const Descriptor &descriptor, } } -RT_API_ATTRS int FinalizeTicket::Begin(WorkQueue &workQueue) { - CallFinalSubroutine(instance_, derived_, workQueue.terminator()); +// Fortran 2018 subclause 7.5.6.2 +RT_API_ATTRS void Finalize(const Descriptor &descriptor, + const typeInfo::DerivedType &derived, Terminator *terminator) { + if (derived.noFinalizationNeeded() || !descriptor.IsAllocated()) { + return; + } + CallFinalSubroutine(descriptor, derived, terminator); + const auto *parentType{derived.GetParentType()}; + bool recurse{parentType && !parentType->noFinalizationNeeded()}; // If there's a finalizable parent component, handle it last, as required // by the Fortran standard (7.5.6.2), and do so recursively with the same // descriptor so that the rank is preserved. - finalizableParentType_ = derived_.GetParentType(); - if (finalizableParentType_) { - if (finalizableParentType_->noFinalizationNeeded()) { - finalizableParentType_ = nullptr; - } else { - SkipToNextComponent(); - } - } - return StatContinue; -} - -RT_API_ATTRS int FinalizeTicket::Continue(WorkQueue &workQueue) { - while (!IsComplete()) { - if (component_->genre() == typeInfo::Component::Genre::Allocatable && - component_->category() == TypeCategory::Derived) { + const Descriptor &componentDesc{derived.component()}; + std::size_t myComponents{componentDesc.Elements()}; + std::size_t elements{descriptor.Elements()}; + for (auto k{recurse ? std::size_t{1} + /* skip first component, it's the parent */ + : 0}; + k < myComponents; ++k) { + const auto &comp{ + *componentDesc.ZeroBasedIndexedElement(k)}; + SubscriptValue at[maxRank]; + descriptor.GetLowerBounds(at); + if (comp.genre() == typeInfo::Component::Genre::Allocatable && + comp.category() == TypeCategory::Derived) { // Component may be polymorphic or unlimited polymorphic. Need to use the // dynamic type to check whether finalization is needed. - const Descriptor &compDesc{*instance_.ElementComponent( - subscripts_, component_->offset())}; - Advance(); - if (compDesc.IsAllocated()) { - if (const DescriptorAddendum *addendum{compDesc.Addendum()}) { - if (const typeInfo::DerivedType *compDynamicType{ - addendum->derivedType()}) { - if (!compDynamicType->noFinalizationNeeded()) { - if (int status{ - workQueue.BeginFinalize(compDesc, *compDynamicType)}; - status != StatOk) { - return status; + for (std::size_t j{0}; j++ < elements; + descriptor.IncrementSubscripts(at)) { + const Descriptor &compDesc{ + *descriptor.ElementComponent(at, comp.offset())}; + if (compDesc.IsAllocated()) { + if (const DescriptorAddendum * addendum{compDesc.Addendum()}) { + if (const typeInfo::DerivedType * + compDynamicType{addendum->derivedType()}) { + if (!compDynamicType->noFinalizationNeeded()) { + Finalize(compDesc, *compDynamicType, terminator); } } } } } - } else if (component_->genre() == typeInfo::Component::Genre::Allocatable || - component_->genre() == typeInfo::Component::Genre::Automatic) { - if (const typeInfo::DerivedType *compType{component_->derivedType()}; - compType && !compType->noFinalizationNeeded()) { - const Descriptor &compDesc{*instance_.ElementComponent( - subscripts_, component_->offset())}; - Advance(); - if (compDesc.IsAllocated()) { - if (int status{workQueue.BeginFinalize(compDesc, *compType)}; - status != StatOk) { - return status; + } else if (comp.genre() == typeInfo::Component::Genre::Allocatable || + comp.genre() == typeInfo::Component::Genre::Automatic) { + if (const typeInfo::DerivedType * compType{comp.derivedType()}) { + if (!compType->noFinalizationNeeded()) { + for (std::size_t j{0}; j++ < elements; + descriptor.IncrementSubscripts(at)) { + const Descriptor &compDesc{ + *descriptor.ElementComponent(at, comp.offset())}; + if (compDesc.IsAllocated()) { + Finalize(compDesc, *compType, terminator); + } } } - } else { - SkipToNextComponent(); } - } else if (component_->genre() == typeInfo::Component::Genre::Data && - component_->derivedType() && - !component_->derivedType()->noFinalizationNeeded()) { + } else if (comp.genre() == typeInfo::Component::Genre::Data && + comp.derivedType() && !comp.derivedType()->noFinalizationNeeded()) { SubscriptValue extents[maxRank]; - GetComponentExtents(extents, *component_, instance_); - Descriptor &compDesc{componentDescriptor_.descriptor()}; - const typeInfo::DerivedType &compType{*component_->derivedType()}; - compDesc.Establish(compType, - instance_.ElementComponent(subscripts_, component_->offset()), - component_->rank(), extents); - Advance(); - if (int status{workQueue.BeginFinalize(compDesc, compType)}; - status != StatOk) { - return status; + GetComponentExtents(extents, comp, descriptor); + StaticDescriptor staticDescriptor; + Descriptor &compDesc{staticDescriptor.descriptor()}; + const typeInfo::DerivedType &compType{*comp.derivedType()}; + for (std::size_t j{0}; j++ < elements; + descriptor.IncrementSubscripts(at)) { + compDesc.Establish(compType, + descriptor.ElementComponent(at, comp.offset()), comp.rank(), + extents); + Finalize(compDesc, compType, terminator); } - } else { - SkipToNextComponent(); } } - // Last, do the parent component, if any and finalizable. - if (finalizableParentType_) { - Descriptor &tmpDesc{componentDescriptor_.descriptor()}; - tmpDesc = instance_; + if (recurse) { + StaticDescriptor statDesc; + Descriptor &tmpDesc{statDesc.descriptor()}; + tmpDesc = descriptor; tmpDesc.raw().attribute = CFI_attribute_pointer; - tmpDesc.Addendum()->set_derivedType(finalizableParentType_); - tmpDesc.raw().elem_len = finalizableParentType_->sizeInBytes(); - const auto &parentType{*finalizableParentType_}; - finalizableParentType_ = nullptr; - // Don't return StatOk here if the nested FInalize is still running; - // it needs this->componentDescriptor_. - return workQueue.BeginFinalize(tmpDesc, parentType); + tmpDesc.Addendum()->set_derivedType(parentType); + tmpDesc.raw().elem_len = parentType->sizeInBytes(); + Finalize(tmpDesc, *parentType, terminator); } - return StatOk; } // The order of finalization follows Fortran 2018 7.5.6.2, with @@ -392,71 +373,51 @@ RT_API_ATTRS int FinalizeTicket::Continue(WorkQueue &workQueue) { // preceding any deallocation. RT_API_ATTRS void Destroy(const Descriptor &descriptor, bool finalize, const typeInfo::DerivedType &derived, Terminator *terminator) { - if (!derived.noFinalizationNeeded() && descriptor.IsAllocated()) { - Terminator stubTerminator{"Destroy() in Fortran runtime", 0}; - WorkQueue workQueue{terminator ? *terminator : stubTerminator}; - if (workQueue.BeginDestroy(descriptor, derived, finalize) == StatContinue) { - workQueue.Run(); - } + if (derived.noDestructionNeeded() || !descriptor.IsAllocated()) { + return; } -} - -RT_API_ATTRS int DestroyTicket::Begin(WorkQueue &workQueue) { - if (finalize_ && !derived_.noFinalizationNeeded()) { - if (int status{workQueue.BeginFinalize(instance_, derived_)}; - status != StatOk && status != StatContinue) { - return status; - } + if (finalize && !derived.noFinalizationNeeded()) { + Finalize(descriptor, derived, terminator); } - return StatContinue; -} - -RT_API_ATTRS int DestroyTicket::Continue(WorkQueue &workQueue) { // Deallocate all direct and indirect allocatable and automatic components. // Contrary to finalization, the order of deallocation does not matter. - while (!IsComplete()) { - const auto *componentDerived{component_->derivedType()}; - if (component_->genre() == typeInfo::Component::Genre::Allocatable || - component_->genre() == typeInfo::Component::Genre::Automatic) { - Descriptor *d{instance_.ElementComponent( - subscripts_, component_->offset())}; - if (d->IsAllocated()) { - if (phase_ == 0) { - ++phase_; - if (componentDerived && !componentDerived->noDestructionNeeded()) { - if (int status{workQueue.BeginDestroy( - *d, *componentDerived, /*finalize=*/false)}; - status != StatOk) { - return status; - } - } + const Descriptor &componentDesc{derived.component()}; + std::size_t myComponents{componentDesc.Elements()}; + std::size_t elements{descriptor.Elements()}; + SubscriptValue at[maxRank]; + descriptor.GetLowerBounds(at); + for (std::size_t k{0}; k < myComponents; ++k) { + const auto &comp{ + *componentDesc.ZeroBasedIndexedElement(k)}; + const bool destroyComp{ + comp.derivedType() && !comp.derivedType()->noDestructionNeeded()}; + if (comp.genre() == typeInfo::Component::Genre::Allocatable || + comp.genre() == typeInfo::Component::Genre::Automatic) { + for (std::size_t j{0}; j < elements; ++j) { + Descriptor *d{ + descriptor.ElementComponent(at, comp.offset())}; + if (destroyComp) { + Destroy(*d, /*finalize=*/false, *comp.derivedType(), terminator); } d->Deallocate(); + descriptor.IncrementSubscripts(at); } - Advance(); - } else if (component_->genre() == typeInfo::Component::Genre::Data) { - if (!componentDerived || componentDerived->noDestructionNeeded()) { - SkipToNextComponent(); - } else { - SubscriptValue extents[maxRank]; - GetComponentExtents(extents, *component_, instance_); - Descriptor &compDesc{componentDescriptor_.descriptor()}; - const typeInfo::DerivedType &compType{*componentDerived}; + } else if (destroyComp && + comp.genre() == typeInfo::Component::Genre::Data) { + SubscriptValue extents[maxRank]; + GetComponentExtents(extents, comp, descriptor); + StaticDescriptor staticDescriptor; + Descriptor &compDesc{staticDescriptor.descriptor()}; + const typeInfo::DerivedType &compType{*comp.derivedType()}; + for (std::size_t j{0}; j++ < elements; + descriptor.IncrementSubscripts(at)) { compDesc.Establish(compType, - instance_.ElementComponent(subscripts_, component_->offset()), - component_->rank(), extents); - Advance(); - if (int status{workQueue.BeginDestroy( - compDesc, *componentDerived, /*finalize=*/false)}; - status != StatOk) { - return status; - } + descriptor.ElementComponent(at, comp.offset()), comp.rank(), + extents); + Destroy(compDesc, /*finalize=*/false, *comp.derivedType(), terminator); } - } else { - SkipToNextComponent(); } } - return StatOk; } RT_API_ATTRS bool HasDynamicComponent(const Descriptor &descriptor) { diff --git a/flang-rt/lib/runtime/descriptor-io.cpp b/flang-rt/lib/runtime/descriptor-io.cpp index 364724b89ba0d..3db1455af52fe 100644 --- a/flang-rt/lib/runtime/descriptor-io.cpp +++ b/flang-rt/lib/runtime/descriptor-io.cpp @@ -7,44 +7,15 @@ //===----------------------------------------------------------------------===// #include "descriptor-io.h" -#include "edit-input.h" -#include "edit-output.h" -#include "unit.h" -#include "flang-rt/runtime/descriptor.h" -#include "flang-rt/runtime/io-stmt.h" -#include "flang-rt/runtime/namelist.h" -#include "flang-rt/runtime/terminator.h" -#include "flang-rt/runtime/type-info.h" -#include "flang-rt/runtime/work-queue.h" -#include "flang/Common/optional.h" #include "flang/Common/restorer.h" -#include "flang/Common/uint128.h" -#include "flang/Runtime/cpp-type.h" #include "flang/Runtime/freestanding-tools.h" -// Implementation of I/O data list item transfers based on descriptors. -// (All I/O items come through here so that the code is exercised for test; -// some scalar I/O data transfer APIs could be changed to bypass their use -// of descriptors in the future for better efficiency.) - namespace Fortran::runtime::io::descr { RT_OFFLOAD_API_GROUP_BEGIN -template -inline RT_API_ATTRS A &ExtractElement(IoStatementState &io, - const Descriptor &descriptor, const SubscriptValue subscripts[]) { - A *p{descriptor.Element(subscripts)}; - if (!p) { - io.GetIoErrorHandler().Crash("Bad address for I/O item -- null base " - "address or subscripts out of range"); - } - return *p; -} - // Defined formatted I/O (maybe) -static RT_API_ATTRS Fortran::common::optional DefinedFormattedIo( - IoStatementState &io, const Descriptor &descriptor, - const typeInfo::DerivedType &derived, +Fortran::common::optional DefinedFormattedIo(IoStatementState &io, + const Descriptor &descriptor, const typeInfo::DerivedType &derived, const typeInfo::SpecialBinding &special, const SubscriptValue subscripts[]) { Fortran::common::optional peek{ @@ -133,8 +104,8 @@ static RT_API_ATTRS Fortran::common::optional DefinedFormattedIo( } // Defined unformatted I/O -static RT_API_ATTRS bool DefinedUnformattedIo(IoStatementState &io, - const Descriptor &descriptor, const typeInfo::DerivedType &derived, +bool DefinedUnformattedIo(IoStatementState &io, const Descriptor &descriptor, + const typeInfo::DerivedType &derived, const typeInfo::SpecialBinding &special) { // Unformatted I/O must have an external unit (or child thereof). IoErrorHandler &handler{io.GetIoErrorHandler()}; @@ -181,619 +152,5 @@ static RT_API_ATTRS bool DefinedUnformattedIo(IoStatementState &io, return handler.GetIoStat() == IostatOk; } -// Per-category descriptor-based I/O templates - -// TODO (perhaps as a nontrivial but small starter project): implement -// automatic repetition counts, like "10*3.14159", for list-directed and -// NAMELIST array output. - -template -inline RT_API_ATTRS bool FormattedIntegerIO(IoStatementState &io, - const Descriptor &descriptor, [[maybe_unused]] bool isSigned) { - std::size_t numElements{descriptor.Elements()}; - SubscriptValue subscripts[maxRank]; - descriptor.GetLowerBounds(subscripts); - using IntType = CppTypeFor; - bool anyInput{false}; - for (std::size_t j{0}; j < numElements; ++j) { - if (auto edit{io.GetNextDataEdit()}) { - IntType &x{ExtractElement(io, descriptor, subscripts)}; - if constexpr (DIR == Direction::Output) { - if (!EditIntegerOutput(io, *edit, x, isSigned)) { - return false; - } - } else if (edit->descriptor != DataEdit::ListDirectedNullValue) { - if (EditIntegerInput( - io, *edit, reinterpret_cast(&x), KIND, isSigned)) { - anyInput = true; - } else { - return anyInput && edit->IsNamelist(); - } - } - if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { - io.GetIoErrorHandler().Crash( - "FormattedIntegerIO: subscripts out of bounds"); - } - } else { - return false; - } - } - return true; -} - -template -inline RT_API_ATTRS bool FormattedRealIO( - IoStatementState &io, const Descriptor &descriptor) { - std::size_t numElements{descriptor.Elements()}; - SubscriptValue subscripts[maxRank]; - descriptor.GetLowerBounds(subscripts); - using RawType = typename RealOutputEditing::BinaryFloatingPoint; - bool anyInput{false}; - for (std::size_t j{0}; j < numElements; ++j) { - if (auto edit{io.GetNextDataEdit()}) { - RawType &x{ExtractElement(io, descriptor, subscripts)}; - if constexpr (DIR == Direction::Output) { - if (!RealOutputEditing{io, x}.Edit(*edit)) { - return false; - } - } else if (edit->descriptor != DataEdit::ListDirectedNullValue) { - if (EditRealInput(io, *edit, reinterpret_cast(&x))) { - anyInput = true; - } else { - return anyInput && edit->IsNamelist(); - } - } - if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { - io.GetIoErrorHandler().Crash( - "FormattedRealIO: subscripts out of bounds"); - } - } else { - return false; - } - } - return true; -} - -template -inline RT_API_ATTRS bool FormattedComplexIO( - IoStatementState &io, const Descriptor &descriptor) { - std::size_t numElements{descriptor.Elements()}; - SubscriptValue subscripts[maxRank]; - descriptor.GetLowerBounds(subscripts); - bool isListOutput{ - io.get_if>() != nullptr}; - using RawType = typename RealOutputEditing::BinaryFloatingPoint; - bool anyInput{false}; - for (std::size_t j{0}; j < numElements; ++j) { - RawType *x{&ExtractElement(io, descriptor, subscripts)}; - if (isListOutput) { - DataEdit rEdit, iEdit; - rEdit.descriptor = DataEdit::ListDirectedRealPart; - iEdit.descriptor = DataEdit::ListDirectedImaginaryPart; - rEdit.modes = iEdit.modes = io.mutableModes(); - if (!RealOutputEditing{io, x[0]}.Edit(rEdit) || - !RealOutputEditing{io, x[1]}.Edit(iEdit)) { - return false; - } - } else { - for (int k{0}; k < 2; ++k, ++x) { - auto edit{io.GetNextDataEdit()}; - if (!edit) { - return false; - } else if constexpr (DIR == Direction::Output) { - if (!RealOutputEditing{io, *x}.Edit(*edit)) { - return false; - } - } else if (edit->descriptor == DataEdit::ListDirectedNullValue) { - break; - } else if (EditRealInput( - io, *edit, reinterpret_cast(x))) { - anyInput = true; - } else { - return anyInput && edit->IsNamelist(); - } - } - } - if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { - io.GetIoErrorHandler().Crash( - "FormattedComplexIO: subscripts out of bounds"); - } - } - return true; -} - -template -inline RT_API_ATTRS bool FormattedCharacterIO( - IoStatementState &io, const Descriptor &descriptor) { - std::size_t numElements{descriptor.Elements()}; - SubscriptValue subscripts[maxRank]; - descriptor.GetLowerBounds(subscripts); - std::size_t length{descriptor.ElementBytes() / sizeof(A)}; - auto *listOutput{io.get_if>()}; - bool anyInput{false}; - for (std::size_t j{0}; j < numElements; ++j) { - A *x{&ExtractElement(io, descriptor, subscripts)}; - if (listOutput) { - if (!ListDirectedCharacterOutput(io, *listOutput, x, length)) { - return false; - } - } else if (auto edit{io.GetNextDataEdit()}) { - if constexpr (DIR == Direction::Output) { - if (!EditCharacterOutput(io, *edit, x, length)) { - return false; - } - } else { // input - if (edit->descriptor != DataEdit::ListDirectedNullValue) { - if (EditCharacterInput(io, *edit, x, length)) { - anyInput = true; - } else { - return anyInput && edit->IsNamelist(); - } - } - } - } else { - return false; - } - if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { - io.GetIoErrorHandler().Crash( - "FormattedCharacterIO: subscripts out of bounds"); - } - } - return true; -} - -template -inline RT_API_ATTRS bool FormattedLogicalIO( - IoStatementState &io, const Descriptor &descriptor) { - std::size_t numElements{descriptor.Elements()}; - SubscriptValue subscripts[maxRank]; - descriptor.GetLowerBounds(subscripts); - auto *listOutput{io.get_if>()}; - using IntType = CppTypeFor; - bool anyInput{false}; - for (std::size_t j{0}; j < numElements; ++j) { - IntType &x{ExtractElement(io, descriptor, subscripts)}; - if (listOutput) { - if (!ListDirectedLogicalOutput(io, *listOutput, x != 0)) { - return false; - } - } else if (auto edit{io.GetNextDataEdit()}) { - if constexpr (DIR == Direction::Output) { - if (!EditLogicalOutput(io, *edit, x != 0)) { - return false; - } - } else { - if (edit->descriptor != DataEdit::ListDirectedNullValue) { - bool truth{}; - if (EditLogicalInput(io, *edit, truth)) { - x = truth; - anyInput = true; - } else { - return anyInput && edit->IsNamelist(); - } - } - } - } else { - return false; - } - if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { - io.GetIoErrorHandler().Crash( - "FormattedLogicalIO: subscripts out of bounds"); - } - } - return true; -} - -template -RT_API_ATTRS int DerivedIoTicket::Continue(WorkQueue &workQueue) { - while (!IsComplete()) { - if (component_->genre() == typeInfo::Component::Genre::Data) { - // Create a descriptor for the component - Descriptor &compDesc{componentDescriptor_.descriptor()}; - component_->CreatePointerDescriptor( - compDesc, instance_, io_.GetIoErrorHandler(), subscripts_); - Advance(); - if (int status{workQueue.BeginDescriptorIo( - io_, compDesc, table_, anyIoTookPlace_)}; - status != StatOk) { - return status; - } - } else { - // Component is itself a descriptor - char *pointer{ - instance_.Element(subscripts_) + component_->offset()}; - const Descriptor &compDesc{ - *reinterpret_cast(pointer)}; - Advance(); - if (compDesc.IsAllocated()) { - if (int status{workQueue.BeginDescriptorIo( - io_, compDesc, table_, anyIoTookPlace_)}; - status != StatOk) { - return status; - } - } - } - } - return StatOk; -} - -template RT_API_ATTRS int DerivedIoTicket::Continue( - WorkQueue &); -template RT_API_ATTRS int DerivedIoTicket::Continue( - WorkQueue &); - -template -RT_API_ATTRS int DescriptorIoTicket::Begin(WorkQueue &workQueue) { - IoErrorHandler &handler{io_.GetIoErrorHandler()}; - if (handler.InError()) { - return handler.GetIoStat(); - } - if (!io_.get_if>()) { - handler.Crash("DescriptorIO() called for wrong I/O direction"); - return handler.GetIoStat(); - } - if constexpr (DIR == Direction::Input) { - if (!io_.BeginReadingRecord()) { - return StatOk; - } - } - if (!io_.get_if>()) { - // Unformatted I/O - IoErrorHandler &handler{io_.GetIoErrorHandler()}; - const DescriptorAddendum *addendum{instance_.Addendum()}; - if (const typeInfo::DerivedType *type{ - addendum ? addendum->derivedType() : nullptr}) { - // derived type unformatted I/O - if (table_) { - if (const auto *definedIo{table_->Find(*type, - DIR == Direction::Input - ? common::DefinedIo::ReadUnformatted - : common::DefinedIo::WriteUnformatted)}) { - if (definedIo->subroutine) { - typeInfo::SpecialBinding special{DIR == Direction::Input - ? typeInfo::SpecialBinding::Which::ReadUnformatted - : typeInfo::SpecialBinding::Which::WriteUnformatted, - definedIo->subroutine, definedIo->isDtvArgPolymorphic, false, - false}; - if (DefinedUnformattedIo(io_, instance_, *type, special)) { - anyIoTookPlace_ = true; - return StatOk; - } - } else { - int status{workQueue.BeginDerivedIo( - io_, instance_, *type, table_, anyIoTookPlace_)}; - return status == StatContinue ? StatOk : status; // done here - } - } - } - if (const typeInfo::SpecialBinding *special{ - type->FindSpecialBinding(DIR == Direction::Input - ? typeInfo::SpecialBinding::Which::ReadUnformatted - : typeInfo::SpecialBinding::Which::WriteUnformatted)}) { - if (!table_ || !table_->ignoreNonTbpEntries || special->isTypeBound()) { - // defined derived type unformatted I/O - if (DefinedUnformattedIo(io_, instance_, *type, *special)) { - anyIoTookPlace_ = true; - return StatOk; - } else { - return IostatEnd; - } - } - } - // Default derived type unformatted I/O - // TODO: If no component at any level has defined READ or WRITE - // (as appropriate), the elements are contiguous, and no byte swapping - // is active, do a block transfer via the code below. - int status{workQueue.BeginDerivedIo( - io_, instance_, *type, table_, anyIoTookPlace_)}; - return status == StatContinue ? StatOk : status; // done here - } else { - // intrinsic type unformatted I/O - auto *externalUnf{io_.get_if>()}; - ChildUnformattedIoStatementState *childUnf{nullptr}; - InquireIOLengthState *inq{nullptr}; - bool swapEndianness{false}; - if (externalUnf) { - swapEndianness = externalUnf->unit().swapEndianness(); - } else { - childUnf = io_.get_if>(); - if (!childUnf) { - inq = DIR == Direction::Output ? io_.get_if() - : nullptr; - RUNTIME_CHECK(handler, inq != nullptr); - } - } - std::size_t elementBytes{instance_.ElementBytes()}; - std::size_t swappingBytes{elementBytes}; - if (auto maybeCatAndKind{instance_.type().GetCategoryAndKind()}) { - // Byte swapping units can be smaller than elements, namely - // for COMPLEX and CHARACTER. - if (maybeCatAndKind->first == TypeCategory::Character) { - // swap each character position independently - swappingBytes = maybeCatAndKind->second; // kind - } else if (maybeCatAndKind->first == TypeCategory::Complex) { - // swap real and imaginary components independently - swappingBytes /= 2; - } - } - using CharType = - std::conditional_t; - auto Transfer{[=](CharType &x, std::size_t totalBytes) -> bool { - if constexpr (DIR == Direction::Output) { - return externalUnf ? externalUnf->Emit(&x, totalBytes, swappingBytes) - : childUnf ? childUnf->Emit(&x, totalBytes, swappingBytes) - : inq->Emit(&x, totalBytes, swappingBytes); - } else { - return externalUnf - ? externalUnf->Receive(&x, totalBytes, swappingBytes) - : childUnf->Receive(&x, totalBytes, swappingBytes); - } - }}; - if (!swapEndianness && - instance_.IsContiguous()) { // contiguous unformatted I/O - char &x{ExtractElement(io_, instance_, subscripts_)}; - if (Transfer(x, elements_ * elementBytes)) { - anyIoTookPlace_ = true; - } else { - return IostatEnd; - } - } else { // non-contiguous or byte-swapped intrinsic type unformatted I/O - for (; !IsComplete(); Advance()) { - char &x{ExtractElement(io_, instance_, subscripts_)}; - if (Transfer(x, elementBytes)) { - anyIoTookPlace_ = true; - } else { - return IostatEnd; - } - } - } - } - // Unformatted I/O never needs to call Continue(). - return StatOk; - } - // Formatted I/O - if (auto catAndKind{instance_.type().GetCategoryAndKind()}) { - TypeCategory cat{catAndKind->first}; - int kind{catAndKind->second}; - bool any{false}; - switch (cat) { - case TypeCategory::Integer: - switch (kind) { - case 1: - any = FormattedIntegerIO<1, DIR>(io_, instance_, true); - break; - case 2: - any = FormattedIntegerIO<2, DIR>(io_, instance_, true); - break; - case 4: - any = FormattedIntegerIO<4, DIR>(io_, instance_, true); - break; - case 8: - any = FormattedIntegerIO<8, DIR>(io_, instance_, true); - break; - case 16: - any = FormattedIntegerIO<16, DIR>(io_, instance_, true); - break; - default: - handler.Crash( - "not yet implemented: INTEGER(KIND=%d) in formatted IO", kind); - return IostatEnd; - } - break; - case TypeCategory::Unsigned: - switch (kind) { - case 1: - any = FormattedIntegerIO<1, DIR>(io_, instance_, false); - break; - case 2: - any = FormattedIntegerIO<2, DIR>(io_, instance_, false); - break; - case 4: - any = FormattedIntegerIO<4, DIR>(io_, instance_, false); - break; - case 8: - any = FormattedIntegerIO<8, DIR>(io_, instance_, false); - break; - case 16: - any = FormattedIntegerIO<16, DIR>(io_, instance_, false); - break; - default: - handler.Crash( - "not yet implemented: UNSIGNED(KIND=%d) in formatted IO", kind); - return IostatEnd; - } - break; - case TypeCategory::Real: - switch (kind) { - case 2: - any = FormattedRealIO<2, DIR>(io_, instance_); - break; - case 3: - any = FormattedRealIO<3, DIR>(io_, instance_); - break; - case 4: - any = FormattedRealIO<4, DIR>(io_, instance_); - break; - case 8: - any = FormattedRealIO<8, DIR>(io_, instance_); - break; - case 10: - any = FormattedRealIO<10, DIR>(io_, instance_); - break; - // TODO: case double/double - case 16: - any = FormattedRealIO<16, DIR>(io_, instance_); - break; - default: - handler.Crash( - "not yet implemented: REAL(KIND=%d) in formatted IO", kind); - return IostatEnd; - } - break; - case TypeCategory::Complex: - switch (kind) { - case 2: - any = FormattedComplexIO<2, DIR>(io_, instance_); - break; - case 3: - any = FormattedComplexIO<3, DIR>(io_, instance_); - break; - case 4: - any = FormattedComplexIO<4, DIR>(io_, instance_); - break; - case 8: - any = FormattedComplexIO<8, DIR>(io_, instance_); - break; - case 10: - any = FormattedComplexIO<10, DIR>(io_, instance_); - break; - // TODO: case double/double - case 16: - any = FormattedComplexIO<16, DIR>(io_, instance_); - break; - default: - handler.Crash( - "not yet implemented: COMPLEX(KIND=%d) in formatted IO", kind); - return IostatEnd; - } - break; - case TypeCategory::Character: - switch (kind) { - case 1: - any = FormattedCharacterIO(io_, instance_); - break; - case 2: - any = FormattedCharacterIO(io_, instance_); - break; - case 4: - any = FormattedCharacterIO(io_, instance_); - break; - default: - handler.Crash( - "not yet implemented: CHARACTER(KIND=%d) in formatted IO", kind); - return IostatEnd; - } - break; - case TypeCategory::Logical: - switch (kind) { - case 1: - any = FormattedLogicalIO<1, DIR>(io_, instance_); - break; - case 2: - any = FormattedLogicalIO<2, DIR>(io_, instance_); - break; - case 4: - any = FormattedLogicalIO<4, DIR>(io_, instance_); - break; - case 8: - any = FormattedLogicalIO<8, DIR>(io_, instance_); - break; - default: - handler.Crash( - "not yet implemented: LOGICAL(KIND=%d) in formatted IO", kind); - return IostatEnd; - } - break; - case TypeCategory::Derived: { - // Derived type information must be present for formatted I/O. - IoErrorHandler &handler{io_.GetIoErrorHandler()}; - const DescriptorAddendum *addendum{instance_.Addendum()}; - RUNTIME_CHECK(handler, addendum != nullptr); - derived_ = addendum->derivedType(); - RUNTIME_CHECK(handler, derived_ != nullptr); - if (table_) { - if (const auto *definedIo{table_->Find(*derived_, - DIR == Direction::Input ? common::DefinedIo::ReadFormatted - : common::DefinedIo::WriteFormatted)}) { - if (definedIo->subroutine) { - nonTbpSpecial_.emplace(DIR == Direction::Input - ? typeInfo::SpecialBinding::Which::ReadFormatted - : typeInfo::SpecialBinding::Which::WriteFormatted, - definedIo->subroutine, definedIo->isDtvArgPolymorphic, false, - false); - special_ = &*nonTbpSpecial_; - } - } - } - if (!special_) { - if (const typeInfo::SpecialBinding *binding{ - derived_->FindSpecialBinding(DIR == Direction::Input - ? typeInfo::SpecialBinding::Which::ReadFormatted - : typeInfo::SpecialBinding::Which::WriteFormatted)}) { - if (!table_ || !table_->ignoreNonTbpEntries || - binding->isTypeBound()) { - special_ = binding; - } - } - } - return StatContinue; - } - } - if (any) { - anyIoTookPlace_ = true; - } else { - return IostatEnd; - } - } else { - handler.Crash("DescriptorIO: bad type code (%d) in descriptor", - static_cast(instance_.type().raw())); - return handler.GetIoStat(); - } - return StatOk; -} - -template RT_API_ATTRS int DescriptorIoTicket::Begin( - WorkQueue &); -template RT_API_ATTRS int DescriptorIoTicket::Begin( - WorkQueue &); - -template -RT_API_ATTRS int DescriptorIoTicket::Continue(WorkQueue &workQueue) { - // Only derived type formatted I/O gets here. - while (!IsComplete()) { - if (special_) { - if (auto defined{DefinedFormattedIo( - io_, instance_, *derived_, *special_, subscripts_)}) { - anyIoTookPlace_ |= *defined; - Advance(); - continue; - } - } - Descriptor &elementDesc{elementDescriptor_.descriptor()}; - elementDesc.Establish( - *derived_, nullptr, 0, nullptr, CFI_attribute_pointer); - elementDesc.set_base_addr(instance_.Element(subscripts_)); - Advance(); - if (int status{workQueue.BeginDerivedIo( - io_, elementDesc, *derived_, table_, anyIoTookPlace_)}; - status != StatOk) { - return status; - } - } - return StatOk; -} - -template RT_API_ATTRS int DescriptorIoTicket::Continue( - WorkQueue &); -template RT_API_ATTRS int DescriptorIoTicket::Continue( - WorkQueue &); - -template -RT_API_ATTRS bool DescriptorIO(IoStatementState &io, - const Descriptor &descriptor, const NonTbpDefinedIoTable *table) { - bool anyIoTookPlace{false}; - WorkQueue workQueue{io.GetIoErrorHandler()}; - if (workQueue.BeginDescriptorIo(io, descriptor, table, anyIoTookPlace) == - StatContinue) { - workQueue.Run(); - } - return anyIoTookPlace; -} - -template RT_API_ATTRS bool DescriptorIO( - IoStatementState &, const Descriptor &, const NonTbpDefinedIoTable *); -template RT_API_ATTRS bool DescriptorIO( - IoStatementState &, const Descriptor &, const NonTbpDefinedIoTable *); - RT_OFFLOAD_API_GROUP_END } // namespace Fortran::runtime::io::descr diff --git a/flang-rt/lib/runtime/descriptor-io.h b/flang-rt/lib/runtime/descriptor-io.h index 88ad59bd24b53..eb60f106c9203 100644 --- a/flang-rt/lib/runtime/descriptor-io.h +++ b/flang-rt/lib/runtime/descriptor-io.h @@ -9,27 +9,619 @@ #ifndef FLANG_RT_RUNTIME_DESCRIPTOR_IO_H_ #define FLANG_RT_RUNTIME_DESCRIPTOR_IO_H_ -#include "flang-rt/runtime/connection.h" +// Implementation of I/O data list item transfers based on descriptors. +// (All I/O items come through here so that the code is exercised for test; +// some scalar I/O data transfer APIs could be changed to bypass their use +// of descriptors in the future for better efficiency.) -namespace Fortran::runtime { -class Descriptor; -} // namespace Fortran::runtime - -namespace Fortran::runtime::io { -class IoStatementState; -struct NonTbpDefinedIoTable; -} // namespace Fortran::runtime::io +#include "edit-input.h" +#include "edit-output.h" +#include "unit.h" +#include "flang-rt/runtime/descriptor.h" +#include "flang-rt/runtime/io-stmt.h" +#include "flang-rt/runtime/namelist.h" +#include "flang-rt/runtime/terminator.h" +#include "flang-rt/runtime/type-info.h" +#include "flang/Common/optional.h" +#include "flang/Common/uint128.h" +#include "flang/Runtime/cpp-type.h" namespace Fortran::runtime::io::descr { +template +inline RT_API_ATTRS A &ExtractElement(IoStatementState &io, + const Descriptor &descriptor, const SubscriptValue subscripts[]) { + A *p{descriptor.Element(subscripts)}; + if (!p) { + io.GetIoErrorHandler().Crash("Bad address for I/O item -- null base " + "address or subscripts out of range"); + } + return *p; +} + +// Per-category descriptor-based I/O templates + +// TODO (perhaps as a nontrivial but small starter project): implement +// automatic repetition counts, like "10*3.14159", for list-directed and +// NAMELIST array output. + +template +inline RT_API_ATTRS bool FormattedIntegerIO(IoStatementState &io, + const Descriptor &descriptor, [[maybe_unused]] bool isSigned) { + std::size_t numElements{descriptor.Elements()}; + SubscriptValue subscripts[maxRank]; + descriptor.GetLowerBounds(subscripts); + using IntType = CppTypeFor; + bool anyInput{false}; + for (std::size_t j{0}; j < numElements; ++j) { + if (auto edit{io.GetNextDataEdit()}) { + IntType &x{ExtractElement(io, descriptor, subscripts)}; + if constexpr (DIR == Direction::Output) { + if (!EditIntegerOutput(io, *edit, x, isSigned)) { + return false; + } + } else if (edit->descriptor != DataEdit::ListDirectedNullValue) { + if (EditIntegerInput( + io, *edit, reinterpret_cast(&x), KIND, isSigned)) { + anyInput = true; + } else { + return anyInput && edit->IsNamelist(); + } + } + if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { + io.GetIoErrorHandler().Crash( + "FormattedIntegerIO: subscripts out of bounds"); + } + } else { + return false; + } + } + return true; +} + +template +inline RT_API_ATTRS bool FormattedRealIO( + IoStatementState &io, const Descriptor &descriptor) { + std::size_t numElements{descriptor.Elements()}; + SubscriptValue subscripts[maxRank]; + descriptor.GetLowerBounds(subscripts); + using RawType = typename RealOutputEditing::BinaryFloatingPoint; + bool anyInput{false}; + for (std::size_t j{0}; j < numElements; ++j) { + if (auto edit{io.GetNextDataEdit()}) { + RawType &x{ExtractElement(io, descriptor, subscripts)}; + if constexpr (DIR == Direction::Output) { + if (!RealOutputEditing{io, x}.Edit(*edit)) { + return false; + } + } else if (edit->descriptor != DataEdit::ListDirectedNullValue) { + if (EditRealInput(io, *edit, reinterpret_cast(&x))) { + anyInput = true; + } else { + return anyInput && edit->IsNamelist(); + } + } + if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { + io.GetIoErrorHandler().Crash( + "FormattedRealIO: subscripts out of bounds"); + } + } else { + return false; + } + } + return true; +} + +template +inline RT_API_ATTRS bool FormattedComplexIO( + IoStatementState &io, const Descriptor &descriptor) { + std::size_t numElements{descriptor.Elements()}; + SubscriptValue subscripts[maxRank]; + descriptor.GetLowerBounds(subscripts); + bool isListOutput{ + io.get_if>() != nullptr}; + using RawType = typename RealOutputEditing::BinaryFloatingPoint; + bool anyInput{false}; + for (std::size_t j{0}; j < numElements; ++j) { + RawType *x{&ExtractElement(io, descriptor, subscripts)}; + if (isListOutput) { + DataEdit rEdit, iEdit; + rEdit.descriptor = DataEdit::ListDirectedRealPart; + iEdit.descriptor = DataEdit::ListDirectedImaginaryPart; + rEdit.modes = iEdit.modes = io.mutableModes(); + if (!RealOutputEditing{io, x[0]}.Edit(rEdit) || + !RealOutputEditing{io, x[1]}.Edit(iEdit)) { + return false; + } + } else { + for (int k{0}; k < 2; ++k, ++x) { + auto edit{io.GetNextDataEdit()}; + if (!edit) { + return false; + } else if constexpr (DIR == Direction::Output) { + if (!RealOutputEditing{io, *x}.Edit(*edit)) { + return false; + } + } else if (edit->descriptor == DataEdit::ListDirectedNullValue) { + break; + } else if (EditRealInput( + io, *edit, reinterpret_cast(x))) { + anyInput = true; + } else { + return anyInput && edit->IsNamelist(); + } + } + } + if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { + io.GetIoErrorHandler().Crash( + "FormattedComplexIO: subscripts out of bounds"); + } + } + return true; +} + +template +inline RT_API_ATTRS bool FormattedCharacterIO( + IoStatementState &io, const Descriptor &descriptor) { + std::size_t numElements{descriptor.Elements()}; + SubscriptValue subscripts[maxRank]; + descriptor.GetLowerBounds(subscripts); + std::size_t length{descriptor.ElementBytes() / sizeof(A)}; + auto *listOutput{io.get_if>()}; + bool anyInput{false}; + for (std::size_t j{0}; j < numElements; ++j) { + A *x{&ExtractElement(io, descriptor, subscripts)}; + if (listOutput) { + if (!ListDirectedCharacterOutput(io, *listOutput, x, length)) { + return false; + } + } else if (auto edit{io.GetNextDataEdit()}) { + if constexpr (DIR == Direction::Output) { + if (!EditCharacterOutput(io, *edit, x, length)) { + return false; + } + } else { // input + if (edit->descriptor != DataEdit::ListDirectedNullValue) { + if (EditCharacterInput(io, *edit, x, length)) { + anyInput = true; + } else { + return anyInput && edit->IsNamelist(); + } + } + } + } else { + return false; + } + if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { + io.GetIoErrorHandler().Crash( + "FormattedCharacterIO: subscripts out of bounds"); + } + } + return true; +} + +template +inline RT_API_ATTRS bool FormattedLogicalIO( + IoStatementState &io, const Descriptor &descriptor) { + std::size_t numElements{descriptor.Elements()}; + SubscriptValue subscripts[maxRank]; + descriptor.GetLowerBounds(subscripts); + auto *listOutput{io.get_if>()}; + using IntType = CppTypeFor; + bool anyInput{false}; + for (std::size_t j{0}; j < numElements; ++j) { + IntType &x{ExtractElement(io, descriptor, subscripts)}; + if (listOutput) { + if (!ListDirectedLogicalOutput(io, *listOutput, x != 0)) { + return false; + } + } else if (auto edit{io.GetNextDataEdit()}) { + if constexpr (DIR == Direction::Output) { + if (!EditLogicalOutput(io, *edit, x != 0)) { + return false; + } + } else { + if (edit->descriptor != DataEdit::ListDirectedNullValue) { + bool truth{}; + if (EditLogicalInput(io, *edit, truth)) { + x = truth; + anyInput = true; + } else { + return anyInput && edit->IsNamelist(); + } + } + } + } else { + return false; + } + if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) { + io.GetIoErrorHandler().Crash( + "FormattedLogicalIO: subscripts out of bounds"); + } + } + return true; +} template -RT_API_ATTRS bool DescriptorIO(IoStatementState &, const Descriptor &, +static RT_API_ATTRS bool DescriptorIO(IoStatementState &, const Descriptor &, const NonTbpDefinedIoTable * = nullptr); -extern template RT_API_ATTRS bool DescriptorIO( - IoStatementState &, const Descriptor &, const NonTbpDefinedIoTable *); -extern template RT_API_ATTRS bool DescriptorIO( - IoStatementState &, const Descriptor &, const NonTbpDefinedIoTable *); +// For intrinsic (not defined) derived type I/O, formatted & unformatted +template +static RT_API_ATTRS bool DefaultComponentIO(IoStatementState &io, + const typeInfo::Component &component, const Descriptor &origDescriptor, + const SubscriptValue origSubscripts[], Terminator &terminator, + const NonTbpDefinedIoTable *table) { +#if !defined(RT_DEVICE_AVOID_RECURSION) + if (component.genre() == typeInfo::Component::Genre::Data) { + // Create a descriptor for the component + StaticDescriptor statDesc; + Descriptor &desc{statDesc.descriptor()}; + component.CreatePointerDescriptor( + desc, origDescriptor, terminator, origSubscripts); + return DescriptorIO(io, desc, table); + } else { + // Component is itself a descriptor + char *pointer{ + origDescriptor.Element(origSubscripts) + component.offset()}; + const Descriptor &compDesc{*reinterpret_cast(pointer)}; + return compDesc.IsAllocated() && DescriptorIO(io, compDesc, table); + } +#else + terminator.Crash("not yet implemented: component IO"); +#endif +} + +template +static RT_API_ATTRS bool DefaultComponentwiseFormattedIO(IoStatementState &io, + const Descriptor &descriptor, const typeInfo::DerivedType &type, + const NonTbpDefinedIoTable *table, const SubscriptValue subscripts[]) { + IoErrorHandler &handler{io.GetIoErrorHandler()}; + const Descriptor &compArray{type.component()}; + RUNTIME_CHECK(handler, compArray.rank() == 1); + std::size_t numComponents{compArray.Elements()}; + SubscriptValue at[maxRank]; + compArray.GetLowerBounds(at); + for (std::size_t k{0}; k < numComponents; + ++k, compArray.IncrementSubscripts(at)) { + const typeInfo::Component &component{ + *compArray.Element(at)}; + if (!DefaultComponentIO( + io, component, descriptor, subscripts, handler, table)) { + // Return true for NAMELIST input if any component appeared. + auto *listInput{ + io.get_if>()}; + return DIR == Direction::Input && k > 0 && listInput && + listInput->inNamelistSequence(); + } + } + return true; +} + +template +static RT_API_ATTRS bool DefaultComponentwiseUnformattedIO(IoStatementState &io, + const Descriptor &descriptor, const typeInfo::DerivedType &type, + const NonTbpDefinedIoTable *table) { + IoErrorHandler &handler{io.GetIoErrorHandler()}; + const Descriptor &compArray{type.component()}; + RUNTIME_CHECK(handler, compArray.rank() == 1); + std::size_t numComponents{compArray.Elements()}; + std::size_t numElements{descriptor.Elements()}; + SubscriptValue subscripts[maxRank]; + descriptor.GetLowerBounds(subscripts); + for (std::size_t j{0}; j < numElements; + ++j, descriptor.IncrementSubscripts(subscripts)) { + SubscriptValue at[maxRank]; + compArray.GetLowerBounds(at); + for (std::size_t k{0}; k < numComponents; + ++k, compArray.IncrementSubscripts(at)) { + const typeInfo::Component &component{ + *compArray.Element(at)}; + if (!DefaultComponentIO( + io, component, descriptor, subscripts, handler, table)) { + return false; + } + } + } + return true; +} + +RT_API_ATTRS Fortran::common::optional DefinedFormattedIo( + IoStatementState &, const Descriptor &, const typeInfo::DerivedType &, + const typeInfo::SpecialBinding &, const SubscriptValue[]); + +template +static RT_API_ATTRS bool FormattedDerivedTypeIO(IoStatementState &io, + const Descriptor &descriptor, const NonTbpDefinedIoTable *table) { + IoErrorHandler &handler{io.GetIoErrorHandler()}; + // Derived type information must be present for formatted I/O. + const DescriptorAddendum *addendum{descriptor.Addendum()}; + RUNTIME_CHECK(handler, addendum != nullptr); + const typeInfo::DerivedType *type{addendum->derivedType()}; + RUNTIME_CHECK(handler, type != nullptr); + Fortran::common::optional nonTbpSpecial; + const typeInfo::SpecialBinding *special{nullptr}; + if (table) { + if (const auto *definedIo{table->Find(*type, + DIR == Direction::Input ? common::DefinedIo::ReadFormatted + : common::DefinedIo::WriteFormatted)}) { + if (definedIo->subroutine) { + nonTbpSpecial.emplace(DIR == Direction::Input + ? typeInfo::SpecialBinding::Which::ReadFormatted + : typeInfo::SpecialBinding::Which::WriteFormatted, + definedIo->subroutine, definedIo->isDtvArgPolymorphic, false, + false); + special = &*nonTbpSpecial; + } + } + } + if (!special) { + if (const typeInfo::SpecialBinding * + binding{type->FindSpecialBinding(DIR == Direction::Input + ? typeInfo::SpecialBinding::Which::ReadFormatted + : typeInfo::SpecialBinding::Which::WriteFormatted)}) { + if (!table || !table->ignoreNonTbpEntries || binding->isTypeBound()) { + special = binding; + } + } + } + SubscriptValue subscripts[maxRank]; + descriptor.GetLowerBounds(subscripts); + std::size_t numElements{descriptor.Elements()}; + for (std::size_t j{0}; j < numElements; + ++j, descriptor.IncrementSubscripts(subscripts)) { + Fortran::common::optional result; + if (special) { + result = DefinedFormattedIo(io, descriptor, *type, *special, subscripts); + } + if (!result) { + result = DefaultComponentwiseFormattedIO( + io, descriptor, *type, table, subscripts); + } + if (!result.value()) { + // Return true for NAMELIST input if we got anything. + auto *listInput{ + io.get_if>()}; + return DIR == Direction::Input && j > 0 && listInput && + listInput->inNamelistSequence(); + } + } + return true; +} + +RT_API_ATTRS bool DefinedUnformattedIo(IoStatementState &, const Descriptor &, + const typeInfo::DerivedType &, const typeInfo::SpecialBinding &); +// Unformatted I/O +template +static RT_API_ATTRS bool UnformattedDescriptorIO(IoStatementState &io, + const Descriptor &descriptor, const NonTbpDefinedIoTable *table = nullptr) { + IoErrorHandler &handler{io.GetIoErrorHandler()}; + const DescriptorAddendum *addendum{descriptor.Addendum()}; + if (const typeInfo::DerivedType * + type{addendum ? addendum->derivedType() : nullptr}) { + // derived type unformatted I/O + if (table) { + if (const auto *definedIo{table->Find(*type, + DIR == Direction::Input ? common::DefinedIo::ReadUnformatted + : common::DefinedIo::WriteUnformatted)}) { + if (definedIo->subroutine) { + typeInfo::SpecialBinding special{DIR == Direction::Input + ? typeInfo::SpecialBinding::Which::ReadUnformatted + : typeInfo::SpecialBinding::Which::WriteUnformatted, + definedIo->subroutine, definedIo->isDtvArgPolymorphic, false, + false}; + if (Fortran::common::optional wasDefined{ + DefinedUnformattedIo(io, descriptor, *type, special)}) { + return *wasDefined; + } + } else { + return DefaultComponentwiseUnformattedIO( + io, descriptor, *type, table); + } + } + } + if (const typeInfo::SpecialBinding * + special{type->FindSpecialBinding(DIR == Direction::Input + ? typeInfo::SpecialBinding::Which::ReadUnformatted + : typeInfo::SpecialBinding::Which::WriteUnformatted)}) { + if (!table || !table->ignoreNonTbpEntries || special->isTypeBound()) { + // defined derived type unformatted I/O + return DefinedUnformattedIo(io, descriptor, *type, *special); + } + } + // Default derived type unformatted I/O + // TODO: If no component at any level has defined READ or WRITE + // (as appropriate), the elements are contiguous, and no byte swapping + // is active, do a block transfer via the code below. + return DefaultComponentwiseUnformattedIO(io, descriptor, *type, table); + } else { + // intrinsic type unformatted I/O + auto *externalUnf{io.get_if>()}; + auto *childUnf{io.get_if>()}; + auto *inq{ + DIR == Direction::Output ? io.get_if() : nullptr}; + RUNTIME_CHECK(handler, externalUnf || childUnf || inq); + std::size_t elementBytes{descriptor.ElementBytes()}; + std::size_t numElements{descriptor.Elements()}; + std::size_t swappingBytes{elementBytes}; + if (auto maybeCatAndKind{descriptor.type().GetCategoryAndKind()}) { + // Byte swapping units can be smaller than elements, namely + // for COMPLEX and CHARACTER. + if (maybeCatAndKind->first == TypeCategory::Character) { + // swap each character position independently + swappingBytes = maybeCatAndKind->second; // kind + } else if (maybeCatAndKind->first == TypeCategory::Complex) { + // swap real and imaginary components independently + swappingBytes /= 2; + } + } + SubscriptValue subscripts[maxRank]; + descriptor.GetLowerBounds(subscripts); + using CharType = + std::conditional_t; + auto Transfer{[=](CharType &x, std::size_t totalBytes) -> bool { + if constexpr (DIR == Direction::Output) { + return externalUnf ? externalUnf->Emit(&x, totalBytes, swappingBytes) + : childUnf ? childUnf->Emit(&x, totalBytes, swappingBytes) + : inq->Emit(&x, totalBytes, swappingBytes); + } else { + return externalUnf ? externalUnf->Receive(&x, totalBytes, swappingBytes) + : childUnf->Receive(&x, totalBytes, swappingBytes); + } + }}; + bool swapEndianness{externalUnf && externalUnf->unit().swapEndianness()}; + if (!swapEndianness && + descriptor.IsContiguous()) { // contiguous unformatted I/O + char &x{ExtractElement(io, descriptor, subscripts)}; + return Transfer(x, numElements * elementBytes); + } else { // non-contiguous or byte-swapped intrinsic type unformatted I/O + for (std::size_t j{0}; j < numElements; ++j) { + char &x{ExtractElement(io, descriptor, subscripts)}; + if (!Transfer(x, elementBytes)) { + return false; + } + if (!descriptor.IncrementSubscripts(subscripts) && + j + 1 < numElements) { + handler.Crash("DescriptorIO: subscripts out of bounds"); + } + } + return true; + } + } +} + +template +static RT_API_ATTRS bool DescriptorIO(IoStatementState &io, + const Descriptor &descriptor, const NonTbpDefinedIoTable *table) { + IoErrorHandler &handler{io.GetIoErrorHandler()}; + if (handler.InError()) { + return false; + } + if (!io.get_if>()) { + handler.Crash("DescriptorIO() called for wrong I/O direction"); + return false; + } + if constexpr (DIR == Direction::Input) { + if (!io.BeginReadingRecord()) { + return false; + } + } + if (!io.get_if>()) { + return UnformattedDescriptorIO(io, descriptor, table); + } + if (auto catAndKind{descriptor.type().GetCategoryAndKind()}) { + TypeCategory cat{catAndKind->first}; + int kind{catAndKind->second}; + switch (cat) { + case TypeCategory::Integer: + switch (kind) { + case 1: + return FormattedIntegerIO<1, DIR>(io, descriptor, true); + case 2: + return FormattedIntegerIO<2, DIR>(io, descriptor, true); + case 4: + return FormattedIntegerIO<4, DIR>(io, descriptor, true); + case 8: + return FormattedIntegerIO<8, DIR>(io, descriptor, true); + case 16: + return FormattedIntegerIO<16, DIR>(io, descriptor, true); + default: + handler.Crash( + "not yet implemented: INTEGER(KIND=%d) in formatted IO", kind); + return false; + } + case TypeCategory::Unsigned: + switch (kind) { + case 1: + return FormattedIntegerIO<1, DIR>(io, descriptor, false); + case 2: + return FormattedIntegerIO<2, DIR>(io, descriptor, false); + case 4: + return FormattedIntegerIO<4, DIR>(io, descriptor, false); + case 8: + return FormattedIntegerIO<8, DIR>(io, descriptor, false); + case 16: + return FormattedIntegerIO<16, DIR>(io, descriptor, false); + default: + handler.Crash( + "not yet implemented: UNSIGNED(KIND=%d) in formatted IO", kind); + return false; + } + case TypeCategory::Real: + switch (kind) { + case 2: + return FormattedRealIO<2, DIR>(io, descriptor); + case 3: + return FormattedRealIO<3, DIR>(io, descriptor); + case 4: + return FormattedRealIO<4, DIR>(io, descriptor); + case 8: + return FormattedRealIO<8, DIR>(io, descriptor); + case 10: + return FormattedRealIO<10, DIR>(io, descriptor); + // TODO: case double/double + case 16: + return FormattedRealIO<16, DIR>(io, descriptor); + default: + handler.Crash( + "not yet implemented: REAL(KIND=%d) in formatted IO", kind); + return false; + } + case TypeCategory::Complex: + switch (kind) { + case 2: + return FormattedComplexIO<2, DIR>(io, descriptor); + case 3: + return FormattedComplexIO<3, DIR>(io, descriptor); + case 4: + return FormattedComplexIO<4, DIR>(io, descriptor); + case 8: + return FormattedComplexIO<8, DIR>(io, descriptor); + case 10: + return FormattedComplexIO<10, DIR>(io, descriptor); + // TODO: case double/double + case 16: + return FormattedComplexIO<16, DIR>(io, descriptor); + default: + handler.Crash( + "not yet implemented: COMPLEX(KIND=%d) in formatted IO", kind); + return false; + } + case TypeCategory::Character: + switch (kind) { + case 1: + return FormattedCharacterIO(io, descriptor); + case 2: + return FormattedCharacterIO(io, descriptor); + case 4: + return FormattedCharacterIO(io, descriptor); + default: + handler.Crash( + "not yet implemented: CHARACTER(KIND=%d) in formatted IO", kind); + return false; + } + case TypeCategory::Logical: + switch (kind) { + case 1: + return FormattedLogicalIO<1, DIR>(io, descriptor); + case 2: + return FormattedLogicalIO<2, DIR>(io, descriptor); + case 4: + return FormattedLogicalIO<4, DIR>(io, descriptor); + case 8: + return FormattedLogicalIO<8, DIR>(io, descriptor); + default: + handler.Crash( + "not yet implemented: LOGICAL(KIND=%d) in formatted IO", kind); + return false; + } + case TypeCategory::Derived: + return FormattedDerivedTypeIO(io, descriptor, table); + } + } + handler.Crash("DescriptorIO: bad type code (%d) in descriptor", + static_cast(descriptor.type().raw())); + return false; +} } // namespace Fortran::runtime::io::descr #endif // FLANG_RT_RUNTIME_DESCRIPTOR_IO_H_ diff --git a/flang-rt/lib/runtime/environment.cpp b/flang-rt/lib/runtime/environment.cpp index 0f0564403c0e2..1d5304254ed0e 100644 --- a/flang-rt/lib/runtime/environment.cpp +++ b/flang-rt/lib/runtime/environment.cpp @@ -143,10 +143,6 @@ void ExecutionEnvironment::Configure(int ac, const char *av[], } } - if (auto *x{std::getenv("FLANG_RT_DEBUG")}) { - internalDebugging = std::strtol(x, nullptr, 10); - } - if (auto *x{std::getenv("ACC_OFFLOAD_STACK_SIZE")}) { char *end; auto n{std::strtoul(x, &end, 10)}; diff --git a/flang-rt/lib/runtime/namelist.cpp b/flang-rt/lib/runtime/namelist.cpp index 1bef387a9771f..b0cf2180fc6d4 100644 --- a/flang-rt/lib/runtime/namelist.cpp +++ b/flang-rt/lib/runtime/namelist.cpp @@ -10,7 +10,6 @@ #include "descriptor-io.h" #include "flang-rt/runtime/emit-encoded.h" #include "flang-rt/runtime/io-stmt.h" -#include "flang-rt/runtime/type-info.h" #include "flang/Runtime/io-api.h" #include #include diff --git a/flang-rt/lib/runtime/tools.cpp b/flang-rt/lib/runtime/tools.cpp index 24d05f369fcbe..b08195cd31e05 100644 --- a/flang-rt/lib/runtime/tools.cpp +++ b/flang-rt/lib/runtime/tools.cpp @@ -205,7 +205,7 @@ RT_API_ATTRS void ShallowCopyInner(const Descriptor &to, const Descriptor &from, // Doing the recursion upwards instead of downwards puts the more common // cases earlier in the if-chain and has a tangible impact on performance. template struct ShallowCopyRankSpecialize { - static RT_API_ATTRS bool execute(const Descriptor &to, const Descriptor &from, + static bool execute(const Descriptor &to, const Descriptor &from, bool toIsContiguous, bool fromIsContiguous) { if (to.rank() == RANK && from.rank() == RANK) { ShallowCopyInner(to, from, toIsContiguous, fromIsContiguous); @@ -217,7 +217,7 @@ template struct ShallowCopyRankSpecialize { }; template struct ShallowCopyRankSpecialize { - static RT_API_ATTRS bool execute(const Descriptor &to, const Descriptor &from, + static bool execute(const Descriptor &to, const Descriptor &from, bool toIsContiguous, bool fromIsContiguous) { return false; } diff --git a/flang-rt/lib/runtime/type-info.cpp b/flang-rt/lib/runtime/type-info.cpp index 451213202acef..82182696d70c6 100644 --- a/flang-rt/lib/runtime/type-info.cpp +++ b/flang-rt/lib/runtime/type-info.cpp @@ -140,11 +140,11 @@ RT_API_ATTRS void Component::CreatePointerDescriptor(Descriptor &descriptor, const SubscriptValue *subscripts) const { RUNTIME_CHECK(terminator, genre_ == Genre::Data); EstablishDescriptor(descriptor, container, terminator); - std::size_t offset{offset_}; if (subscripts) { - offset += container.SubscriptsToByteOffset(subscripts); + descriptor.set_base_addr(container.Element(subscripts) + offset_); + } else { + descriptor.set_base_addr(container.OffsetElement() + offset_); } - descriptor.set_base_addr(container.OffsetElement() + offset); descriptor.raw().attribute = CFI_attribute_pointer; } diff --git a/flang-rt/lib/runtime/work-queue.cpp b/flang-rt/lib/runtime/work-queue.cpp deleted file mode 100644 index a508ecb637102..0000000000000 --- a/flang-rt/lib/runtime/work-queue.cpp +++ /dev/null @@ -1,161 +0,0 @@ -//===-- lib/runtime/work-queue.cpp ------------------------------*- C++ -*-===// -// -// 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 -// -//===----------------------------------------------------------------------===// - -#include "flang-rt/runtime/work-queue.h" -#include "flang-rt/runtime/environment.h" -#include "flang-rt/runtime/memory.h" -#include "flang-rt/runtime/type-info.h" -#include "flang/Common/visit.h" - -namespace Fortran::runtime { - -#if !defined(RT_DEVICE_COMPILATION) -// FLANG_RT_DEBUG code is disabled when false. -static constexpr bool enableDebugOutput{false}; -#endif - -RT_OFFLOAD_API_GROUP_BEGIN - -RT_API_ATTRS Componentwise::Componentwise(const typeInfo::DerivedType &derived) - : derived_{derived}, components_{derived_.component().Elements()} { - GetComponent(); -} - -RT_API_ATTRS void Componentwise::GetComponent() { - if (IsComplete()) { - component_ = nullptr; - } else { - const Descriptor &componentDesc{derived_.component()}; - component_ = componentDesc.ZeroBasedIndexedElement( - componentAt_); - } -} - -RT_API_ATTRS int Ticket::Continue(WorkQueue &workQueue) { - if (!begun) { - begun = true; - return common::visit( - [&workQueue]( - auto &specificTicket) { return specificTicket.Begin(workQueue); }, - u); - } else { - return common::visit( - [&workQueue](auto &specificTicket) { - return specificTicket.Continue(workQueue); - }, - u); - } -} - -RT_API_ATTRS WorkQueue::~WorkQueue() { - if (last_) { - if ((last_->next = firstFree_)) { - last_->next->previous = last_; - } - firstFree_ = first_; - first_ = last_ = nullptr; - } - while (firstFree_) { - TicketList *next{firstFree_->next}; - if (!firstFree_->isStatic) { - FreeMemory(firstFree_); - } - firstFree_ = next; - } -} - -RT_API_ATTRS Ticket &WorkQueue::StartTicket() { - if (!firstFree_) { - void *p{AllocateMemoryOrCrash(terminator_, sizeof(TicketList))}; - firstFree_ = new (p) TicketList; - firstFree_->isStatic = false; - } - TicketList *newTicket{firstFree_}; - if ((firstFree_ = newTicket->next)) { - firstFree_->previous = nullptr; - } - TicketList *after{insertAfter_ ? insertAfter_->next : nullptr}; - if ((newTicket->previous = insertAfter_ ? insertAfter_ : last_)) { - newTicket->previous->next = newTicket; - } else { - first_ = newTicket; - } - if ((newTicket->next = after)) { - after->previous = newTicket; - } else { - last_ = newTicket; - } - newTicket->ticket.begun = false; -#if !defined(RT_DEVICE_COMPILATION) - if (enableDebugOutput && - (executionEnvironment.internalDebugging & - ExecutionEnvironment::WorkQueue)) { - std::fprintf(stderr, "WQ: new ticket\n"); - } -#endif - return newTicket->ticket; -} - -RT_API_ATTRS int WorkQueue::Run() { - while (last_) { - TicketList *at{last_}; - insertAfter_ = last_; -#if !defined(RT_DEVICE_COMPILATION) - if (enableDebugOutput && - (executionEnvironment.internalDebugging & - ExecutionEnvironment::WorkQueue)) { - std::fprintf(stderr, "WQ: %zd %s\n", at->ticket.u.index(), - at->ticket.begun ? "Continue" : "Begin"); - } -#endif - int stat{at->ticket.Continue(*this)}; -#if !defined(RT_DEVICE_COMPILATION) - if (enableDebugOutput && - (executionEnvironment.internalDebugging & - ExecutionEnvironment::WorkQueue)) { - std::fprintf(stderr, "WQ: ... stat %d\n", stat); - } -#endif - insertAfter_ = nullptr; - if (stat == StatOk) { - if (at->previous) { - at->previous->next = at->next; - } else { - first_ = at->next; - } - if (at->next) { - at->next->previous = at->previous; - } else { - last_ = at->previous; - } - if ((at->next = firstFree_)) { - at->next->previous = at; - } - at->previous = nullptr; - firstFree_ = at; - } else if (stat != StatContinue) { - Stop(); - return stat; - } - } - return StatOk; -} - -RT_API_ATTRS void WorkQueue::Stop() { - if (last_) { - if ((last_->next = firstFree_)) { - last_->next->previous = last_; - } - firstFree_ = first_; - first_ = last_ = nullptr; - } -} - -RT_OFFLOAD_API_GROUP_END - -} // namespace Fortran::runtime diff --git a/flang-rt/unittests/Runtime/ExternalIOTest.cpp b/flang-rt/unittests/Runtime/ExternalIOTest.cpp index 6c148b1de6f82..3833e48be3dd6 100644 --- a/flang-rt/unittests/Runtime/ExternalIOTest.cpp +++ b/flang-rt/unittests/Runtime/ExternalIOTest.cpp @@ -184,7 +184,7 @@ TEST(ExternalIOTests, TestSequentialFixedUnformatted) { io = IONAME(BeginInquireIoLength)(__FILE__, __LINE__); for (int j{1}; j <= 3; ++j) { ASSERT_TRUE(IONAME(OutputDescriptor)(io, desc)) - << "OutputDescriptor() for InquireIoLength " << j; + << "OutputDescriptor() for InquireIoLength"; } ASSERT_EQ(IONAME(GetIoLength)(io), 3 * recl) << "GetIoLength"; ASSERT_EQ(IONAME(EndIoStatement)(io), IostatOk) diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md index 871749934810c..78d871c593e1d 100644 --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -858,16 +858,6 @@ print *, [(j,j=1,10)] warning since such values may have become defined by the time the nested expression's value is required. -* Intrinsic assignment of arrays is defined elementally, and intrinsic - assignment of derived type components is defined componentwise. - However, when intrinsic assignment takes place for an array of derived - type, the order of the loop nesting is not defined. - Some compilers will loop over the elements, assigning all of the components - of each element before proceeding to the next element. - This compiler loops over all of the components, and assigns all of - the elements for each component before proceeding to the next component. - A program using defined assignment might be able to detect the difference. - ## De Facto Standard Features * `EXTENDS_TYPE_OF()` returns `.TRUE.` if both of its arguments have the diff --git a/flang/include/flang/Runtime/assign.h b/flang/include/flang/Runtime/assign.h index eb1f63184a177..bc80997a1bec2 100644 --- a/flang/include/flang/Runtime/assign.h +++ b/flang/include/flang/Runtime/assign.h @@ -38,7 +38,7 @@ enum AssignFlags { ComponentCanBeDefinedAssignment = 1 << 3, ExplicitLengthCharacterLHS = 1 << 4, PolymorphicLHS = 1 << 5, - DeallocateLHS = 1 << 6, + DeallocateLHS = 1 << 6 }; #ifdef RT_DEVICE_COMPILATION diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h index 51df7c40f5b8b..4b2bb4fa167f8 100644 --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -182,12 +182,9 @@ const Symbol *HasImpureFinal( const Symbol &, std::optional rank = std::nullopt); // Is this type finalizable or does it contain any polymorphic allocatable // ultimate components? -bool MayRequireFinalization(const DerivedTypeSpec &); +bool MayRequireFinalization(const DerivedTypeSpec &derived); // Does this type have an allocatable direct component? -bool HasAllocatableDirectComponent(const DerivedTypeSpec &); -// Does this type have any defined assignment at any level (or any polymorphic -// allocatable)? -bool MayHaveDefinedAssignment(const DerivedTypeSpec &); +bool HasAllocatableDirectComponent(const DerivedTypeSpec &derived); bool IsInBlankCommon(const Symbol &); bool IsAssumedLengthCharacter(const Symbol &); diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp index 4c186f4874152..26ae81f97895a 100644 --- a/flang/lib/Semantics/runtime-type-info.cpp +++ b/flang/lib/Semantics/runtime-type-info.cpp @@ -661,10 +661,6 @@ const Symbol *RuntimeTableBuilder::DescribeType( AddValue(dtValues, derivedTypeSchema_, "nofinalizationneeded"s, IntExpr<1>( derivedTypeSpec && !MayRequireFinalization(*derivedTypeSpec))); - // Similarly, a flag to enable optimized runtime assignment. - AddValue(dtValues, derivedTypeSchema_, "nodefinedassignment"s, - IntExpr<1>( - derivedTypeSpec && !MayHaveDefinedAssignment(*derivedTypeSpec))); } dtObject.get().set_init(MaybeExpr{ StructureExpr(Structure(derivedTypeSchema_, std::move(dtValues)))}); diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index ea5ab2d455b54..ac69e6ff5cb79 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -813,38 +813,6 @@ bool HasAllocatableDirectComponent(const DerivedTypeSpec &derived) { return std::any_of(directs.begin(), directs.end(), IsAllocatable); } -static bool MayHaveDefinedAssignment( - const DerivedTypeSpec &derived, std::set &checked) { - if (const Scope *scope{derived.GetScope()}; - scope && checked.find(scope) == checked.end()) { - checked.insert(scope); - for (const auto &[_, symbolRef] : *scope) { - if (const auto *generic{symbolRef->detailsIf()}) { - if (generic->kind().IsAssignment()) { - return true; - } - } else if (symbolRef->has() && - !IsPointer(*symbolRef)) { - if (const DeclTypeSpec *type{symbolRef->GetType()}) { - if (type->IsPolymorphic()) { - return true; - } else if (const DerivedTypeSpec *derived{type->AsDerived()}) { - if (MayHaveDefinedAssignment(*derived, checked)) { - return true; - } - } - } - } - } - } - return false; -} - -bool MayHaveDefinedAssignment(const DerivedTypeSpec &derived) { - std::set checked; - return MayHaveDefinedAssignment(derived, checked); -} - bool IsAssumedLengthCharacter(const Symbol &symbol) { if (const DeclTypeSpec * type{symbol.GetType()}) { return type->category() == DeclTypeSpec::Character && diff --git a/flang/module/__fortran_type_info.f90 b/flang/module/__fortran_type_info.f90 index 7226b06504d28..b30a6bf697563 100644 --- a/flang/module/__fortran_type_info.f90 +++ b/flang/module/__fortran_type_info.f90 @@ -52,8 +52,7 @@ integer(1) :: noInitializationNeeded ! 1 if no component w/ init integer(1) :: noDestructionNeeded ! 1 if no component w/ dealloc/final integer(1) :: noFinalizationNeeded ! 1 if nothing finalizeable - integer(1) :: noDefinedAssignment ! 1 if no defined ASSIGNMENT(=) - integer(1) :: __padding0(3) + integer(1) :: __padding0(4) end type type :: Binding diff --git a/flang/test/Lower/volatile-openmp.f90 b/flang/test/Lower/volatile-openmp.f90 index 2e05b652822b5..28f0bf78f33c9 100644 --- a/flang/test/Lower/volatile-openmp.f90 +++ b/flang/test/Lower/volatile-openmp.f90 @@ -23,11 +23,11 @@ ! CHECK: %[[VAL_11:.*]] = fir.address_of(@_QFEcontainer) : !fir.ref>>}>> ! CHECK: %[[VAL_12:.*]] = fir.volatile_cast %[[VAL_11]] : (!fir.ref>>}>>) -> !fir.ref>>}>, volatile> ! CHECK: %[[VAL_13:.*]]:2 = hlfir.declare %[[VAL_12]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFEcontainer"} : (!fir.ref>>}>, volatile>) -> (!fir.ref>>}>, volatile>, !fir.ref>>}>, volatile>) -! CHECK: %[[VAL_14:.*]] = fir.address_of(@_QFE.c.t) : !fir.ref>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>> +! CHECK: %[[VAL_14:.*]] = fir.address_of(@_QFE.c.t) : !fir.ref>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,__padding0:!fir.array<4xi8>}>>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>> ! CHECK: %[[VAL_15:.*]] = fir.shape_shift %[[VAL_0]], %[[VAL_1]] : (index, index) -> !fir.shapeshift<1> -! CHECK: %[[VAL_16:.*]]:2 = hlfir.declare %[[VAL_14]](%[[VAL_15]]) {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.c.t"} : (!fir.ref>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>, !fir.shapeshift<1>) -> (!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>, !fir.ref>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>) -! CHECK: %[[VAL_17:.*]] = fir.address_of(@_QFE.dt.t) : !fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>> -! CHECK: %[[VAL_18:.*]]:2 = hlfir.declare %[[VAL_17]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.dt.t"} : (!fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>) -> (!fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>, !fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>) +! CHECK: %[[VAL_16:.*]]:2 = hlfir.declare %[[VAL_14]](%[[VAL_15]]) {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.c.t"} : (!fir.ref>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,__padding0:!fir.array<4xi8>}>>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>, !fir.shapeshift<1>) -> (!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,__padding0:!fir.array<4xi8>}>>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>, !fir.ref>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,__padding0:!fir.array<4xi8>}>>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>) +! CHECK: %[[VAL_17:.*]] = fir.address_of(@_QFE.dt.t) : !fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,__padding0:!fir.array<4xi8>}>> +! CHECK: %[[VAL_18:.*]]:2 = hlfir.declare %[[VAL_17]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.dt.t"} : (!fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,__padding0:!fir.array<4xi8>}>>) -> (!fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,__padding0:!fir.array<4xi8>}>>, !fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,__padding0:!fir.array<4xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{{[<]?}}{genre:i8,__padding0:!fir.array<7xi8>,value:i64}{{[>]?}}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}{{[>]?}}>>>>,bounds:!fir.box,value:i64}{{[>]?}}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}{{[>]?}}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,__padding0:!fir.array<4xi8>}>>) ! CHECK: %[[VAL_19:.*]] = hlfir.designate %[[VAL_13]]#0{"array"} {fortran_attrs = #fir.var_attrs} : (!fir.ref>>}>, volatile>) -> !fir.ref>>, volatile> ! CHECK: %[[VAL_20:.*]] = fir.load %[[VAL_19]] : !fir.ref>>, volatile> ! CHECK: %[[VAL_21:.*]]:3 = fir.box_dims %[[VAL_20]], %[[VAL_0]] : (!fir.box>>, index) -> (index, index, index) diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90 index 7dc92504aeebf..d228cd2a84ca4 100644 --- a/flang/test/Semantics/typeinfo01.f90 +++ b/flang/test/Semantics/typeinfo01.f90 @@ -8,7 +8,7 @@ module m01 end type !CHECK: Module scope: m01 !CHECK: .c.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.n,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())] -!CHECK: .dt.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t1,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t1,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +!CHECK: .dt.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t1,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t1,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) !CHECK: .n.n, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: CHARACTER(1_8,1) init:"n" !CHECK: .n.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: CHARACTER(2_8,1) init:"t1" !CHECK: DerivedType scope: t1 @@ -23,8 +23,8 @@ module m02 end type !CHECK: .c.child, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:1_8 init:[component::component(name=.n.parent,genre=1_1,category=6_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.parent,lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.cn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=4_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())] !CHECK: .c.parent, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.pn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())] -!CHECK: .dt.child, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.child,sizeinbytes=8_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.child,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) -!CHECK: .dt.parent, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.parent,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.parent,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +!CHECK: .dt.child, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.child,sizeinbytes=8_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.child,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) +!CHECK: .dt.parent, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.parent,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.parent,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) end module module m03 @@ -35,7 +35,7 @@ module m03 type(kpdt(4)) :: x !CHECK: .c.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.a,genre=1_1,category=2_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())] !CHECK: .dt.kpdt, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.kpdt,uninstantiated=NULL(),kindparameter=.kp.kpdt,lenparameterkind=NULL()) -!CHECK: .dt.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.kpdt,sizeinbytes=4_8,uninstantiated=.dt.kpdt,kindparameter=.kp.kpdt.4,lenparameterkind=NULL(),component=.c.kpdt.4,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +!CHECK: .dt.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.kpdt,sizeinbytes=4_8,uninstantiated=.dt.kpdt,kindparameter=.kp.kpdt.4,lenparameterkind=NULL(),component=.c.kpdt.4,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) !CHECK: .kp.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: INTEGER(8) shape: 0_8:0_8 init:[INTEGER(8)::4_8] end module @@ -49,7 +49,7 @@ module m04 subroutine s1(x) class(tbps), intent(in) :: x end subroutine -!CHECK: .dt.tbps, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.tbps,name=.n.tbps,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +!CHECK: .dt.tbps, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.tbps,name=.n.tbps,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) !CHECK: .v.tbps, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:1_8 init:[binding::binding(proc=s1,name=.n.b1),binding(proc=s1,name=.n.b2)] end module @@ -61,7 +61,7 @@ module m05 subroutine s1(x) class(t), intent(in) :: x end subroutine -!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=8_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=.p.t,special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=8_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=.p.t,special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) !CHECK: .p.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(procptrcomponent) shape: 0_8:0_8 init:[procptrcomponent::procptrcomponent(name=.n.p1,offset=0_8,initialization=s1)] end module @@ -85,8 +85,8 @@ subroutine s2(x, y) class(t), intent(in) :: y end subroutine !CHECK: .c.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t,genre=1_1,category=6_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.t,lenvalue=NULL(),bounds=NULL(),initialization=NULL())] -!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=2_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=0_1) -!CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=.s.t2,specialbitset=2_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=0_1) +!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=2_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) +!CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=.s.t2,specialbitset=2_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) !CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=1_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=s1)] !CHECK: .s.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=1_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=s2)] !CHECK: .v.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)] @@ -113,8 +113,8 @@ subroutine s2(x, y) class(t2), intent(in) :: y end subroutine !CHECK: .c.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t,genre=1_1,category=6_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.t,lenvalue=NULL(),bounds=NULL(),initialization=NULL())] -!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=2_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=0_1) -!CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=.s.t2,specialbitset=2_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=0_1) +!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=2_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) +!CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=.s.t2,specialbitset=2_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) !CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=1_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=s1)] !CHECK: .s.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=1_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=s2)] !CHECK: .v.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)] @@ -132,7 +132,7 @@ impure elemental subroutine s1(x, y) class(t), intent(out) :: x class(t), intent(in) :: y end subroutine -!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=4_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=0_1) +!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=4_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) !CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=2_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=s1)] !CHECK: .v.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)] end module @@ -155,7 +155,7 @@ impure elemental subroutine s3(x) subroutine s4(x) type(t), contiguous :: x(:,:,:) end subroutine -!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=7296_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1,nodefinedassignment=1_1) +!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=7296_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1) !CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=7_1,isargdescriptorset=0_1,istypebound=1_1,isargcontiguousset=0_1,proc=s3),specialbinding(which=10_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=s1),specialbinding(which=11_1,isargdescriptorset=0_1,istypebound=1_1,isargcontiguousset=1_1,proc=s2),specialbinding(which=12_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=1_1,proc=s4)] end module @@ -197,7 +197,7 @@ subroutine wu(x,u,iostat,iomsg) integer, intent(out) :: iostat character(len=*), intent(inout) :: iomsg end subroutine -!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=120_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=120_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) !CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=3_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=rf),specialbinding(which=4_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=ru),specialbinding(which=5_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=wf),specialbinding(which=6_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=wu)] !CHECK: .v.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:3_8 init:[binding::binding(proc=rf,name=.n.rf),binding(proc=ru,name=.n.ru),binding(proc=wf,name=.n.wf),binding(proc=wu,name=.n.wu)] end module @@ -246,7 +246,7 @@ subroutine wu(x,u,iostat,iomsg) integer, intent(out) :: iostat character(len=*), intent(inout) :: iomsg end subroutine -!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=120_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=120_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) !CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=3_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=rf),specialbinding(which=4_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=ru),specialbinding(which=5_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=wf),specialbinding(which=6_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=wu)] end module @@ -263,7 +263,7 @@ module m11 !CHECK: .c.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=2_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=2_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=.di.t.pointer),component(name=.n.chauto,genre=4_1,category=4_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.automatic,genre=4_1,category=2_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.automatic,initialization=NULL())] !CHECK: .di.t.pointer, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(.dp.t.pointer) init:.dp.t.pointer(pointer=target) !CHECK: .dp.t.pointer (CompilerCreated): DerivedType components: pointer -!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=144_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=.lpk.t,component=.c.t,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=144_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=.lpk.t,component=.c.t,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_1) !CHECK: .lpk.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::8_1] !CHECK: DerivedType scope: .dp.t.pointer size=24 alignment=8 instantiation of .dp.t.pointer !CHECK: pointer, POINTER size=24 offset=0: ObjectEntity type: REAL(4) diff --git a/flang/test/Semantics/typeinfo03.f90 b/flang/test/Semantics/typeinfo03.f90 index e2552d0a21d6f..f0c0a817da4a4 100644 --- a/flang/test/Semantics/typeinfo03.f90 +++ b/flang/test/Semantics/typeinfo03.f90 @@ -6,4 +6,4 @@ module m class(*), pointer :: sp, ap(:) end type end module -!CHECK: .dt.haspointer, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.haspointer,sizeinbytes=104_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.haspointer,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +!CHECK: .dt.haspointer, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.haspointer,sizeinbytes=104_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.haspointer,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) diff --git a/flang/test/Semantics/typeinfo04.f90 b/flang/test/Semantics/typeinfo04.f90 index 94dd2199db35a..de8464321a409 100644 --- a/flang/test/Semantics/typeinfo04.f90 +++ b/flang/test/Semantics/typeinfo04.f90 @@ -7,18 +7,18 @@ module m contains final :: final end type -!CHECK: .dt.finalizable, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.finalizable,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.finalizable,specialbitset=128_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1,nodefinedassignment=1_1) +!CHECK: .dt.finalizable, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.finalizable,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.finalizable,specialbitset=128_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1) type, abstract :: t1 end type -!CHECK: .dt.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t1,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +!CHECK: .dt.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t1,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) type, abstract :: t2 real, allocatable :: a(:) end type -!CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t2,sizeinbytes=48_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +!CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t2,sizeinbytes=48_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_1) type, abstract :: t3 type(finalizable) :: x end type -!CHECK: .dt.t3, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t3,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t3,procptr=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1,nodefinedassignment=1_1) +!CHECK: .dt.t3, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t3,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t3,procptr=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1) contains impure elemental subroutine final(x) type(finalizable), intent(in out) :: x diff --git a/flang/test/Semantics/typeinfo05.f90 b/flang/test/Semantics/typeinfo05.f90 index df1aecf3821de..2a7f12a153eb8 100644 --- a/flang/test/Semantics/typeinfo05.f90 +++ b/flang/test/Semantics/typeinfo05.f90 @@ -7,10 +7,10 @@ program main type t1 type(t2), pointer :: b end type t1 -!CHECK: .dt.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t1,sizeinbytes=40_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t1,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +!CHECK: .dt.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t1,sizeinbytes=40_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t1,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) type :: t2 type(t1) :: a end type t2 -! CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t2,sizeinbytes=40_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +! CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t2,sizeinbytes=40_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) end program main diff --git a/flang/test/Semantics/typeinfo06.f90 b/flang/test/Semantics/typeinfo06.f90 index 22f37b1a4369d..2385709a8eb44 100644 --- a/flang/test/Semantics/typeinfo06.f90 +++ b/flang/test/Semantics/typeinfo06.f90 @@ -7,10 +7,10 @@ program main type t1 type(t2), allocatable :: b end type t1 -!CHECK: .dt.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t1,sizeinbytes=40_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t1,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +!CHECK: .dt.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t1,sizeinbytes=40_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t1,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_1) type :: t2 type(t1) :: a end type t2 -! CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t2,sizeinbytes=40_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +! CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t2,sizeinbytes=40_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_1) end program main diff --git a/flang/test/Semantics/typeinfo07.f90 b/flang/test/Semantics/typeinfo07.f90 index ab20d6f601106..e8766d9811db8 100644 --- a/flang/test/Semantics/typeinfo07.f90 +++ b/flang/test/Semantics/typeinfo07.f90 @@ -16,7 +16,7 @@ type(t_container_extension) :: wrapper end type end -! CHECK: .dt.t_container, SAVE, TARGET (CompilerCreated, ReadOnly): {{.*}}noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=0_1,nodefinedassignment=0_1) -! CHECK: .dt.t_container_extension, SAVE, TARGET (CompilerCreated, ReadOnly): {{.*}}noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=0_1,nodefinedassignment=0_1) -! CHECK: .dt.t_container_not_polymorphic, SAVE, TARGET (CompilerCreated, ReadOnly): {{.*}}noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) -! CHECK: .dt.t_container_wrapper, SAVE, TARGET (CompilerCreated, ReadOnly): {{.*}}noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=0_1,nodefinedassignment=0_1) +! CHECK: .dt.t_container, SAVE, TARGET (CompilerCreated, ReadOnly): {{.*}}noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=0_1) +! CHECK: .dt.t_container_extension, SAVE, TARGET (CompilerCreated, ReadOnly): {{.*}}noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=0_1) +! CHECK: .dt.t_container_not_polymorphic, SAVE, TARGET (CompilerCreated, ReadOnly): {{.*}}noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_1) +! CHECK: .dt.t_container_wrapper, SAVE, TARGET (CompilerCreated, ReadOnly): {{.*}}noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=0_1) diff --git a/flang/test/Semantics/typeinfo08.f90 b/flang/test/Semantics/typeinfo08.f90 index 391a66f3d6664..689cf469dee3b 100644 --- a/flang/test/Semantics/typeinfo08.f90 +++ b/flang/test/Semantics/typeinfo08.f90 @@ -13,7 +13,7 @@ module m !CHECK: Module scope: m size=0 alignment=1 sourceRange=113 bytes !CHECK: .c.s, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t1,genre=1_1,category=6_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),lenvalue=NULL(),bounds=NULL(),initialization=NULL())] -!CHECK: .dt.s, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.s,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=.lpk.s,component=.c.s,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) +!CHECK: .dt.s, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.s,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=.lpk.s,component=.c.s,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1) !CHECK: .lpk.s, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::4_1] !CHECK: .n.s, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: CHARACTER(1_8,1) init:"s" !CHECK: .n.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: CHARACTER(2_8,1) init:"t1" diff --git a/flang/test/Semantics/typeinfo11.f90 b/flang/test/Semantics/typeinfo11.f90 index 08e0b95abb763..92efc8f9ea54b 100644 --- a/flang/test/Semantics/typeinfo11.f90 +++ b/flang/test/Semantics/typeinfo11.f90 @@ -14,4 +14,4 @@ type(t2) x end -!CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t2,sizeinbytes=40_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=0_1,nodefinedassignment=0_1) +!CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t2,sizeinbytes=40_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=0_1) diff --git a/flang/test/Semantics/typeinfo12.f90 b/flang/test/Semantics/typeinfo12.f90 deleted file mode 100644 index 6b23b63d28b1d..0000000000000 --- a/flang/test/Semantics/typeinfo12.f90 +++ /dev/null @@ -1,67 +0,0 @@ -!RUN: bbc --dump-symbols %s | FileCheck %s -!Check "nodefinedassignment" settings. - -module m01 - - type hasAsst1 - contains - procedure asst1 - generic :: assignment(=) => asst1 - end type -!CHECK: .dt.hasasst1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.hasasst1,name=.n.hasasst1,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.hasasst1,specialbitset=4_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=0_1) - - type hasAsst2 ! no defined assignment relevant to the runtime - end type - interface assignment(=) - procedure asst2 - end interface -!CHECK: .dt.hasasst2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.hasasst2,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) - - type test1 - type(hasAsst1) c - end type -!CHECK: .dt.test1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.test1,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.test1,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=0_1) - - type test2 - type(hasAsst2) c - end type -!CHECK: .dt.test2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.test2,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.test2,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) - - type test3 - type(hasAsst1), pointer :: p - end type -!CHECK: .dt.test3, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.test3,sizeinbytes=40_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.test3,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) - - type test4 - type(hasAsst2), pointer :: p - end type -!CHECK: .dt.test4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.test4,sizeinbytes=40_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.test4,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) - - type, extends(hasAsst1) :: test5 - end type -!CHECK: .dt.test5, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.test5,name=.n.test5,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.test5,procptr=NULL(),special=.s.test5,specialbitset=4_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=0_1) - - type, extends(hasAsst2) :: test6 - end type -!CHECK: .dt.test6, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.test6,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.test6,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) - - type test7 - type(test7), allocatable :: c - end type -!CHECK: .dt.test7, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.test7,sizeinbytes=40_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.test7,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_1,nodefinedassignment=1_1) - - type test8 - class(test8), allocatable :: c - end type -!CHECK: .dt.test8, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.test8,sizeinbytes=40_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.test8,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=0_1,nodefinedassignment=0_1) - - contains - impure elemental subroutine asst1(left, right) - class(hasAsst1), intent(out) :: left - class(hasAsst1), intent(in) :: right - end - impure elemental subroutine asst2(left, right) - class(hasAsst2), intent(out) :: left - class(hasAsst2), intent(in) :: right - end -end