diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -129,7 +129,7 @@
* A `RETURN` statement may appear in a main program.
* DATA statement initialization is allowed for procedure pointers outside
structure constructors.
-* Nonstandard intrinsic functions: ISNAN
+* Nonstandard intrinsic functions: ISNAN, SIZEOF
### Extensions supported when enabled by options
@@ -144,10 +144,11 @@
rule imposes an artificially small constraint in some cases
where Fortran mandates that something have the default `INTEGER`
type: specifically, the results of references to the intrinsic functions
- `SIZE`, `LBOUND`, `UBOUND`, `SHAPE`, and the location reductions
+ `SIZE`, `STORAGE_SIZE`,`LBOUND`, `UBOUND`, `SHAPE`, and the location reductions
`FINDLOC`, `MAXLOC`, and `MINLOC` in the absence of an explicit
`KIND=` actual argument. We return `INTEGER(KIND=8)` by default in
these cases when the `-flarge-sizes` option is enabled.
+ `SIZEOF` and `C_SIZEOF` always return `INTEGER(KIND=8)`.
* Treat each specification-part like is has `IMPLICIT NONE`
[-fimplicit-none-type-always]
* Ignore occurrences of `IMPLICIT NONE` and `IMPLICIT NONE(TYPE)`
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -148,7 +148,7 @@
const char *thisIs = "POINTER", const char *thatIs = "TARGET",
bool isElemental = false) const;
std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(
- FoldingContext * = nullptr) const;
+ FoldingContext &) const;
llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
diff --git a/flang/include/flang/Evaluate/common.h b/flang/include/flang/Evaluate/common.h
--- a/flang/include/flang/Evaluate/common.h
+++ b/flang/include/flang/Evaluate/common.h
@@ -235,6 +235,7 @@
Rounding rounding() const { return rounding_; }
bool flushSubnormalsToZero() const { return flushSubnormalsToZero_; }
bool bigEndian() const { return bigEndian_; }
+ std::size_t maxAlignment() const { return maxAlignment_; }
const semantics::DerivedTypeSpec *pdtInstance() const { return pdtInstance_; }
const IntrinsicProcTable &intrinsics() const { return intrinsics_; }
@@ -257,7 +258,8 @@
const IntrinsicProcTable &intrinsics_;
Rounding rounding_{defaultRounding};
bool flushSubnormalsToZero_{false};
- bool bigEndian_{false};
+ static constexpr bool bigEndian_{false}; // TODO: configure for target
+ static constexpr std::size_t maxAlignment_{8}; // TODO: configure for target
const semantics::DerivedTypeSpec *pdtInstance_{nullptr};
std::map<parser::CharBlock, ConstantSubscript> impliedDos_;
};
diff --git a/flang/include/flang/Evaluate/initial-image.h b/flang/include/flang/Evaluate/initial-image.h
--- a/flang/include/flang/Evaluate/initial-image.h
+++ b/flang/include/flang/Evaluate/initial-image.h
@@ -33,16 +33,17 @@
std::size_t size() const { return data_.size(); }
- template <typename A> Result Add(ConstantSubscript, std::size_t, const A &) {
+ template <typename A>
+ Result Add(ConstantSubscript, std::size_t, const A &, FoldingContext &) {
return NotAConstant;
}
template <typename T>
- Result Add(
- ConstantSubscript offset, std::size_t bytes, const Constant<T> &x) {
+ Result Add(ConstantSubscript offset, std::size_t bytes, const Constant<T> &x,
+ FoldingContext &context) {
if (offset < 0 || offset + bytes > data_.size()) {
return OutOfRange;
} else {
- auto elementBytes{ToInt64(x.GetType().MeasureSizeInBytes())};
+ auto elementBytes{ToInt64(x.GetType().MeasureSizeInBytes(context, true))};
if (!elementBytes ||
bytes !=
x.values().size() * static_cast<std::size_t>(*elementBytes)) {
@@ -55,7 +56,8 @@
}
template <int KIND>
Result Add(ConstantSubscript offset, std::size_t bytes,
- const Constant<Type<TypeCategory::Character, KIND>> &x) {
+ const Constant<Type<TypeCategory::Character, KIND>> &x,
+ FoldingContext &) {
if (offset < 0 || offset + bytes > data_.size()) {
return OutOfRange;
} else {
@@ -80,11 +82,13 @@
}
}
}
- Result Add(ConstantSubscript, std::size_t, const Constant<SomeDerived> &);
+ Result Add(ConstantSubscript, std::size_t, const Constant<SomeDerived> &,
+ FoldingContext &);
template <typename T>
- Result Add(ConstantSubscript offset, std::size_t bytes, const Expr<T> &x) {
+ Result Add(ConstantSubscript offset, std::size_t bytes, const Expr<T> &x,
+ FoldingContext &c) {
return std::visit(
- [&](const auto &y) { return Add(offset, bytes, y); }, x.u);
+ [&](const auto &y) { return Add(offset, bytes, y, c); }, x.u);
}
void AddPointer(ConstantSubscript, const Expr<SomeType> &);
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -141,8 +141,10 @@
return charLength_;
}
std::optional<Expr<SubscriptInteger>> GetCharLength() const;
+
+ std::size_t GetAlignment(const FoldingContext &) const;
std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(
- FoldingContext * = nullptr) const;
+ FoldingContext &, bool aligned) const;
std::string AsFortran() const;
std::string AsFortran(std::string &&charLenExpr) const;
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -165,17 +165,17 @@
}
std::optional<Expr<SubscriptInteger>> TypeAndShape::MeasureSizeInBytes(
- FoldingContext *foldingContext) const {
- if (type_.category() == TypeCategory::Character && LEN_) {
- Expr<SubscriptInteger> result{
- common::Clone(*LEN_) * Expr<SubscriptInteger>{type_.kind()}};
- if (foldingContext) {
- result = Fold(*foldingContext, std::move(result));
+ FoldingContext &foldingContext) const {
+ if (auto elements{GetSize(Shape{shape_})}) {
+ // Sizes of arrays (even with single elements) are multiples of
+ // their alignments.
+ if (auto elementBytes{
+ type_.MeasureSizeInBytes(foldingContext, GetRank(shape_) > 0)}) {
+ return Fold(
+ foldingContext, std::move(*elements) * std::move(*elementBytes));
}
- return result;
- } else {
- return type_.MeasureSizeInBytes(foldingContext);
}
+ return std::nullopt;
}
void TypeAndShape::AcquireShape(
diff --git a/flang/lib/Evaluate/fold-designator.cpp b/flang/lib/Evaluate/fold-designator.cpp
--- a/flang/lib/Evaluate/fold-designator.cpp
+++ b/flang/lib/Evaluate/fold-designator.cpp
@@ -27,8 +27,9 @@
} else if (symbol.has<semantics::ObjectEntityDetails>() &&
!IsNamedConstant(symbol)) {
if (auto type{DynamicType::From(symbol)}) {
- if (auto bytes{ToInt64(type->MeasureSizeInBytes(&context_))}) {
- if (auto extents{GetConstantExtents(context_, symbol)}) {
+ if (auto extents{GetConstantExtents(context_, symbol)}) {
+ if (auto bytes{ToInt64(
+ type->MeasureSizeInBytes(context_, GetRank(*extents) > 0))}) {
OffsetSymbol result{symbol, static_cast<std::size_t>(*bytes)};
auto stride{*bytes};
for (auto extent : *extents) {
@@ -57,8 +58,8 @@
const ArrayRef &x, ConstantSubscript which) {
const Symbol &array{x.base().GetLastSymbol()};
if (auto type{DynamicType::From(array)}) {
- if (auto bytes{ToInt64(type->MeasureSizeInBytes(&context_))}) {
- if (auto extents{GetConstantExtents(context_, array)}) {
+ if (auto extents{GetConstantExtents(context_, array)}) {
+ if (auto bytes{ToInt64(type->MeasureSizeInBytes(context_, true))}) {
Shape lbs{GetLowerBounds(context_, x.base())};
if (auto lowerBounds{AsConstantExtents(context_, lbs)}) {
std::optional<OffsetSymbol> result;
@@ -217,7 +218,7 @@
auto extents{AsConstantExtents(context, shape)};
Shape lbs{GetLowerBounds(context, entity)};
auto lower{AsConstantExtents(context, lbs)};
- auto elementBytes{ToInt64(elementType.MeasureSizeInBytes(&context))};
+ auto elementBytes{ToInt64(elementType.MeasureSizeInBytes(context, true))};
if (!extents || !lower || !elementBytes || *elementBytes <= 0) {
return std::nullopt;
}
@@ -316,7 +317,7 @@
TypedWrapper<Designator>(*type, std::move(*dataRef))}) {
if (IsAllocatableOrPointer(symbol)) {
} else if (auto elementBytes{
- ToInt64(type->MeasureSizeInBytes(&context))}) {
+ ToInt64(type->MeasureSizeInBytes(context, true))}) {
if (auto *zExpr{std::get_if<Expr<SomeComplex>>(&result->u)}) {
if (size * 2 > static_cast<std::size_t>(*elementBytes)) {
return result;
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -587,6 +587,22 @@
return Expr<T>{ConvertToType<T>(Fold(context, std::move(product)))};
}
}
+ } else if (name == "sizeof") { // in bytes; extension
+ if (auto info{
+ characteristics::TypeAndShape::Characterize(args[0], context)}) {
+ if (auto bytes{info->MeasureSizeInBytes(context)}) {
+ return Expr<T>{Fold(context, ConvertToType<T>(std::move(*bytes)))};
+ }
+ }
+ } else if (name == "storage_size") { // in bits
+ if (const auto *expr{UnwrapExpr<Expr<SomeType>>(args[0])}) {
+ if (auto type{expr->GetType()}) {
+ if (auto bytes{type->MeasureSizeInBytes(context, true)}) {
+ return Expr<T>{
+ Fold(context, Expr<T>{8} * ConvertToType<T>(std::move(*bytes)))};
+ }
+ }
+ }
} else if (name == "ubound") {
return UBOUND(context, std::move(funcRef));
}
diff --git a/flang/lib/Evaluate/initial-image.cpp b/flang/lib/Evaluate/initial-image.cpp
--- a/flang/lib/Evaluate/initial-image.cpp
+++ b/flang/lib/Evaluate/initial-image.cpp
@@ -14,7 +14,7 @@
namespace Fortran::evaluate {
auto InitialImage::Add(ConstantSubscript offset, std::size_t bytes,
- const Constant<SomeDerived> &x) -> Result {
+ const Constant<SomeDerived> &x, FoldingContext &context) -> Result {
if (offset < 0 || offset + bytes > data_.size()) {
return OutOfRange;
} else {
@@ -36,7 +36,7 @@
AddPointer(offset + component.offset(), indExpr.value());
} else {
Result added{Add(offset + component.offset(), component.size(),
- indExpr.value())};
+ indExpr.value(), context)};
if (added != Ok) {
return Ok;
}
@@ -88,7 +88,8 @@
using Scalar = typename Const::Element;
std::size_t elements{TotalElementCount(extents_)};
std::vector<Scalar> typedValue(elements);
- auto elemBytes{ToInt64(type_.MeasureSizeInBytes(&context_))};
+ auto elemBytes{
+ ToInt64(type_.MeasureSizeInBytes(context_, GetRank(extents_) > 0))};
CHECK(elemBytes && *elemBytes >= 0);
std::size_t stride{static_cast<std::size_t>(*elemBytes)};
CHECK(offset_ + elements * stride <= image_.data_.size());
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -685,6 +685,8 @@
{{"array", AnyData, Rank::anyOrAssumedRank}, OptionalDIM,
SizeDefaultKIND},
KINDInt, Rank::scalar, IntrinsicClass::inquiryFunction},
+ {"sizeof", {{"a", AnyData, Rank::anyOrAssumedRank}}, SubscriptInt,
+ Rank::scalar, IntrinsicClass::inquiryFunction},
{"spacing", {{"x", SameReal}}, SameReal},
{"spread",
{{"source", SameType, Rank::known}, RequiredDIM,
@@ -742,7 +744,7 @@
// AND, OR, XOR, LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT,
// COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT,
// QCMPLX, DFLOAT, QEXT, QFLOAT, QREAL, DNUM,
-// INUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF,
+// INUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN,
// MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR
// IARG, IARGC, NARGS, NUMARG, BADDRESS, IADDR, CACHESIZE,
// EOF, FP_CLASS, INT_PTR_KIND, MALLOC
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -643,17 +643,13 @@
if (auto sourceTypeAndShape{
characteristics::TypeAndShape::Characterize(
call.arguments().at(0), context_)}) {
- auto sourceElements{
- GetSize(common::Clone(sourceTypeAndShape->shape()))};
- auto sourceElementBytes{
- sourceTypeAndShape->MeasureSizeInBytes(&context_)};
+ auto sourceBytes{sourceTypeAndShape->MeasureSizeInBytes(context_)};
auto moldElementBytes{
- moldTypeAndShape->MeasureSizeInBytes(&context_)};
- if (sourceElements && sourceElementBytes && moldElementBytes) {
+ moldTypeAndShape->type().MeasureSizeInBytes(context_, true)};
+ if (sourceBytes && moldElementBytes) {
ExtentExpr extent{Fold(context_,
- ((std::move(*sourceElements) *
- std::move(*sourceElementBytes)) +
- common::Clone(*moldElementBytes) - ExtentExpr{1}) /
+ (std::move(*sourceBytes) + common::Clone(*moldElementBytes) -
+ ExtentExpr{1}) /
common::Clone(*moldElementBytes))};
return Shape{MaybeExtentExpr{std::move(extent)}};
}
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -112,7 +112,7 @@
return std::nullopt;
}
-static constexpr int RealKindBytes(int kind) {
+static constexpr std::size_t RealKindBytes(int kind) {
switch (kind) {
case 3: // non-IEEE 16-bit format (truncated 32-bit)
return 2;
@@ -124,8 +124,26 @@
}
}
+std::size_t DynamicType::GetAlignment(const FoldingContext &context) const {
+ switch (category_) {
+ case TypeCategory::Integer:
+ case TypeCategory::Character:
+ case TypeCategory::Logical:
+ return std::min<std::size_t>(kind_, context.maxAlignment());
+ case TypeCategory::Real:
+ case TypeCategory::Complex:
+ return std::min(RealKindBytes(kind_), context.maxAlignment());
+ case TypeCategory::Derived:
+ if (derived_ && derived_->scope()) {
+ return derived_->scope()->alignment().value_or(1);
+ }
+ break;
+ }
+ return 1; // needs to be after switch to dodge a bogus gcc warning
+}
+
std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes(
- FoldingContext *context) const {
+ FoldingContext &context, bool aligned) const {
switch (category_) {
case TypeCategory::Integer:
return Expr<SubscriptInteger>{kind_};
@@ -135,20 +153,18 @@
return Expr<SubscriptInteger>{2 * RealKindBytes(kind_)};
case TypeCategory::Character:
if (auto len{GetCharLength()}) {
- auto result{Expr<SubscriptInteger>{kind_} * std::move(*len)};
- if (context) {
- return Fold(*context, std::move(result));
- } else {
- return std::move(result);
- }
+ return Fold(context, Expr<SubscriptInteger>{kind_} * std::move(*len));
}
break;
case TypeCategory::Logical:
return Expr<SubscriptInteger>{kind_};
case TypeCategory::Derived:
if (derived_ && derived_->scope()) {
+ auto size{derived_->scope()->size()};
+ auto align{aligned ? derived_->scope()->alignment().value_or(0) : 0};
+ auto alignedSize{align > 0 ? ((size + align - 1) / align) * align : size};
return Expr<SubscriptInteger>{
- static_cast<common::ConstantSubscript>(derived_->scope()->size())};
+ static_cast<ConstantSubscript>(alignedSize)};
}
break;
}
diff --git a/flang/lib/Semantics/compute-offsets.h b/flang/lib/Semantics/compute-offsets.h
--- a/flang/lib/Semantics/compute-offsets.h
+++ b/flang/lib/Semantics/compute-offsets.h
@@ -11,7 +11,8 @@
namespace Fortran::semantics {
class SemanticsContext;
-void ComputeOffsets(SemanticsContext &);
+class Scope;
+void ComputeOffsets(SemanticsContext &, Scope &);
} // namespace Fortran::semantics
#endif
diff --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp
--- a/flang/lib/Semantics/compute-offsets.cpp
+++ b/flang/lib/Semantics/compute-offsets.cpp
@@ -24,11 +24,8 @@
class ComputeOffsetsHelper {
public:
- // TODO: configure based on target
- static constexpr std::size_t maxAlignment{8};
-
ComputeOffsetsHelper(SemanticsContext &context) : context_{context} {}
- void Compute() { Compute(context_.globalScope()); }
+ void Compute(Scope &);
private:
struct SizeAndAlignment {
@@ -48,24 +45,18 @@
const EquivalenceObject *object;
};
- void Compute(Scope &);
- void DoScope(Scope &);
void DoCommonBlock(Symbol &);
void DoEquivalenceBlockBase(Symbol &, SizeAndAlignment &);
void DoEquivalenceSet(const EquivalenceSet &);
SymbolAndOffset Resolve(const SymbolAndOffset &);
std::size_t ComputeOffset(const EquivalenceObject &);
void DoSymbol(Symbol &);
- SizeAndAlignment GetSizeAndAlignment(const Symbol &);
- SizeAndAlignment GetElementSize(const Symbol &);
- std::size_t CountElements(const Symbol &);
- static std::size_t Align(std::size_t, std::size_t);
- static SizeAndAlignment GetIntrinsicSizeAndAlignment(TypeCategory, int);
+ SizeAndAlignment GetSizeAndAlignment(const Symbol &, bool entire);
+ std::size_t Align(std::size_t, std::size_t);
SemanticsContext &context_;
- evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
std::size_t offset_{0};
- std::size_t alignment_{0};
+ std::size_t alignment_{1};
// symbol -> symbol+offset that determines its location, from EQUIVALENCE
std::map<MutableSymbolRef, SymbolAndOffset> dependents_;
// base symbol -> SizeAndAlignment for each distinct EQUIVALENCE block
@@ -74,14 +65,8 @@
void ComputeOffsetsHelper::Compute(Scope &scope) {
for (Scope &child : scope.children()) {
- Compute(child);
+ ComputeOffsets(context_, child);
}
- DoScope(scope);
- dependents_.clear();
- equivalenceBlock_.clear();
-}
-
-void ComputeOffsetsHelper::DoScope(Scope &scope) {
if (scope.symbol() && scope.IsParameterizedDerivedType()) {
return; // only process instantiations of parameterized derived types
}
@@ -93,14 +78,12 @@
for (const EquivalenceSet &set : scope.equivalenceSets()) {
DoEquivalenceSet(set);
}
- offset_ = 0;
- alignment_ = 1;
// Compute a base symbol and overall block size for each
// disjoint EQUIVALENCE storage sequence.
for (auto &[symbol, dep] : dependents_) {
dep = Resolve(dep);
CHECK(symbol->size() == 0);
- auto symInfo{GetSizeAndAlignment(*symbol)};
+ auto symInfo{GetSizeAndAlignment(*symbol, true)};
symbol->set_size(symInfo.size);
Symbol &base{*dep.symbol};
auto iter{equivalenceBlock_.find(base)};
@@ -285,7 +268,7 @@
offset *= ubound(i) - lbound(i) + 1;
}
}
- auto result{offset * GetElementSize(object.symbol).size};
+ auto result{offset * GetSizeAndAlignment(object.symbol, false).size};
if (object.substringStart) {
int kind{context_.defaultKinds().GetDefaultKind(TypeCategory::Character)};
if (const DeclTypeSpec * type{object.symbol.GetType()}) {
@@ -302,7 +285,7 @@
if (!symbol.has<ObjectEntityDetails>() && !symbol.has<ProcEntityDetails>()) {
return;
}
- SizeAndAlignment s{GetSizeAndAlignment(symbol)};
+ SizeAndAlignment s{GetSizeAndAlignment(symbol, true)};
if (s.size == 0) {
return;
}
@@ -313,101 +296,51 @@
alignment_ = std::max(alignment_, s.alignment);
}
-auto ComputeOffsetsHelper::GetSizeAndAlignment(const Symbol &symbol)
- -> SizeAndAlignment {
- SizeAndAlignment result{GetElementSize(symbol)};
- std::size_t elements{CountElements(symbol)};
- if (elements > 1) {
- result.size = Align(result.size, result.alignment);
- }
- result.size *= elements;
- return result;
-}
-
-auto ComputeOffsetsHelper::GetElementSize(const Symbol &symbol)
- -> SizeAndAlignment {
- const DeclTypeSpec *type{symbol.GetType()};
- if (!evaluate::DynamicType::From(type).has_value()) {
- return {};
- }
+auto ComputeOffsetsHelper::GetSizeAndAlignment(
+ const Symbol &symbol, bool entire) -> SizeAndAlignment {
// TODO: The size of procedure pointers is not yet known
// and is independent of rank (and probably also the number
// of length type parameters).
+ auto &foldingContext{context_.foldingContext()};
if (IsDescriptor(symbol) || IsProcedurePointer(symbol)) {
int lenParams{0};
- if (const DerivedTypeSpec * derived{type->AsDerived()}) {
+ if (const auto *derived{evaluate::GetDerivedTypeSpec(
+ evaluate::DynamicType::From(symbol))}) {
lenParams = CountLenParameters(*derived);
}
std::size_t size{
runtime::Descriptor::SizeInBytes(symbol.Rank(), false, lenParams)};
- return {size, maxAlignment};
+ return {size, foldingContext.maxAlignment()};
}
if (IsProcedure(symbol)) {
return {};
}
- SizeAndAlignment result;
- if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {
- if (auto kind{ToInt64(intrinsic->kind())}) {
- result = GetIntrinsicSizeAndAlignment(intrinsic->category(), *kind);
- }
- if (type->category() == DeclTypeSpec::Character) {
- ParamValue length{type->characterTypeSpec().length()};
- CHECK(length.isExplicit()); // else should be descriptor
- if (MaybeIntExpr lengthExpr{length.GetExplicit()}) {
- if (auto lengthInt{ToInt64(*lengthExpr)}) {
- result.size *= *lengthInt;
- }
+ if (auto chars{evaluate::characteristics::TypeAndShape::Characterize(
+ symbol, foldingContext)}) {
+ if (entire) {
+ if (auto size{ToInt64(chars->MeasureSizeInBytes(foldingContext))}) {
+ return {static_cast<std::size_t>(*size),
+ chars->type().GetAlignment(foldingContext)};
}
- }
- } else if (const DerivedTypeSpec * derived{type->AsDerived()}) {
- if (derived->scope()) {
- DoScope(*const_cast<Scope *>(derived->scope()));
- result.size = derived->scope()->size();
- result.alignment = derived->scope()->alignment().value_or(0);
- }
- } else {
- DIE("not intrinsic or derived");
- }
- return result;
-}
-
-std::size_t ComputeOffsetsHelper::CountElements(const Symbol &symbol) {
- if (auto shape{GetShape(foldingContext_, symbol)}) {
- if (auto sizeExpr{evaluate::GetSize(std::move(*shape))}) {
- if (auto size{ToInt64(Fold(foldingContext_, std::move(*sizeExpr)))}) {
- return *size;
+ } else { // element size only
+ if (auto size{ToInt64(chars->type().MeasureSizeInBytes(
+ foldingContext, true /*aligned*/))}) {
+ return {static_cast<std::size_t>(*size),
+ chars->type().GetAlignment(foldingContext)};
}
}
}
- return 1;
+ return {};
}
// Align a size to its natural alignment, up to maxAlignment.
std::size_t ComputeOffsetsHelper::Align(std::size_t x, std::size_t alignment) {
- if (alignment > maxAlignment) {
- alignment = maxAlignment;
- }
+ alignment = std::min(alignment, context_.foldingContext().maxAlignment());
return (x + alignment - 1) & -alignment;
}
-auto ComputeOffsetsHelper::GetIntrinsicSizeAndAlignment(
- TypeCategory category, int kind) -> SizeAndAlignment {
- if (category == TypeCategory::Character) {
- return {static_cast<std::size_t>(kind)};
- }
- auto bytes{evaluate::ToInt64(
- evaluate::DynamicType{category, kind}.MeasureSizeInBytes())};
- CHECK(bytes && *bytes > 0);
- std::size_t size{static_cast<std::size_t>(*bytes)};
- if (category == TypeCategory::Complex) {
- return {size, size >> 1};
- } else {
- return {size};
- }
-}
-
-void ComputeOffsets(SemanticsContext &context) {
- ComputeOffsetsHelper{context}.Compute();
+void ComputeOffsets(SemanticsContext &context, Scope &scope) {
+ ComputeOffsetsHelper{context}.Compute(scope);
}
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -229,9 +229,9 @@
// (most) other Fortran compilers do. Pad on the right with spaces
// when short, truncate the right if long.
// TODO: big-endian targets
- std::size_t bytes{static_cast<std::size_t>(evaluate::ToInt64(
- type.MeasureSizeInBytes(&exprAnalyzer_.GetFoldingContext()))
- .value())};
+ auto bytes{static_cast<std::size_t>(evaluate::ToInt64(
+ type.MeasureSizeInBytes(exprAnalyzer_.GetFoldingContext(), false))
+ .value())};
evaluate::BOZLiteralConstant bits{0};
for (std::size_t j{0}; j < bytes; ++j) {
char ch{j >= chValue->size() ? ' ' : chValue->at(j)};
@@ -342,8 +342,8 @@
DescribeElement(), designatorType->AsFortran());
}
auto folded{evaluate::Fold(context, std::move(converted->first))};
- switch (
- GetImage().Add(offsetSymbol.offset(), offsetSymbol.size(), folded)) {
+ switch (GetImage().Add(
+ offsetSymbol.offset(), offsetSymbol.size(), folded, context)) {
case evaluate::InitialImage::Ok:
return true;
case evaluate::InitialImage::NotAConstant:
@@ -427,15 +427,15 @@
// Compute the minimum common granularity
if (auto dyType{evaluate::DynamicType::From(symbol)}) {
minElementBytes = evaluate::ToInt64(
- dyType->MeasureSizeInBytes(&exprAnalyzer.GetFoldingContext()))
+ dyType->MeasureSizeInBytes(exprAnalyzer.GetFoldingContext(), true))
.value_or(1);
}
for (const Symbol *s : conflicts) {
if (auto dyType{evaluate::DynamicType::From(*s)}) {
- minElementBytes = std::min(minElementBytes,
- static_cast<std::size_t>(evaluate::ToInt64(
- dyType->MeasureSizeInBytes(&exprAnalyzer.GetFoldingContext()))
- .value_or(1)));
+ minElementBytes = std::min<std::size_t>(minElementBytes,
+ evaluate::ToInt64(dyType->MeasureSizeInBytes(
+ exprAnalyzer.GetFoldingContext(), true))
+ .value_or(1));
} else {
minElementBytes = 1;
}
diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -169,7 +169,9 @@
} else if (lhsType_) {
const auto *frTypeAndShape{funcResult->GetTypeAndShape()};
CHECK(frTypeAndShape);
- if (!lhsType_->IsCompatibleWith(context_.messages(), *frTypeAndShape)) {
+ if (!lhsType_->IsCompatibleWith(context_.messages(), *frTypeAndShape,
+ "pointer", "function result", false /*elemental*/,
+ true /*left: deferred shape*/, true /*right: deferred shape*/)) {
msg = "%s is associated with the result of a reference to function '%s'"
" whose pointer result has an incompatible type or shape"_err_en_US;
}
diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -167,7 +167,7 @@
SemanticsContext &context, parser::Program &program) {
ResolveNames(context, program);
RewriteParseTree(context, program);
- ComputeOffsets(context);
+ ComputeOffsets(context, context.globalScope());
CheckDeclarations(context);
StatementSemanticsPass1{context}.Walk(program);
StatementSemanticsPass2 pass2{context};
diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -8,6 +8,7 @@
#include "flang/Semantics/type.h"
#include "check-declarations.h"
+#include "compute-offsets.h"
#include "flang/Evaluate/fold.h"
#include "flang/Parser/characters.h"
#include "flang/Semantics/scope.h"
@@ -248,6 +249,7 @@
}
}
}
+ ComputeOffsets(context, const_cast<Scope &>(typeScope));
return;
}
Scope &newScope{containingScope.MakeScope(Scope::Kind::DerivedType)};
@@ -306,6 +308,7 @@
for (const auto &pair : fromScope) {
InstantiateComponent(*pair.second);
}
+ ComputeOffsets(context_, scope_);
}
void InstantiateHelper::InstantiateComponent(const Symbol &oldSymbol) {
diff --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90
--- a/flang/module/__fortran_builtins.f90
+++ b/flang/module/__fortran_builtins.f90
@@ -16,6 +16,7 @@
integer, parameter, private :: int64 = selected_int_kind(18)
intrinsic :: __builtin_c_f_pointer
+ intrinsic :: sizeof ! extension
type :: __builtin_event_type
integer(kind=int64) :: __count
diff --git a/flang/module/iso_c_binding.f90 b/flang/module/iso_c_binding.f90
--- a/flang/module/iso_c_binding.f90
+++ b/flang/module/iso_c_binding.f90
@@ -13,7 +13,8 @@
use __Fortran_builtins, only: &
c_f_pointer => __builtin_c_f_pointer, &
c_ptr => __builtin_c_ptr, &
- c_funptr => __builtin_c_funptr
+ c_funptr => __builtin_c_funptr, &
+ c_sizeof => sizeof
type(c_ptr), parameter :: c_null_ptr = c_ptr(0)
type(c_funptr), parameter :: c_null_funptr = c_funptr(0)
@@ -32,7 +33,7 @@
c_long = c_int64_t, &
c_long_long = c_int64_t, &
c_signed_char = c_int8_t, &
- c_size_t = c_long_long, &
+ c_size_t = kind(c_sizeof(1)), &
c_intmax_t = c_int128_t, &
c_intptr_t = c_size_t, &
c_ptrdiff_t = c_size_t
@@ -102,6 +103,5 @@
end function c_funloc
! TODO c_f_procpointer
- ! TODO c_sizeof
end module iso_c_binding
diff --git a/flang/test/Evaluate/folding17.f90 b/flang/test/Evaluate/folding17.f90
new file mode 100644
--- /dev/null
+++ b/flang/test/Evaluate/folding17.f90
@@ -0,0 +1,23 @@
+! RUN: %S/test_folding.sh %s %t %f18
+! Test implementations of STORAGE_SIZE() and SIZEOF() as expression rewrites
+module m1
+ type :: t1
+ real :: a(2,3)
+ character*5 :: c(3)
+ end type
+ type :: t2(k)
+ integer, kind :: k
+ type(t1) :: a(k)
+ end type
+ type(t2(2)) :: a(2)
+ integer, parameter :: ss1 = storage_size(a(1)%a(1)%a)
+ integer, parameter :: sz1 = sizeof(a(1)%a(1)%a)
+ integer, parameter :: ss2 = storage_size(a(1)%a(1)%c)
+ integer, parameter :: sz2 = sizeof(a(1)%a(1)%c)
+ integer, parameter :: ss3 = storage_size(a(1)%a)
+ integer, parameter :: sz3 = sizeof(a(1)%a)
+ integer, parameter :: ss4 = storage_size(a)
+ integer, parameter :: sz4 = sizeof(a)
+ logical, parameter :: test_ss = all([ss1,ss2,ss3,ss4]==[32, 40, 320, 640])
+ logical, parameter :: test_sz = all([sz1,sz2,sz3,sz4]==[24, 15, 80, 160])
+end module
diff --git a/flang/test/Semantics/resolve92.f90 b/flang/test/Semantics/resolve92.f90
--- a/flang/test/Semantics/resolve92.f90
+++ b/flang/test/Semantics/resolve92.f90
@@ -6,7 +6,7 @@
integer :: n
end type
type t2
- ! t and t2 must be resolved to types in m, not components in t2
+ ! t and t2 must be resolved to types in m1, not components in t2
type(t) :: t(10) = t(1)
type(t) :: x = t(1)
integer :: t2
diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90
--- a/flang/test/Semantics/typeinfo01.f90
+++ b/flang/test/Semantics/typeinfo01.f90
@@ -59,7 +59,7 @@
subroutine s1(x)
class(t), intent(in) :: x
end subroutine
-!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=.p.t,special=NULL())
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=24_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=.p.t,special=NULL())
!CHECK: .p.t, SAVE, TARGET: ObjectEntity type: TYPE(procptrcomponent) shape: 0_8:0_8 init:[procptrcomponent::procptrcomponent(name=.n.p1,offset=0_8,initialization=s1)]
end module