[flang-commits] [flang] [flang] Associate named constant actual arguments with their storage (PR #222986)
Eugene Epshteyn via flang-commits
flang-commits at lists.llvm.org
Thu Sep 17 12:22:00 PDT 2026
https://github.com/eugeneepshteyn updated https://github.com/llvm/llvm-project/pull/222986
>From f16118737f145029de552849a426218ea5f56c20 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Fri, 11 Sep 2026 08:36:06 -0700
Subject: [PATCH 01/13] [flang] Associate named constant actual arguments with
their storage
A designator whose base is a named constant is not a variable, but it
still designates an object with storage. Give it the same copy-in
analysis as a variable instead of the blanket expression treatment:
whether a copy is needed for argument association is decided by
contiguity (physical contiguity, not the IS_CONTIGUOUS() presumption
for named-constant sections), and copy-out is never needed since a
named constant is not definable.
In lowering, make the parameter-object carve-out fire only when the
copy analysis suggests a copy: the temporary remains the right
mechanism when a copy is needed (the entity may be a raw address that
the runtime copy-in cannot take, and compiler-generated copy-out must
never target read-only storage), but when no copy is needed the named
constant's own storage is associated with the dummy argument.
In semantics, retain whole-array and array-element designators of
named constants for actual arguments of procedure references instead
of replacing them by their folded Constant values, so that lowering
sees the declared object rather than an outlined literal. This
implements sequence association for named-constant array elements
(F'2023 15.5.2.12) and makes address-based lookups (e.g. OpenACC
present checks against a module variable registered by declare
copyin) see the declared storage. A parenthesized designator is a
primary (F'2023 R1001) and keeps its folded value. Once a call
resolves to an intrinsic procedure, retained designators are folded
back to their values (intrinsic argument checking inspects constant
values structurally, and the storage identity of a named constant is
irrelevant to an intrinsic procedure).
---
flang/lib/Evaluate/check-expression.cpp | 23 +++-
flang/lib/Evaluate/intrinsics.cpp | 16 +++
flang/lib/Lower/ConvertCall.cpp | 39 +++---
flang/lib/Semantics/expression.cpp | 66 +++++++++-
.../Lower/HLFIR/call-parameter-array-arg.f90 | 114 ++++++++++++++++++
.../Lower/HLFIR/calls-constant-expr-arg.f90 | 13 +-
flang/test/Lower/Intrinsics/ieee_flag.f90 | 44 +++----
flang/test/Lower/call-by-value-attr.f90 | 2 +-
8 files changed, 262 insertions(+), 55 deletions(-)
create mode 100644 flang/test/Lower/HLFIR/call-parameter-array-arg.f90
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 6e4ea495c6ab8..c13e0fef46957 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -1657,8 +1657,21 @@ std::optional<bool> ActualArgNeedsCopy(const ActualArgument *actual,
: nullptr};
const bool forCopyIn{!forCopyOut};
if (!evaluate::IsVariable(*actual)) {
- // Expressions are copy-in, but not copy-out.
- return forCopyIn;
+ // A designator whose base object is a named constant is not a variable,
+ // but it still designates an object with storage. It never needs
+ // copy-out, since a named constant is not definable; whether it needs
+ // copy-in depends on its contiguity, like a variable, so fall through
+ // to the analysis below. Other expressions are copy-in, but not
+ // copy-out.
+ const auto dataRef{ExtractDataRef(
+ *actual, /*intoSubstring=*/true, /*intoComplexPart=*/true)};
+ if (!dataRef ||
+ !semantics::IsNamedConstant(dataRef->GetFirstSymbol().GetUltimate())) {
+ return forCopyIn;
+ }
+ if (forCopyOut) {
+ return false;
+ }
}
if (forCopyOut) {
// F2023 8.5.10 C846/p2/p6: a nonpointer INTENT(IN) dummy and its
@@ -1675,7 +1688,11 @@ std::optional<bool> ActualArgNeedsCopy(const ActualArgument *actual,
}
}
}
- auto maybeContigActual{IsContiguous(*actual, fc)};
+ // Copy decisions depend on the actual argument's physical contiguity,
+ // so do not let sections of named constants be presumed contiguous here
+ // (they are for IS_CONTIGUOUS(), but their storage is what it is).
+ auto maybeContigActual{
+ IsContiguous(*actual, fc, /*namedConstantSectionsAreContiguous=*/false)};
if (dummyObj) { // Explict interface
CopyInOutExplicitInterface check{fc, *actual, *dummyObj};
if (forCopyOut && check.HasIntentIn()) {
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 88874f7ef08e8..4b0d493959ec9 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -3962,6 +3962,22 @@ static bool CheckAtomicDefineAndRef(FoldingContext &context,
// Applies any semantic checks peculiar to an intrinsic.
// TODO: Move the rest of these checks to Semantics/check-call.cpp.
static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
+ // Actual arguments may have been retained in named-constant designator
+ // form for the benefit of nonintrinsic calls (storage association); the
+ // checks below inspect constant values structurally, so fold such
+ // arguments back to their values first.
+ for (auto &arg : call.arguments) {
+ if (arg && !arg->isAlternateReturn()) {
+ if (Expr<SomeType> * expr{arg->UnwrapExpr()}) {
+ if (auto dataRef{ExtractDataRef(
+ *expr, /*intoSubstring=*/true, /*intoComplexPart=*/true)};
+ dataRef &&
+ IsNamedConstant(dataRef->GetFirstSymbol().GetUltimate())) {
+ *expr = Fold(context, std::move(*expr));
+ }
+ }
+ }
+ }
bool ok{true};
const std::string &name{call.specificIntrinsic.name};
if (name == "allocated") {
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 19678e429249b..13fbc94ad4278 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1387,19 +1387,24 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
bool mustDoCopyIn{false};
bool mustDoCopyOut{false};
+ // Default to suggesting a copy when the copy analysis does not run, so
+ // that the parameter-object temporary below stays conservative in
+ // contexts that disable the analysis.
+ bool suggestCopyIn{true};
+ bool suggestCopyOut{true};
if (callContext.doCopyIn) {
Fortran::evaluate::FoldingContext &foldingContext{
callContext.converter.getFoldingContext()};
- bool suggestCopyIn = Fortran::evaluate::ActualArgNeedsCopy(
- arg.entity, arg.characteristics, foldingContext,
- /*forCopyOut=*/false)
- .value_or(true);
- bool suggestCopyOut = Fortran::evaluate::ActualArgNeedsCopy(
- arg.entity, arg.characteristics, foldingContext,
- /*forCopyOut=*/true)
- .value_or(true);
+ suggestCopyIn = Fortran::evaluate::ActualArgNeedsCopy(
+ arg.entity, arg.characteristics, foldingContext,
+ /*forCopyOut=*/false)
+ .value_or(true);
+ suggestCopyOut = Fortran::evaluate::ActualArgNeedsCopy(
+ arg.entity, arg.characteristics, foldingContext,
+ /*forCopyOut=*/true)
+ .value_or(true);
mustDoCopyIn = actual.isArray() && suggestCopyIn;
mustDoCopyOut = actual.isArray() && suggestCopyOut;
}
@@ -1496,13 +1501,17 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
if (mustSetDynamicTypeToDummyType)
entity = genSetDynamicTypeToDummyType(entity);
if (arg.hasValueAttribute() ||
- // Constant expressions might be lowered as variables with
- // 'parameter' attribute. Even though the constant expressions
- // are not definable and explicit assignments to them are not
- // possible, we have to create a temporary copies when we pass
- // them down the call stack because of potential compiler
- // generated writes in copy-out.
- isParameterObjectOrSubObject(entity)) {
+ // Named constants and constant expressions might be lowered as
+ // variables with the 'parameter' attribute. Whether a copy is
+ // needed for argument association is decided by the copy-in/copy-out
+ // analysis like for any other object; but when a copy is needed, it
+ // must be made via a temporary rather than via the runtime copy-in
+ // machinery below, both because the entity may be a raw address
+ // (genCopyIn requires a descriptor) and because compiler-generated
+ // copy-out must never target the read-only storage of a
+ // non-definable actual argument.
+ (isParameterObjectOrSubObject(entity) &&
+ (suggestCopyIn || suggestCopyOut))) {
// Make a copy in a temporary.
auto copy = hlfir::AsExprOp::create(builder, loc, entity);
mlir::Type storageType = entity.getType();
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 0a73c108094d0..8b67b4318bcef 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -45,6 +45,8 @@ using common::LanguageFeature;
using common::NumericOperator;
using common::TypeCategory;
+static void FoldNamedConstantActuals(FoldingContext &, ActualArguments &);
+
static inline std::string ToUpperCase(std::string_view str) {
return parser::ToUpperCaseLetters(str);
}
@@ -3480,6 +3482,7 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
CallCharacteristics{name.source.ToString(), isSubroutine},
localArguments, GetFoldingContext())}) {
CheckBadExplicitType(*specificCall, *symbol);
+ FoldNamedConstantActuals(GetFoldingContext(), specificCall->arguments);
return CalleeAndArguments{
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
std::move(specificCall->arguments)};
@@ -3510,6 +3513,7 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
CallCharacteristics{name.ToString(), isSubroutine}, arguments,
GetFoldingContext())}) {
CheckBadExplicitType(*specificCall, *symbol);
+ FoldNamedConstantActuals(GetFoldingContext(), specificCall->arguments);
return CalleeAndArguments{
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
std::move(specificCall->arguments)};
@@ -4925,11 +4929,34 @@ MaybeExpr ExpressionAnalyzer::MakeFunctionRef(parser::CharBlock callSite,
return std::nullopt;
}
+// Fold actual arguments that were retained in named-constant designator form
+// (see ArgumentAnalyzer::AnalyzeExprOrWholeAssumedSizeArray) once the callee
+// has resolved to an intrinsic procedure. Intrinsic argument checking and
+// intrinsic folding inspect constant values structurally, and the storage
+// identity of a named constant is irrelevant to an intrinsic procedure.
+static void FoldNamedConstantActuals(
+ FoldingContext &context, ActualArguments &arguments) {
+ for (auto &arg : arguments) {
+ if (arg && !arg->isAlternateReturn()) {
+ if (Expr<SomeType> * expr{arg->UnwrapExpr()}) {
+ if (auto dataRef{ExtractDataRef(
+ *expr, /*intoSubstring=*/true, /*intoComplexPart=*/true)};
+ dataRef &&
+ semantics::IsNamedConstant(
+ dataRef->GetFirstSymbol().GetUltimate())) {
+ *expr = Fold(context, std::move(*expr));
+ }
+ }
+ }
+ }
+}
+
MaybeExpr ExpressionAnalyzer::MakeFunctionRef(
parser::CharBlock intrinsic, ActualArguments &&arguments) {
if (std::optional<SpecificCall> specificCall{
context_.intrinsics().Probe(CallCharacteristics{intrinsic.ToString()},
arguments, GetFoldingContext())}) {
+ FoldNamedConstantActuals(GetFoldingContext(), specificCall->arguments);
return MakeFunctionRef(intrinsic,
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
std::move(specificCall->arguments));
@@ -5856,7 +5883,44 @@ MaybeExpr ArgumentAnalyzer::AnalyzeExprOrWholeAssumedSizeArray(
}
}
auto restorer{context_.AllowNullPointer()};
- return context_.Analyze(expr);
+ MaybeExpr result{context_.Analyze(expr)};
+ // For actual arguments of procedure references, retain a designator whose
+ // base is a named constant in designator form instead of replacing it by
+ // its folded Constant value, so that lowering associates the dummy argument
+ // with the named constant's storage. This matters for sequence association
+ // of an array element actual argument (F'2023 15.5.2.12) and whenever the
+ // dummy's address is meaningful (e.g. OpenACC/OpenMP present checks).
+ // The inner Analyze calls below do not apply the outer folding performed
+ // by Analyze(parser::Expr), and folding still sees through the retained
+ // designator wherever a constant value is needed later.
+ if (isProcedureCall_ && result) {
+ // Look only at an expression that is itself a designator: a
+ // parenthesized designator is a primary, i.e. an expression
+ // (F'2023 R1001), and must keep its folded value.
+ if (const auto *designator{
+ std::get_if<common::Indirection<parser::Designator>>(&expr.u)}) {
+ if (const auto *name{parser::Unwrap<parser::Name>(designator->value())}) {
+ // Whole named-constant array.
+ if (name->symbol &&
+ semantics::IsNamedConstant(name->symbol->GetUltimate()) &&
+ name->symbol->Rank() > 0) {
+ return context_.Analyze(*name);
+ }
+ } else if (result->Rank() == 0) {
+ // Named-constant array element (or array component of a scalar
+ // named constant of derived type), e.g. a(1) or pt%arr(1).
+ if (const auto *ae{
+ parser::Unwrap<parser::ArrayElement>(designator->value())}) {
+ const auto &baseName{parser::GetFirstName(ae->Base())};
+ if (baseName.symbol &&
+ semantics::IsNamedConstant(baseName.symbol->GetUltimate())) {
+ return context_.Analyze(*ae);
+ }
+ }
+ }
+ }
+ }
+ return result;
}
bool ArgumentAnalyzer::AreConformable() const {
diff --git a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90 b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
new file mode 100644
index 0000000000000..8491392cfe27c
--- /dev/null
+++ b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
@@ -0,0 +1,114 @@
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+! Test that named constant (PARAMETER) array actual arguments are associated
+! with the named constant's storage instead of a temporary copy, when no copy
+! is required for argument association (F'2023 15.5.2.12). A copy is still
+! made whenever argument association requires one (non-contiguous actual,
+! polymorphic dummy, VALUE dummy, or a true constant expression).
+
+module m
+ implicit none
+ integer, parameter :: gp(4) = [1, 2, 3, 4]
+contains
+ subroutine expl(x)
+ integer, intent(in) :: x(4)
+ end subroutine
+ subroutine asmd(x)
+ integer, intent(in) :: x(:)
+ end subroutine
+ subroutine poly(x)
+ class(*), intent(in) :: x(:)
+ end subroutine
+ subroutine byval(x)
+ integer, value :: x(4)
+ end subroutine
+end module
+
+! Whole named-constant array to an explicit-shape dummy: the address of the
+! named constant's global is passed directly; no temporary, no copy-in.
+! CHECK-LABEL: func.func @_QPwhole_explicit_shape
+! CHECK: %[[ADDR:.*]] = fir.address_of(@_QMmECgp) : !fir.ref<!fir.array<4xi32>>
+! CHECK: %[[DECL:.*]]:2 = hlfir.declare %[[ADDR]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK-NOT: hlfir.copy_in
+! CHECK: fir.call @_QMmPexpl(%[[DECL]]#0
+subroutine whole_explicit_shape()
+ use m
+ call expl(gp)
+end subroutine
+
+! Whole named-constant array to an assumed-shape dummy: a descriptor over the
+! named constant's storage; still no temporary.
+! CHECK-LABEL: func.func @_QPwhole_assumed_shape
+! CHECK: %[[ADDR:.*]] = fir.address_of(@_QMmECgp)
+! CHECK: %[[DECL:.*]]:2 = hlfir.declare %[[ADDR]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[BOX:.*]] = fir.embox %[[DECL]]#0
+! CHECK-NOT: hlfir.as_expr
+! CHECK: fir.call @_QMmPasmd
+subroutine whole_assumed_shape()
+ use m
+ call asmd(gp)
+end subroutine
+
+! Named-constant array element to an explicit-shape dummy (sequence
+! association): the element's address is passed; no scalar temporary.
+! CHECK-LABEL: func.func @_QPelement_seq_assoc
+! CHECK: %[[EADDR:.*]] = fir.address_of(@_QMmECgp)
+! CHECK: %[[EDECL:.*]]:2 = hlfir.declare %[[EADDR]]
+! CHECK: %[[ELT:.*]] = hlfir.designate %[[EDECL]]#0 (%{{.*}}) : (!fir.ref<!fir.array<4xi32>>, i64) -> !fir.ref<i32>
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[ECAST:.*]] = fir.convert %[[ELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<4xi32>>
+! CHECK: fir.call @_QMmPexpl(%[[ECAST]])
+subroutine element_seq_assoc()
+ use m
+ call expl(gp(2))
+end subroutine
+
+! Polymorphic assumed-shape dummy: no contiguity requirement, so no copy is
+! needed (same as for a variable actual argument); the descriptor is built
+! over the named constant's storage.
+! CHECK-LABEL: func.func @_QPpoly_dummy
+! CHECK: %[[PADDR:.*]] = fir.address_of(@_QMmECgp)
+! CHECK: %[[PDECL:.*]]:2 = hlfir.declare %[[PADDR]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[PBOX:.*]] = fir.embox %[[PDECL]]#0
+! CHECK: %[[PCLS:.*]] = fir.rebox %[[PBOX]] : (!fir.box<!fir.array<4xi32>>) -> !fir.class<!fir.array<?xnone>>
+! CHECK: fir.call @_QMmPpoly(%[[PCLS]]
+subroutine poly_dummy()
+ use m
+ call poly(gp)
+end subroutine
+
+! A parenthesized named constant is a constant expression, not a designator
+! (a parenthesized designator is a primary, R1001): it is still materialized
+! into a temporary.
+! CHECK-LABEL: func.func @_QPparen_expr
+! CHECK: fir.address_of(@_QQro.4xi4.0)
+! CHECK: %[[PAREN_TMP:.*]]:3 = hlfir.associate {{.*}} {adapt.valuebyref}
+! CHECK: fir.call @_QMmPexpl(%[[PAREN_TMP]]#0
+subroutine paren_expr()
+ use m
+ call expl((gp))
+end subroutine
+
+! VALUE dummy: always a copy.
+! CHECK-LABEL: func.func @_QPvalue_dummy
+! CHECK: hlfir.as_expr
+! CHECK: fir.call @_QMmPbyval
+subroutine value_dummy()
+ use m
+ call byval(gp)
+end subroutine
+
+! Implicit interface: the whole named-constant array's address is passed
+! directly (known contiguous).
+! CHECK-LABEL: func.func @_QPimplicit_iface
+! CHECK: fir.address_of(@_QMmECgp)
+! CHECK-NOT: hlfir.as_expr
+! CHECK: fir.call @_QPext_sub
+subroutine implicit_iface()
+ use m
+ external :: ext_sub
+ call ext_sub(gp)
+end subroutine
diff --git a/flang/test/Lower/HLFIR/calls-constant-expr-arg.f90 b/flang/test/Lower/HLFIR/calls-constant-expr-arg.f90
index 2186bda79a46f..b6a19bd013c97 100644
--- a/flang/test/Lower/HLFIR/calls-constant-expr-arg.f90
+++ b/flang/test/Lower/HLFIR/calls-constant-expr-arg.f90
@@ -84,9 +84,10 @@ subroutine foo(x)
! CHECK: %[[VAL_19:.*]]:2 = hlfir.declare %[[VAL_18]] {{.*}}
! CHECK: %[[VAL_25:.*]] = hlfir.designate %[[VAL_19]]#0 {{.*}}
! CHECK: %[[VAL_26:.*]]:2 = hlfir.declare %[[VAL_25]] {uniq_name = "_QFtest_associateEb"} : (!fir.box<!fir.array<1xf32>>) -> (!fir.box<!fir.array<1xf32>>, !fir.box<!fir.array<1xf32>>)
-! CHECK: %[[VAL_27:.*]] = hlfir.as_expr %[[VAL_26]]#0 : (!fir.box<!fir.array<1xf32>>) -> !hlfir.expr<1xf32>
-! CHECK: %[[VAL_30:.*]]:3 = hlfir.associate %[[VAL_27]]({{.*}}) {adapt.valuebyref} : (!hlfir.expr<1xf32>, !fir.shape<1>) -> (!fir.ref<!fir.array<1xf32>>, !fir.ref<!fir.array<1xf32>>, i1)
-! CHECK: %[[VAL_31:.*]] = fir.embox %[[VAL_30]]
-! CHECK: %[[VAL_32:.*]] = fir.convert %[[VAL_31]] : (!fir.box<!fir.array<1xf32>>) -> !fir.box<!fir.array<?xf32>>
-! CHECK: fir.call @_QPfoo(%[[VAL_32]]) {{.*}} : (!fir.box<!fir.array<?xf32>>) -> ()
-! CHECK: hlfir.end_associate %[[VAL_30]]#1, %[[VAL_30]]#2 : !fir.ref<!fir.array<1xf32>>, i1
+! No copy: the dummy argument is assumed shape, so the (possibly discontiguous)
+! descriptor over the named constant's storage is passed directly, and there is
+! no copy-out because the actual argument is not definable.
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_26]]#0 : (!fir.box<!fir.array<1xf32>>) -> !fir.box<!fir.array<?xf32>>
+! CHECK: fir.call @_QPfoo(%[[VAL_27]]) {{.*}} : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK-NOT: hlfir.copy_out
diff --git a/flang/test/Lower/Intrinsics/ieee_flag.f90 b/flang/test/Lower/Intrinsics/ieee_flag.f90
index acf3fedae4181..12b04879656e5 100644
--- a/flang/test/Lower/Intrinsics/ieee_flag.f90
+++ b/flang/test/Lower/Intrinsics/ieee_flag.f90
@@ -157,10 +157,8 @@
! CHECK: %[[V_158:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
print*, '[overflow[T], invalid[F]]: ', v2
- ! CHECK: %[[V_165:[0-9]+]] = fir.address_of(@_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4) : !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
- ! CHECK: %[[V_166:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_166]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.convert %[[V_312]] : (i8) -> i32
@@ -173,9 +171,8 @@
! CHECK: }
call ieee_set_flag(ieee_usual, .true.)
- ! CHECK: %[[V_167:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_167]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_64]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
@@ -191,11 +188,10 @@
! CHECK: %[[V_168:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
print*, '[overflow[T], divide_by_zero[T], invalid[T]]: ', v_usual
- ! CHECK: %[[V_178:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
- ! CHECK: %[[V_179:[0-9]+]] = fir.address_of(@_QQro.3xl4.5) : !fir.ref<!fir.array<3x!fir.logical<4>>>
- ! CHECK: %[[V_180:[0-9]+]] = fir.declare %[[V_179]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3xl4.5"} : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.logical<4>>>
+ ! CHECK: %[[V_179:[0-9]+]] = fir.address_of(@_QQro.3xl4.4) : !fir.ref<!fir.array<3x!fir.logical<4>>>
+ ! CHECK: %[[V_180:[0-9]+]] = fir.declare %[[V_179]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3xl4.4"} : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.logical<4>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_178]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_180]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<!fir.logical<4>>
! CHECK: %[[V_313:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
@@ -211,9 +207,8 @@
! CHECK: }
call ieee_set_flag(ieee_usual, [.true., .false., .true.])
- ! CHECK: %[[V_181:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_181]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_64]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
@@ -229,10 +224,8 @@
! CHECK: %[[V_182:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
print*, '[overflow[T], divide_by_zero[F], invalid[T]]: ', v_usual
- ! CHECK: %[[V_189:[0-9]+]] = fir.address_of(@_QQro.5x_QM__fortran_builtinsT__builtin_ieee_flag_type.6) : !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
- ! CHECK: %[[V_190:[0-9]+]] = fir.declare %[[V_189]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_builtinsT__builtin_ieee_flag_type.6"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_190]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_2]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.convert %[[V_312]] : (i8) -> i32
@@ -245,9 +238,8 @@
! CHECK: }
call ieee_set_flag(ieee_all, .false.)
- ! CHECK: %[[V_191:[0-9]+]] = fir.declare %[[V_189]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_builtinsT__builtin_ieee_flag_type.6"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_191]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_2]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
@@ -399,9 +391,8 @@
! CHECK: %[[V_277:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
print*, '[overflow[T], invalid[F]]: ', v2
- ! CHECK: %[[V_283:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_283]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.convert %[[V_312]] : (i8) -> i32
@@ -414,9 +405,8 @@
! CHECK: }
call ieee_set_halting_mode(ieee_usual, .true.)
- ! CHECK: %[[V_284:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_284]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_64]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
@@ -433,10 +423,9 @@
! CHECK: %[[V_285:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
print*, '[overflow[T], divide_by_zero[T], invalid[T]]: ', v_usual
- ! CHECK: %[[V_291:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
- ! CHECK: %[[V_292:[0-9]+]] = fir.declare %[[V_179]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3xl4.5"} : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.logical<4>>>
+ ! CHECK: %[[V_292:[0-9]+]] = fir.declare %[[V_179]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3xl4.4"} : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.logical<4>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_291]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_292]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<!fir.logical<4>>
! CHECK: %[[V_313:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
@@ -452,9 +441,8 @@
! CHECK: }
call ieee_set_halting_mode(ieee_usual, [.true., .false., .true.])
- ! CHECK: %[[V_293:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_293]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_64]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
@@ -471,9 +459,8 @@
! CHECK: %[[V_294:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
print*, '[overflow[T], divide_by_zero[F], invalid[T]]: ', v_usual
- ! CHECK: %[[V_300:[0-9]+]] = fir.declare %[[V_189]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_builtinsT__builtin_ieee_flag_type.6"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_300]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_2]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.convert %[[V_312]] : (i8) -> i32
@@ -486,9 +473,8 @@
! CHECK: }
call ieee_set_halting_mode(ieee_all, .true.)
- ! CHECK: %[[V_301:[0-9]+]] = fir.declare %[[V_189]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_builtinsT__builtin_ieee_flag_type.6"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_301]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_2]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
diff --git a/flang/test/Lower/call-by-value-attr.f90 b/flang/test/Lower/call-by-value-attr.f90
index 9b9076722828e..e28d1ee1baa56 100644
--- a/flang/test/Lower/call-by-value-attr.f90
+++ b/flang/test/Lower/call-by-value-attr.f90
@@ -61,7 +61,7 @@ subroutine takes_array_value(v)
end interface
integer, parameter :: p(100) = 42
call takes_array_value(p)
- ! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare {{.*}}"_QQro.100xi4.2"
+ ! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare {{.*}}"_QFtest_litteral_copies_1ECp"
! CHECK: %[[VAL_8:.*]] = hlfir.as_expr %[[VAL_7]]#0 : (!fir.ref<!fir.array<100xi32>>) -> !hlfir.expr<100xi32>
! CHECK: %[[VAL_9:.*]]:3 = hlfir.associate %[[VAL_8]](%{{.*}}) {adapt.valuebyref} : (!hlfir.expr<100xi32>, !fir.shape<1>) -> (!fir.ref<!fir.array<100xi32>>, !fir.ref<!fir.array<100xi32>>, i1)
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]]#0 : (!fir.ref<!fir.array<100xi32>>) -> !fir.ref<!fir.array<4xi32>>
>From 059af6ff7db33da2f051854b905aff0f00c5b6f8 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Fri, 11 Sep 2026 10:00:11 -0700
Subject: [PATCH 02/13] [flang] Test named constants of derived type as actual
arguments
Add derived-type coverage to the named-constant actual argument test:
whole constant array to explicit-shape and assumed-shape dummies and an
element of a constant array (all associated directly with the named
constant's storage), an array-component element of a scalar named
constant passed to an array dummy (sequence association), and the two
shapes that keep the temporary-copy behavior (a whole scalar named
constant and a whole array component of a scalar named constant).
---
.../Lower/HLFIR/call-parameter-array-arg.f90 | 93 +++++++++++++++++++
1 file changed, 93 insertions(+)
diff --git a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90 b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
index 8491392cfe27c..281b3b7b1d1ae 100644
--- a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
+++ b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
@@ -112,3 +112,96 @@ subroutine implicit_iface()
external :: ext_sub
call ext_sub(gp)
end subroutine
+
+! ---- Named constants of derived type ----
+
+module md
+ implicit none
+ type :: t
+ integer :: k
+ integer :: a(3)
+ end type
+ type(t), parameter :: ds = t(7, [1, 2, 3])
+ type(t), parameter :: dc(2) = [t(1, [1, 2, 3]), t(2, [4, 5, 6])]
+contains
+ subroutine dt_scalar(x)
+ type(t), intent(in) :: x
+ end subroutine
+ subroutine dt_array(x)
+ type(t), intent(in) :: x(2)
+ end subroutine
+ subroutine dt_assumed(x)
+ type(t), intent(in) :: x(:)
+ end subroutine
+ subroutine int_array(x)
+ integer, intent(in) :: x(3)
+ end subroutine
+end module
+
+! Whole derived-type named-constant array to an explicit-shape dummy: direct.
+! CHECK-LABEL: func.func @_QPderived_whole_array
+! CHECK: %[[DA:.*]] = fir.address_of(@_QMmdECdc)
+! CHECK: %[[DAD:.*]]:2 = hlfir.declare %[[DA]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK: fir.call @_QMmdPdt_array(%[[DAD]]#0
+subroutine derived_whole_array()
+ use md
+ call dt_array(dc)
+end subroutine
+
+! Whole derived-type named-constant array to an assumed-shape dummy: a
+! descriptor over the named constant's storage.
+! CHECK-LABEL: func.func @_QPderived_assumed_shape
+! CHECK: %[[DB:.*]] = fir.address_of(@_QMmdECdc)
+! CHECK: %[[DBD:.*]]:2 = hlfir.declare %[[DB]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[DBOX:.*]] = fir.embox %[[DBD]]#0
+! CHECK-NOT: hlfir.as_expr
+! CHECK: fir.call @_QMmdPdt_assumed
+subroutine derived_assumed_shape()
+ use md
+ call dt_assumed(dc)
+end subroutine
+
+! Element of a derived-type named-constant array to a scalar dummy: the
+! element's address is passed.
+! CHECK-LABEL: func.func @_QPderived_array_element
+! CHECK: %[[DC:.*]] = fir.address_of(@_QMmdECdc)
+! CHECK: %[[DCD:.*]]:2 = hlfir.declare %[[DC]]
+! CHECK: %[[DELT:.*]] = hlfir.designate %[[DCD]]#0 (%{{.*}})
+! CHECK-NOT: hlfir.as_expr
+! CHECK: fir.call @_QMmdPdt_scalar(%[[DELT]])
+subroutine derived_array_element()
+ use md
+ call dt_scalar(dc(2))
+end subroutine
+
+! Array-component element of a scalar derived-type named constant, passed to
+! an array dummy (sequence association): the element's address is passed.
+! CHECK-LABEL: func.func @_QPderived_component_element
+! CHECK: %[[DS:.*]] = fir.address_of(@_QMmdECds)
+! CHECK: %[[DSD:.*]]:2 = hlfir.declare %[[DS]]
+! CHECK: %[[DCELT:.*]] = hlfir.designate %[[DSD]]#0{"a"} <%{{.*}}> (%c1{{.*}}) : {{.*}} -> !fir.ref<i32>
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[DCAST:.*]] = fir.convert %[[DCELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<3xi32>>
+! CHECK: fir.call @_QMmdPint_array(%[[DCAST]])
+subroutine derived_component_element()
+ use md
+ call int_array(ds%a(1))
+end subroutine
+
+! A whole SCALAR derived-type named constant and a whole array COMPONENT of a
+! scalar named constant are not (yet) retained in designator form: they keep
+! the temporary-copy behavior.
+! CHECK-LABEL: func.func @_QPderived_scalar_and_component
+! CHECK: hlfir.as_expr
+! CHECK: hlfir.associate {{.*}} {adapt.valuebyref}
+! CHECK: fir.call @_QMmdPdt_scalar
+! CHECK: hlfir.as_expr
+! CHECK: hlfir.associate {{.*}} {adapt.valuebyref}
+! CHECK: fir.call @_QMmdPint_array
+subroutine derived_scalar_and_component()
+ use md
+ call dt_scalar(ds)
+ call int_array(ds%a)
+end subroutine
>From c5b2e0305ae5efdebfa3cd950ac26caa880931b4 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Tue, 15 Sep 2026 09:16:36 -0700
Subject: [PATCH 03/13] [flang] Fold retained named-constant actuals when a
call resolves to an intrinsic
Replace the per-site folding of retained named-constant designators with a
single presence-gated fold at IntrinsicProcTable::Probe entry: when an actual
argument retains a named-constant designator, probe with a folded copy, so
that intrinsic matching, argument checking, and the special handlers all see
constant values, while a failed probe leaves the caller's original arguments
untouched for subsequent nonintrinsic resolution. This also covers checks
that ran before the previous per-site folds (e.g. the DIM= range checks and
the special handlers), which could otherwise silently skip diagnostics.
The PowerPC vector intrinsics are resolved as module procedures, not through
Probe, and both their semantic checks and PowerPC lowering require constant
values; fold at the point where the call commits to the __ppc_ resolution.
Also diagnose, rather than CHECK(), a constant expression whose value is not
statically known in CheckArgumentIsConstantExprInRange, as defense in depth.
The folding helpers are exported from Evaluate (AnyNamedConstantActualArguments,
FoldNamedConstantActualArguments) next to ActualArgNeedsCopy.
---
.../include/flang/Evaluate/check-expression.h | 9 +++++
flang/lib/Evaluate/check-expression.cpp | 34 +++++++++++++++++
flang/lib/Evaluate/intrinsics.cpp | 32 ++++++++--------
flang/lib/Semantics/expression.cpp | 37 +++++--------------
.../PowerPC/ppc-vec-shift-parameter.f90 | 21 +++++++++++
.../PowerPC/ppc-vector-intrinsics.f90 | 9 +++++
6 files changed, 98 insertions(+), 44 deletions(-)
create mode 100644 flang/test/Integration/PowerPC/ppc-vec-shift-parameter.f90
diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h
index c837a7d72e8b1..2b8cb4ea457eb 100644
--- a/flang/include/flang/Evaluate/check-expression.h
+++ b/flang/include/flang/Evaluate/check-expression.h
@@ -177,6 +177,15 @@ extern template bool IsErrorExpr(const Expr<SomeType> &);
std::optional<parser::Message> CheckStatementFunction(
const Symbol &, const Expr<SomeType> &, FoldingContext &);
+// Actual arguments of procedure references may retain designators of named
+// constants (rather than their folded values) so that lowering can associate
+// dummy arguments with the named constant's storage. Intrinsic argument
+// matching, checking, and folding inspect constant values structurally, so
+// such arguments must be folded back to values once a call is known to
+// resolve to an intrinsic procedure.
+bool AnyNamedConstantActualArguments(const ActualArguments &);
+void FoldNamedConstantActualArguments(FoldingContext &, ActualArguments &);
+
std::optional<bool> ActualArgNeedsCopy(const ActualArgument *,
const characteristics::DummyArgument *, FoldingContext &, bool forCopyOut);
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index c13e0fef46957..0f24689cf79de 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -1643,6 +1643,40 @@ class CopyInOutExplicitInterface {
// perspective, meaning that for copy-in the caller need to do the copy
// before calling the callee. Similarly, for copy-out the caller is expected
// to do the copy after the callee returns.
+static bool IsNamedConstantDesignator(const Expr<SomeType> &expr) {
+ if (auto dataRef{ExtractDataRef(
+ expr, /*intoSubstring=*/true, /*intoComplexPart=*/true)}) {
+ return semantics::IsNamedConstant(dataRef->GetFirstSymbol().GetUltimate());
+ }
+ return false;
+}
+
+bool AnyNamedConstantActualArguments(const ActualArguments &arguments) {
+ for (const auto &arg : arguments) {
+ if (arg && !arg->isAlternateReturn()) {
+ if (const Expr<SomeType> *expr{arg->UnwrapExpr()}) {
+ if (IsNamedConstantDesignator(*expr)) {
+ return true;
+ }
+ }
+ }
+ }
+ return false;
+}
+
+void FoldNamedConstantActualArguments(
+ FoldingContext &context, ActualArguments &arguments) {
+ for (auto &arg : arguments) {
+ if (arg && !arg->isAlternateReturn()) {
+ if (Expr<SomeType> * expr{arg->UnwrapExpr()}) {
+ if (IsNamedConstantDesignator(*expr)) {
+ *expr = Fold(context, std::move(*expr));
+ }
+ }
+ }
+ }
+}
+
std::optional<bool> ActualArgNeedsCopy(const ActualArgument *actual,
const characteristics::DummyArgument *dummy, FoldingContext &fc,
bool forCopyOut) {
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 4b0d493959ec9..e6f39ae89ab05 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -3962,22 +3962,6 @@ static bool CheckAtomicDefineAndRef(FoldingContext &context,
// Applies any semantic checks peculiar to an intrinsic.
// TODO: Move the rest of these checks to Semantics/check-call.cpp.
static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
- // Actual arguments may have been retained in named-constant designator
- // form for the benefit of nonintrinsic calls (storage association); the
- // checks below inspect constant values structurally, so fold such
- // arguments back to their values first.
- for (auto &arg : call.arguments) {
- if (arg && !arg->isAlternateReturn()) {
- if (Expr<SomeType> * expr{arg->UnwrapExpr()}) {
- if (auto dataRef{ExtractDataRef(
- *expr, /*intoSubstring=*/true, /*intoComplexPart=*/true)};
- dataRef &&
- IsNamedConstant(dataRef->GetFirstSymbol().GetUltimate())) {
- *expr = Fold(context, std::move(*expr));
- }
- }
- }
- }
bool ok{true};
const std::string &name{call.specificIntrinsic.name};
if (name == "allocated") {
@@ -4495,6 +4479,22 @@ std::string IntrinsicProcTable::GetGenericIntrinsicName(
std::optional<SpecificCall> IntrinsicProcTable::Probe(
const CallCharacteristics &call, ActualArguments &arguments,
FoldingContext &context) const {
+ // Actual arguments may retain designators of named constants for the
+ // benefit of storage association in nonintrinsic calls (see
+ // ArgumentAnalyzer::AnalyzeExprOrWholeAssumedSizeArray). Intrinsic
+ // matching, argument checking, and the special handlers inspect constant
+ // values structurally, so probe with a folded copy of such arguments.
+ // On success the SpecificCall carries the folded arguments; on failure
+ // the caller's original arguments are left untouched for subsequent
+ // nonintrinsic resolution. (Note a pre-existing quirk, unchanged here:
+ // Match() moves arguments while rearranging them and can still fail late,
+ // so a failed match can leave a probe's working vector partially moved
+ // from; using a copy confines that to the copy.)
+ if (AnyNamedConstantActualArguments(arguments)) {
+ ActualArguments folded{arguments};
+ FoldNamedConstantActualArguments(context, folded);
+ return DEREF(impl_.get()).Probe(call, folded, context);
+ }
return DEREF(impl_.get()).Probe(call, arguments, context);
}
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 8b67b4318bcef..20e20b91c4efb 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -45,8 +45,6 @@ using common::LanguageFeature;
using common::NumericOperator;
using common::TypeCategory;
-static void FoldNamedConstantActuals(FoldingContext &, ActualArguments &);
-
static inline std::string ToUpperCase(std::string_view str) {
return parser::ToUpperCaseLetters(str);
}
@@ -3482,7 +3480,6 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
CallCharacteristics{name.source.ToString(), isSubroutine},
localArguments, GetFoldingContext())}) {
CheckBadExplicitType(*specificCall, *symbol);
- FoldNamedConstantActuals(GetFoldingContext(), specificCall->arguments);
return CalleeAndArguments{
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
std::move(specificCall->arguments)};
@@ -3491,6 +3488,12 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
if (resolution) {
if (context_.GetPPCBuiltinsScope() &&
resolution->name().ToString().rfind("__ppc_", 0) == 0) {
+ // The PowerPC intrinsic checks and PowerPC lowering require constant
+ // values for some arguments; now that the call is committed to this
+ // resolution, fold any named-constant designators that were retained
+ // for storage association.
+ evaluate::FoldNamedConstantActualArguments(
+ GetFoldingContext(), arguments);
semantics::CheckPPCIntrinsic(
*symbol, *resolution, arguments, GetFoldingContext());
}
@@ -3513,7 +3516,6 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
CallCharacteristics{name.ToString(), isSubroutine}, arguments,
GetFoldingContext())}) {
CheckBadExplicitType(*specificCall, *symbol);
- FoldNamedConstantActuals(GetFoldingContext(), specificCall->arguments);
return CalleeAndArguments{
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
std::move(specificCall->arguments)};
@@ -4929,34 +4931,11 @@ MaybeExpr ExpressionAnalyzer::MakeFunctionRef(parser::CharBlock callSite,
return std::nullopt;
}
-// Fold actual arguments that were retained in named-constant designator form
-// (see ArgumentAnalyzer::AnalyzeExprOrWholeAssumedSizeArray) once the callee
-// has resolved to an intrinsic procedure. Intrinsic argument checking and
-// intrinsic folding inspect constant values structurally, and the storage
-// identity of a named constant is irrelevant to an intrinsic procedure.
-static void FoldNamedConstantActuals(
- FoldingContext &context, ActualArguments &arguments) {
- for (auto &arg : arguments) {
- if (arg && !arg->isAlternateReturn()) {
- if (Expr<SomeType> * expr{arg->UnwrapExpr()}) {
- if (auto dataRef{ExtractDataRef(
- *expr, /*intoSubstring=*/true, /*intoComplexPart=*/true)};
- dataRef &&
- semantics::IsNamedConstant(
- dataRef->GetFirstSymbol().GetUltimate())) {
- *expr = Fold(context, std::move(*expr));
- }
- }
- }
- }
-}
-
MaybeExpr ExpressionAnalyzer::MakeFunctionRef(
parser::CharBlock intrinsic, ActualArguments &&arguments) {
if (std::optional<SpecificCall> specificCall{
context_.intrinsics().Probe(CallCharacteristics{intrinsic.ToString()},
arguments, GetFoldingContext())}) {
- FoldNamedConstantActuals(GetFoldingContext(), specificCall->arguments);
return MakeFunctionRef(intrinsic,
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
std::move(specificCall->arguments));
@@ -5896,7 +5875,9 @@ MaybeExpr ArgumentAnalyzer::AnalyzeExprOrWholeAssumedSizeArray(
if (isProcedureCall_ && result) {
// Look only at an expression that is itself a designator: a
// parenthesized designator is a primary, i.e. an expression
- // (F'2023 R1001), and must keep its folded value.
+ // (F'2023 R1001), and must keep its folded value. Substring actual
+ // arguments (the F'2023 15.5.2.12 p4 form of character sequence
+ // association) are not retained here and keep their folded values.
if (const auto *designator{
std::get_if<common::Indirection<parser::Designator>>(&expr.u)}) {
if (const auto *name{parser::Unwrap<parser::Name>(designator->value())}) {
diff --git a/flang/test/Integration/PowerPC/ppc-vec-shift-parameter.f90 b/flang/test/Integration/PowerPC/ppc-vec-shift-parameter.f90
new file mode 100644
index 0000000000000..b259a35fd7337
--- /dev/null
+++ b/flang/test/Integration/PowerPC/ppc-vec-shift-parameter.f90
@@ -0,0 +1,21 @@
+!===----------------------------------------------------------------------===!
+! This directory can be used to add Integration tests involving multiple
+! stages of the compiler (for eg. from Fortran to LLVM IR). It should not
+! contain executable tests. We should only add tests here sparingly and only
+! if there is no other way to test. Repeat this message in each test that is
+! added to this directory and sub-directories.
+!===----------------------------------------------------------------------===!
+
+! RUN: %flang_fc1 -emit-llvm %s -triple ppc64le-unknown-linux -o - | FileCheck %s
+! REQUIRES: target=powerpc{{.*}}
+
+! The shift amount of vec_sld must reach PowerPC lowering as a constant even
+! when it is written as an element of a named constant (which the front end
+! may keep in designator form for storage association).
+subroutine test_sld_parameter(arg1, arg2, r)
+ vector(integer(4)) :: arg1, arg2, r
+ integer, parameter :: sh(1) = [2]
+ r = vec_sld(arg1, arg2, sh(1))
+end subroutine
+! CHECK-LABEL: @test_sld_parameter_
+! CHECK: shufflevector <16 x i8> %{{[0-9]+}}, <16 x i8> %{{[0-9]+}}, <16 x i32>
diff --git a/flang/test/Semantics/PowerPC/ppc-vector-intrinsics.f90 b/flang/test/Semantics/PowerPC/ppc-vector-intrinsics.f90
index e0df315fa57df..bb80bcd0d792c 100644
--- a/flang/test/Semantics/PowerPC/ppc-vector-intrinsics.f90
+++ b/flang/test/Semantics/PowerPC/ppc-vector-intrinsics.f90
@@ -5,6 +5,15 @@ program test
vector(integer(4)) :: arg1, arg2, r
vector(real(4)) :: rr
integer :: i
+ integer, parameter :: sh(1) = [2]
+ integer, parameter :: shbad(1) = [17]
+
+! An element of a named constant is a constant expression whose value must be
+! usable by the range check (it is folded when the call commits to the PowerPC
+! intrinsic), not a crash.
+ r = vec_sld(arg1, arg2, sh(1))
+!ERROR: Argument #3 must be a constant expression in range 0 to 15
+ r = vec_sld(arg1, arg2, shbad(1))
!ERROR: Actual argument #3 must be a constant expression
r = vec_sld(arg1, arg2, i)
>From 9eadb37cdb9ab6f1ab05edac5aecd4287e86e5d6 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Tue, 15 Sep 2026 09:16:37 -0700
Subject: [PATCH 04/13] [flang] Diagnose short storage sequences for
named-constant array elements
A named constant has no storage offsets, so the DesignatorFolder-based
storage-sequence extent check (F'2023 15.5.2.12 p6) silently skipped named
constant array element actual arguments; compute the remaining sequence from
the constant's shape, lower bounds, and constant subscripts instead, so that
passing a too-short remainder to an explicit-shape dummy is diagnosed the
same way it is for variables.
Also correct the element sequence-association case in
call-parameter-array-arg.f90 to use a dummy whose extent matches the
remaining sequence, and add semantics tests covering the accepted element
association, the short-sequence diagnostic, INTENT definability rejection,
and the DIM= range check on a named-constant argument.
---
flang/lib/Semantics/check-call.cpp | 69 ++++++++++++++++++-
.../Lower/HLFIR/call-parameter-array-arg.f90 | 13 ++--
.../Semantics/call-parameter-seq-assoc.f90 | 54 +++++++++++++++
3 files changed, 130 insertions(+), 6 deletions(-)
create mode 100644 flang/test/Semantics/call-parameter-seq-assoc.f90
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 2fd7ff5ac1a5c..b12c8bd604b10 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -706,9 +706,67 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
} else if (actualRank == 0) {
if (evaluate::IsArrayElement(actual)) {
// Actual argument is a scalar array element
+ std::optional<std::int64_t> namedConstElements;
+ if (auto dataRef{evaluate::ExtractDataRef(actual)}) {
+ // A named constant has no storage offsets, so FoldDesignator
+ // below cannot measure it; compute the remaining storage
+ // sequence from the constant subscripts of a whole-symbol
+ // array element reference instead.
+ if (const auto *aRef{
+ std::get_if<evaluate::ArrayRef>(&dataRef->u)}) {
+ const Symbol &ncBase{aRef->base().GetLastSymbol()};
+ if (IsNamedConstant(ncBase.GetUltimate()) &&
+ aRef->base().IsSymbol()) {
+ if (auto extents{evaluate::GetConstantExtents(
+ foldingContext, &ncBase)}) {
+ evaluate::Shape lbShape{evaluate::GetLBOUNDs(aRef->base())};
+ std::int64_t linear{0}, stride{1}, total{1};
+ bool ok{extents->size() == aRef->subscript().size() &&
+ extents->size() == lbShape.size()};
+ for (std::size_t d{0}; ok && d < extents->size(); ++d) {
+ auto lb{lbShape[d]
+ ? evaluate::ToInt64(evaluate::Fold(
+ foldingContext, std::move(*lbShape[d])))
+ : std::nullopt};
+ const auto *ssExpr{
+ std::get_if<evaluate::IndirectSubscriptIntegerExpr>(
+ &aRef->subscript()[d].u)};
+ auto ss{ssExpr
+ ? evaluate::ToInt64(evaluate::Fold(foldingContext,
+ common::Clone(ssExpr->value())))
+ : std::nullopt};
+ if (lb && ss) {
+ linear += (*ss - *lb) * stride;
+ stride *= (*extents)[d];
+ total *= (*extents)[d];
+ } else {
+ ok = false;
+ }
+ }
+ if (ok && linear >= 0 && linear < total) {
+ namedConstElements = total - linear;
+ }
+ }
+ }
+ }
+ }
evaluate::DesignatorFolder folder{
context.foldingContext(), /*getLastComponent=*/true};
- if (auto actualOffset{folder.FoldDesignator(actual)}) {
+ if (namedConstElements) {
+ if (*namedConstElements < *dummySize) {
+ if (extentErrors) {
+ messages.Say(
+ "Actual argument has fewer elements remaining in storage sequence (%jd) than %s array (%jd)"_err_en_US,
+ static_cast<std::intmax_t>(*namedConstElements),
+ dummyName, static_cast<std::intmax_t>(*dummySize));
+ } else {
+ foldingContext.Warn(common::UsageWarning::ShortArrayActual,
+ "Actual argument has fewer elements remaining in storage sequence (%jd) than %s array (%jd)"_warn_en_US,
+ static_cast<std::intmax_t>(*namedConstElements),
+ dummyName, static_cast<std::intmax_t>(*dummySize));
+ }
+ }
+ } else if (auto actualOffset{folder.FoldDesignator(actual)}) {
std::optional<std::int64_t> actualElements;
if (IsAllocatableOrPointer(actualOffset->symbol())) {
// don't use actualOffset->symbol().size()!
@@ -2567,7 +2625,14 @@ bool CheckArgumentIsConstantExprInRange(
// for the intrinsic's argument should have been check prior. This is just
// a conversion so that we can read the constant value.
auto scalarValue{evaluate::ToInt64(argExpr)};
- CHECK(scalarValue.has_value());
+ if (!scalarValue) {
+ // A constant expression whose value is not statically known here (e.g.
+ // a designator that was not folded); diagnose rather than crash.
+ messages.Say(
+ "Actual argument #%d must be a constant integer expression"_err_en_US,
+ index + 1);
+ return false;
+ }
if (*scalarValue < lowerBound || *scalarValue > upperBound) {
messages.Say(
diff --git a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90 b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
index 281b3b7b1d1ae..d7fae1773ab93 100644
--- a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
+++ b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
@@ -13,6 +13,9 @@ module m
subroutine expl(x)
integer, intent(in) :: x(4)
end subroutine
+ subroutine expl3(x)
+ integer, intent(in) :: x(3)
+ end subroutine
subroutine asmd(x)
integer, intent(in) :: x(:)
end subroutine
@@ -52,17 +55,19 @@ subroutine whole_assumed_shape()
end subroutine
! Named-constant array element to an explicit-shape dummy (sequence
-! association): the element's address is passed; no scalar temporary.
+! association, F'2023 15.5.2.12): the element's address is passed; no scalar
+! temporary. The dummy extent (3) matches the sequence remaining from gp(2)
+! per 15.5.2.12 p6.
! CHECK-LABEL: func.func @_QPelement_seq_assoc
! CHECK: %[[EADDR:.*]] = fir.address_of(@_QMmECgp)
! CHECK: %[[EDECL:.*]]:2 = hlfir.declare %[[EADDR]]
! CHECK: %[[ELT:.*]] = hlfir.designate %[[EDECL]]#0 (%{{.*}}) : (!fir.ref<!fir.array<4xi32>>, i64) -> !fir.ref<i32>
! CHECK-NOT: hlfir.as_expr
-! CHECK: %[[ECAST:.*]] = fir.convert %[[ELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<4xi32>>
-! CHECK: fir.call @_QMmPexpl(%[[ECAST]])
+! CHECK: %[[ECAST:.*]] = fir.convert %[[ELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<3xi32>>
+! CHECK: fir.call @_QMmPexpl3(%[[ECAST]])
subroutine element_seq_assoc()
use m
- call expl(gp(2))
+ call expl3(gp(2))
end subroutine
! Polymorphic assumed-shape dummy: no contiguity requirement, so no copy is
diff --git a/flang/test/Semantics/call-parameter-seq-assoc.f90 b/flang/test/Semantics/call-parameter-seq-assoc.f90
new file mode 100644
index 0000000000000..6b4a90f9be56d
--- /dev/null
+++ b/flang/test/Semantics/call-parameter-seq-assoc.f90
@@ -0,0 +1,54 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Named constants (PARAMETER) as actual arguments: element sequence
+! association is accepted (F'2023 15.5.2.12), short sequences and attempts
+! to modify the dummy are still diagnosed, and intrinsic argument checks
+! that need constant values still fire.
+module m
+ integer, parameter :: gp(4) = [1, 2, 3, 4]
+ integer, parameter :: d1(1) = [5]
+contains
+ subroutine expl3(x)
+ integer, intent(in) :: x(3)
+ end subroutine
+ subroutine expl4(x)
+ integer, intent(in) :: x(4)
+ end subroutine
+ subroutine modifies(x)
+ integer, intent(inout) :: x(3)
+ end subroutine
+ subroutine outputs(x)
+ integer, intent(out) :: x(3)
+ end subroutine
+end module
+
+subroutine accepted()
+ use m
+ ! Element of a named constant to an explicit-shape dummy whose extent
+ ! matches the remaining sequence: conforming, no error.
+ call expl3(gp(2))
+end subroutine
+
+subroutine short_sequence()
+ use m
+ !ERROR: Actual argument has fewer elements remaining in storage sequence (3) than dummy argument 'x=' array (4)
+ call expl4(gp(2))
+end subroutine
+
+subroutine not_definable()
+ use m
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+ !BECAUSE: 'gp' is not a variable
+ call modifies(gp(2))
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+ !BECAUSE: 'gp' is not a variable
+ call outputs(gp(2))
+end subroutine
+
+subroutine intrinsic_dim_check()
+ use m
+ real :: a(2, 3)
+ ! A named-constant DIM= argument out of range must still be diagnosed
+ ! (the designator is folded back to a value for intrinsic checking).
+ !ERROR: The value of DIM= (5) may not be greater than 2
+ print *, sum(a, dim=d1(1))
+end subroutine
>From 9476502c90a87bef031c4a54d834f45d5171f966 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Wed, 16 Sep 2026 07:10:23 -0700
Subject: [PATCH 05/13] [flang][NFC] Reuse IsNamedConstantDesignator in
ActualArgNeedsCopy
The named-constant-designator test in ActualArgNeedsCopy duplicated the
logic of the IsNamedConstantDesignator helper defined just above it; use
the helper. Behaviorally identical: the helper takes the unwrapped
expression rather than the ActualArgument, and the only actual argument
without an expression is an assumed-type passthrough, whose dummy symbol
is never a named constant (and a named constant cannot be assumed-type),
so both paths return forCopyIn for it.
---
flang/lib/Evaluate/check-expression.cpp | 6 ++----
1 file changed, 2 insertions(+), 4 deletions(-)
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 0f24689cf79de..46dccab02df86 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -1697,10 +1697,8 @@ std::optional<bool> ActualArgNeedsCopy(const ActualArgument *actual,
// copy-in depends on its contiguity, like a variable, so fall through
// to the analysis below. Other expressions are copy-in, but not
// copy-out.
- const auto dataRef{ExtractDataRef(
- *actual, /*intoSubstring=*/true, /*intoComplexPart=*/true)};
- if (!dataRef ||
- !semantics::IsNamedConstant(dataRef->GetFirstSymbol().GetUltimate())) {
+ const Expr<SomeType> *expr{actual->UnwrapExpr()};
+ if (!expr || !IsNamedConstantDesignator(*expr)) {
return forCopyIn;
}
if (forCopyOut) {
>From 3d0d35564d9abd0a0a599a3d76a2a39e8db43b12 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Wed, 16 Sep 2026 07:57:58 -0700
Subject: [PATCH 06/13] [flang] Fold named-constant designators in
DesignatorFolder on request
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Replace the hand-rolled remaining-storage-sequence computation for named
constant array elements in check-call.cpp with an opt-in DesignatorFolder
capability: with foldNamedConstants set, the folder resolves a named
constant through its ultimate symbol and folds its designators to
(offset, size) within the constant's own storage sequence, exactly as it
already does for variables (the size comes from the type and constant
extents, not from a storage assignment). Clients that map real memory,
like DATA statement initialization, keep the default and are unchanged.
Both storage-sequence extent checks in check-call.cpp opt in, which also
extends the CHARACTER storage sequence check (F'2023 15.5.2.12 p4) to
named constant elements — previously it silently skipped them — and both
checks now handle use- and host-associated named constants. A shared
ObjectTotalBytes helper measures named constants from their type and
extents where a variable's symbol size would be used.
---
.../include/flang/Evaluate/fold-designator.h | 12 +-
flang/lib/Evaluate/fold-designator.cpp | 22 ++--
flang/lib/Semantics/check-call.cpp | 117 +++++++-----------
.../Semantics/call-parameter-seq-assoc.f90 | 24 ++++
4 files changed, 91 insertions(+), 84 deletions(-)
diff --git a/flang/include/flang/Evaluate/fold-designator.h b/flang/include/flang/Evaluate/fold-designator.h
index 919f3c6db547b..32bb26588407a 100644
--- a/flang/include/flang/Evaluate/fold-designator.h
+++ b/flang/include/flang/Evaluate/fold-designator.h
@@ -59,8 +59,15 @@ class OffsetSymbol {
// corresponding to an element in array element order.
class DesignatorFolder {
public:
- explicit DesignatorFolder(FoldingContext &c, bool getLastComponent = false)
- : context_{c}, getLastComponent_{getLastComponent} {}
+ // A named constant has no storage assignment, but its designators can
+ // still be folded to (offset, size) within the constant's own storage
+ // sequence, which storage sequence association checks need; opt in with
+ // foldNamedConstants. Clients that map real memory (e.g. DATA statement
+ // initialization) must keep the default.
+ explicit DesignatorFolder(FoldingContext &c, bool getLastComponent = false,
+ bool foldNamedConstants = false)
+ : context_{c}, getLastComponent_{getLastComponent},
+ foldNamedConstants_{foldNamedConstants} {}
bool isEmpty() const { return isEmpty_; }
bool isOutOfRange() const { return isOutOfRange_; }
@@ -158,6 +165,7 @@ class DesignatorFolder {
FoldingContext &context_;
bool getLastComponent_{false};
+ bool foldNamedConstants_{false};
ConstantSubscript elementNumber_{0}; // zero-based
bool isEmpty_{false};
bool isOutOfRange_{false};
diff --git a/flang/lib/Evaluate/fold-designator.cpp b/flang/lib/Evaluate/fold-designator.cpp
index d7751ec389917..00559ea1f4e93 100644
--- a/flang/lib/Evaluate/fold-designator.cpp
+++ b/flang/lib/Evaluate/fold-designator.cpp
@@ -15,22 +15,30 @@ DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(OffsetSymbol)
std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
const Symbol &symbol, ConstantSubscript which) {
- if (!getLastComponent_ && IsAllocatableOrPointer(symbol)) {
+ // A named constant is used through its ultimate symbol: the local alias
+ // of a use- or host-associated named constant has no object details of
+ // its own. Variables are deliberately not resolved this way here, so
+ // that the default behavior is unchanged.
+ const Symbol *object{&symbol};
+ if (foldNamedConstants_ && IsNamedConstant(symbol.GetUltimate())) {
+ object = &symbol.GetUltimate();
+ }
+ if (!getLastComponent_ && IsAllocatableOrPointer(*object)) {
// A pointer may appear as a DATA statement object if it is the
// rightmost symbol in a designator and has no subscripts.
// An allocatable may appear if its initializer is NULL().
if (which > 0) {
isEmpty_ = true;
} else {
- return OffsetSymbol{symbol, symbol.size()};
+ return OffsetSymbol{*object, object->size()};
}
- } else if (symbol.has<semantics::ObjectEntityDetails>() &&
- !IsNamedConstant(symbol)) {
- if (auto type{DynamicType::From(symbol)}) {
- if (auto extents{GetConstantExtents(context_, symbol)}) {
+ } else if (object->has<semantics::ObjectEntityDetails>() &&
+ (foldNamedConstants_ || !IsNamedConstant(*object))) {
+ if (auto type{DynamicType::From(*object)}) {
+ if (auto extents{GetConstantExtents(context_, *object)}) {
if (auto bytes{ToInt64(
type->MeasureSizeInBytes(context_, GetRank(*extents) > 0))}) {
- OffsetSymbol result{symbol, static_cast<std::size_t>(*bytes)};
+ OffsetSymbol result{*object, static_cast<std::size_t>(*bytes)};
if (which < GetSize(*extents)) {
result.Augment(*bytes * which);
return result;
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index b12c8bd604b10..d065c1e6a6597 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -132,6 +132,29 @@ void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
// F'2023 15.5.2.12p1: "Sequence association only applies when the dummy
// argument is an explicit-shape or assumed-size array."
+// Total size in bytes of a whole object for storage-sequence checks.
+// A named constant has no storage assignment (symbol.size() is zero), so
+// measure it from its type and constant extents instead.
+static std::optional<std::int64_t> ObjectTotalBytes(
+ const Symbol &symbol, evaluate::FoldingContext &foldingContext) {
+ if (std::size_t bytes{symbol.size()}) {
+ return static_cast<std::int64_t>(bytes);
+ }
+ if (const Symbol &ultimate{symbol.GetUltimate()}; IsNamedConstant(ultimate)) {
+ if (auto type{evaluate::DynamicType::From(ultimate)}) {
+ if (auto extents{
+ evaluate::GetConstantExtents(foldingContext, &ultimate)}) {
+ if (auto bytes{evaluate::ToInt64(evaluate::Fold(foldingContext,
+ type->MeasureSizeInBytes(
+ foldingContext, evaluate::GetRank(*extents) > 0)))}) {
+ return *bytes * evaluate::GetSize(*extents);
+ }
+ }
+ }
+ }
+ return std::nullopt;
+}
+
static bool CanAssociateWithStorageSequence(
const characteristics::DummyDataObject &dummy) {
return !dummy.type.attrs().test(
@@ -186,14 +209,17 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
foldingContext, evaluate::GetSize(dummy.type.shape())))}) {
auto dummyChars{*dummySize * *dummyLength};
if (actualType.Rank() == 0 && !actualIsAssumedRank) {
- evaluate::DesignatorFolder folder{
- context.foldingContext(), /*getLastComponent=*/true};
+ evaluate::DesignatorFolder folder{context.foldingContext(),
+ /*getLastComponent=*/true, /*foldNamedConstants=*/true};
if (auto actualOffset{folder.FoldDesignator(actual)}) {
std::int64_t actualChars{*actualLength};
+ auto totalBytes{
+ ObjectTotalBytes(actualOffset->symbol(), foldingContext)};
if (IsAllocatableOrPointer(actualOffset->symbol())) {
- // don't use actualOffset->symbol().size()!
- } else if (static_cast<std::size_t>(actualOffset->offset()) >=
- actualOffset->symbol().size() ||
+ // don't use the symbol's size!
+ } else if (!totalBytes ||
+ static_cast<std::int64_t>(actualOffset->offset()) >=
+ *totalBytes ||
!evaluate::IsContiguous(
actualOffset->symbol(), foldingContext)
.value_or(false)) {
@@ -204,9 +230,7 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
*actualLength;
}
} else {
- actualChars = (static_cast<std::int64_t>(
- actualOffset->symbol().size()) -
- actualOffset->offset()) /
+ actualChars = (*totalBytes - actualOffset->offset()) /
actualType.type().kind();
}
if (actualChars < dummyChars) {
@@ -706,72 +730,17 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
} else if (actualRank == 0) {
if (evaluate::IsArrayElement(actual)) {
// Actual argument is a scalar array element
- std::optional<std::int64_t> namedConstElements;
- if (auto dataRef{evaluate::ExtractDataRef(actual)}) {
- // A named constant has no storage offsets, so FoldDesignator
- // below cannot measure it; compute the remaining storage
- // sequence from the constant subscripts of a whole-symbol
- // array element reference instead.
- if (const auto *aRef{
- std::get_if<evaluate::ArrayRef>(&dataRef->u)}) {
- const Symbol &ncBase{aRef->base().GetLastSymbol()};
- if (IsNamedConstant(ncBase.GetUltimate()) &&
- aRef->base().IsSymbol()) {
- if (auto extents{evaluate::GetConstantExtents(
- foldingContext, &ncBase)}) {
- evaluate::Shape lbShape{evaluate::GetLBOUNDs(aRef->base())};
- std::int64_t linear{0}, stride{1}, total{1};
- bool ok{extents->size() == aRef->subscript().size() &&
- extents->size() == lbShape.size()};
- for (std::size_t d{0}; ok && d < extents->size(); ++d) {
- auto lb{lbShape[d]
- ? evaluate::ToInt64(evaluate::Fold(
- foldingContext, std::move(*lbShape[d])))
- : std::nullopt};
- const auto *ssExpr{
- std::get_if<evaluate::IndirectSubscriptIntegerExpr>(
- &aRef->subscript()[d].u)};
- auto ss{ssExpr
- ? evaluate::ToInt64(evaluate::Fold(foldingContext,
- common::Clone(ssExpr->value())))
- : std::nullopt};
- if (lb && ss) {
- linear += (*ss - *lb) * stride;
- stride *= (*extents)[d];
- total *= (*extents)[d];
- } else {
- ok = false;
- }
- }
- if (ok && linear >= 0 && linear < total) {
- namedConstElements = total - linear;
- }
- }
- }
- }
- }
- evaluate::DesignatorFolder folder{
- context.foldingContext(), /*getLastComponent=*/true};
- if (namedConstElements) {
- if (*namedConstElements < *dummySize) {
- if (extentErrors) {
- messages.Say(
- "Actual argument has fewer elements remaining in storage sequence (%jd) than %s array (%jd)"_err_en_US,
- static_cast<std::intmax_t>(*namedConstElements),
- dummyName, static_cast<std::intmax_t>(*dummySize));
- } else {
- foldingContext.Warn(common::UsageWarning::ShortArrayActual,
- "Actual argument has fewer elements remaining in storage sequence (%jd) than %s array (%jd)"_warn_en_US,
- static_cast<std::intmax_t>(*namedConstElements),
- dummyName, static_cast<std::intmax_t>(*dummySize));
- }
- }
- } else if (auto actualOffset{folder.FoldDesignator(actual)}) {
+ evaluate::DesignatorFolder folder{context.foldingContext(),
+ /*getLastComponent=*/true, /*foldNamedConstants=*/true};
+ if (auto actualOffset{folder.FoldDesignator(actual)}) {
std::optional<std::int64_t> actualElements;
+ auto totalBytes{
+ ObjectTotalBytes(actualOffset->symbol(), foldingContext)};
if (IsAllocatableOrPointer(actualOffset->symbol())) {
- // don't use actualOffset->symbol().size()!
- } else if (static_cast<std::size_t>(actualOffset->offset()) >=
- actualOffset->symbol().size() ||
+ // don't use the symbol's size!
+ } else if (!totalBytes ||
+ static_cast<std::int64_t>(actualOffset->offset()) >=
+ *totalBytes ||
!evaluate::IsContiguous(
actualOffset->symbol(), foldingContext)
.value_or(false)) {
@@ -783,9 +752,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
actualSymType->MeasureSizeInBytes(
foldingContext, false)))};
actualSymTypeBytes && *actualSymTypeBytes > 0) {
- actualElements = (static_cast<std::int64_t>(
- actualOffset->symbol().size()) -
- actualOffset->offset()) /
+ actualElements = (*totalBytes - actualOffset->offset()) /
*actualSymTypeBytes;
}
}
diff --git a/flang/test/Semantics/call-parameter-seq-assoc.f90 b/flang/test/Semantics/call-parameter-seq-assoc.f90
index 6b4a90f9be56d..dfdf49823c921 100644
--- a/flang/test/Semantics/call-parameter-seq-assoc.f90
+++ b/flang/test/Semantics/call-parameter-seq-assoc.f90
@@ -52,3 +52,27 @@ subroutine intrinsic_dim_check()
!ERROR: The value of DIM= (5) may not be greater than 2
print *, sum(a, dim=d1(1))
end subroutine
+
+module mc
+ character(len=4), parameter :: cp(2) = ['abcd', 'efgh']
+contains
+ subroutine takes_c2x2(c)
+ character(len=2), intent(in) :: c(2)
+ end subroutine
+ subroutine takes_c2x3(c)
+ character(len=2), intent(in) :: c(3)
+ end subroutine
+end module
+
+subroutine char_accepted()
+ use mc
+ ! Character storage sequence association (F'2023 15.5.2.12 p4): the 4
+ ! characters remaining from cp(2) exactly fill the 2x2-character dummy.
+ call takes_c2x2(cp(2))
+end subroutine
+
+subroutine char_short_sequence()
+ use mc
+ !ERROR: Actual argument has fewer characters remaining in storage sequence (4) than dummy argument 'c=' (6)
+ call takes_c2x3(cp(2))
+end subroutine
>From a7f1c380c73db0c85fa53d5ddd605042523c1acc Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Wed, 16 Sep 2026 10:09:38 -0700
Subject: [PATCH 07/13] [flang] Test character named-constant elements with
assumed-length dummies
Cover character storage sequence association (F'2023 15.5.2.12 p4) of a
named-constant array element with an assumed-length explicit-shape array
dummy: the element is designated directly in the named constant's storage
and passed as a boxchar carrying the element length, with no temporary and
no outlined copy. Covered for one- and multi-character element types.
---
.../Lower/HLFIR/call-parameter-array-arg.f90 | 49 +++++++++++++++++++
1 file changed, 49 insertions(+)
diff --git a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90 b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
index d7fae1773ab93..43d94d670271b 100644
--- a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
+++ b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
@@ -210,3 +210,52 @@ subroutine derived_scalar_and_component()
call dt_scalar(ds)
call int_array(ds%a)
end subroutine
+
+! ---- Character named-constant elements and assumed-length dummies ----
+
+module mq
+ implicit none
+ character(len=1), parameter :: letters(8) = &
+ ['p', 'q', 'r', 's', 't', 'u', 'v', 'w']
+ character(len=3), parameter :: trip(4) = ['abc', 'def', 'ghi', 'jkl']
+contains
+ subroutine asl1(x)
+ character(*), intent(in) :: x(8)
+ end subroutine
+ subroutine asl3(x)
+ character(*), intent(in) :: x(3)
+ end subroutine
+end module
+
+! Element of a character named constant passed to an assumed-length
+! explicit-shape array dummy (character storage sequence association,
+! F'2023 15.5.2.12 p4): the element is designated directly in the named
+! constant's storage and passed as a boxchar carrying the element length;
+! no temporary and no outlined copy.
+! CHECK-LABEL: func.func @_QPchar_elem_assumed_len
+! CHECK: %[[LADDR:.*]] = fir.address_of(@_QMmqECletters)
+! CHECK: %[[LDECL:.*]]:2 = hlfir.declare %[[LADDR]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[LELT:.*]] = hlfir.designate %[[LDECL]]#0 (%{{.*}}) typeparams %c1{{.*}} : (!fir.ref<!fir.array<8x!fir.char<1>>>, i64, index) -> !fir.ref<!fir.char<1>>
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[LBOX:.*]] = fir.emboxchar %[[LELT]], %c1{{.*}} : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
+! CHECK: fir.call @_QMmqPasl1(%[[LBOX]])
+subroutine char_elem_assumed_len()
+ use mq
+ call asl1(letters(1))
+end subroutine
+
+! Same with a multi-character element type: the boxchar carries the
+! named constant's element length (3).
+! CHECK-LABEL: func.func @_QPchar_elem_len3
+! CHECK: %[[TADDR:.*]] = fir.address_of(@_QMmqECtrip)
+! CHECK: %[[TDECL:.*]]:2 = hlfir.declare %[[TADDR]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[TELT:.*]] = hlfir.designate %[[TDECL]]#0 (%{{.*}}) typeparams %c3{{.*}} : (!fir.ref<!fir.array<4x!fir.char<1,3>>>, i64, index) -> !fir.ref<!fir.char<1,3>>
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[TBOX:.*]] = fir.emboxchar %[[TELT]], %c3{{.*}} : (!fir.ref<!fir.char<1,3>>, index) -> !fir.boxchar<1>
+! CHECK: fir.call @_QMmqPasl3(%[[TBOX]])
+subroutine char_elem_len3()
+ use mq
+ call asl3(trip(2))
+end subroutine
>From 4dc632bc38661a80a401e20ce90f5c935f5421c5 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Thu, 17 Sep 2026 04:45:31 -0700
Subject: [PATCH 08/13] [flang] Keep retained named-constant designators
through function-reference folding
Expression folding of a nonintrinsic function reference folds its actual
arguments in place, which replaced a retained named-constant designator
with its scalar value: the element sequence accepted by semantics then
reached lowering as a one-element scalar association cast to an array.
Skip that refold for named-constant designators of nonintrinsic function
references (and in the conditional-argument consequent folding), so
function references get the same storage association CALL statements get;
intrinsic references still fold, and their argument values come through
the folded copy made at intrinsic resolution.
Also fold a copy of a retained named-constant designator in the
Hollerith/CHARACTER-as-BOZ conversion extension, which inspects constant
values structurally and otherwise stopped accepting a named-constant
CHARACTER element passed to a scalar INTEGER dummy.
IsNamedConstantDesignator is now exported from Evaluate for these uses.
Tests: function-reference element sequence association and whole-array
dataflow; the BOZ extension with named-constant, literal, and
parenthesized actuals plus a variable negative control.
---
.../include/flang/Evaluate/check-expression.h | 1 +
flang/lib/Evaluate/check-expression.cpp | 2 +-
flang/lib/Evaluate/fold-implementation.h | 11 ++++
flang/lib/Evaluate/fold.cpp | 7 ++-
flang/lib/Semantics/check-call.cpp | 13 ++++-
.../Lower/HLFIR/call-parameter-array-arg.f90 | 51 +++++++++++++++++++
flang/test/Semantics/call-parameter-boz.f90 | 34 +++++++++++++
7 files changed, 115 insertions(+), 4 deletions(-)
create mode 100644 flang/test/Semantics/call-parameter-boz.f90
diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h
index 2b8cb4ea457eb..3003179699faa 100644
--- a/flang/include/flang/Evaluate/check-expression.h
+++ b/flang/include/flang/Evaluate/check-expression.h
@@ -183,6 +183,7 @@ std::optional<parser::Message> CheckStatementFunction(
// matching, checking, and folding inspect constant values structurally, so
// such arguments must be folded back to values once a call is known to
// resolve to an intrinsic procedure.
+bool IsNamedConstantDesignator(const Expr<SomeType> &);
bool AnyNamedConstantActualArguments(const ActualArguments &);
void FoldNamedConstantActualArguments(FoldingContext &, ActualArguments &);
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 46dccab02df86..db4cf137b5eb0 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -1643,7 +1643,7 @@ class CopyInOutExplicitInterface {
// perspective, meaning that for copy-in the caller need to do the copy
// before calling the callee. Similarly, for copy-out the caller is expected
// to do the copy after the callee returns.
-static bool IsNamedConstantDesignator(const Expr<SomeType> &expr) {
+bool IsNamedConstantDesignator(const Expr<SomeType> &expr) {
if (auto dataRef{ExtractDataRef(
expr, /*intoSubstring=*/true, /*intoComplexPart=*/true)}) {
return semantics::IsNamedConstant(dataRef->GetFirstSymbol().GetUltimate());
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index f89fb1601176e..03414f1e789e0 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -16,6 +16,7 @@
#include "flang/Common/template.h"
#include "flang/Common/unwrap.h"
#include "flang/Evaluate/characteristics.h"
+#include "flang/Evaluate/check-expression.h"
#include "flang/Evaluate/common.h"
#include "flang/Evaluate/constant.h"
#include "flang/Evaluate/expression.h"
@@ -1377,6 +1378,16 @@ Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) {
if (arg && arg->GetConditionalArg()) {
FoldConditionalArg(context, arg);
} else if (auto *expr{UnwrapExpr<Expr<SomeType>>(arg)}) {
+ if (!intrinsic && IsNamedConstantDesignator(*expr)) {
+ // A designator of a named constant retained as the actual argument
+ // of a nonintrinsic function reference stays in designator form so
+ // that lowering can associate the dummy argument with the named
+ // constant's storage (in particular for element sequence
+ // association); folding it here would replace it with its scalar
+ // value. Intrinsic references still fold, since intrinsic folding
+ // inspects constant values.
+ continue;
+ }
*expr = Fold(context, std::move(*expr));
}
}
diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp
index f20d32077602d..6cf5a654b648d 100644
--- a/flang/lib/Evaluate/fold.cpp
+++ b/flang/lib/Evaluate/fold.cpp
@@ -9,6 +9,7 @@
#include "flang/Evaluate/fold.h"
#include "fold-implementation.h"
#include "flang/Evaluate/characteristics.h"
+#include "flang/Evaluate/check-expression.h"
#include "flang/Evaluate/initial-image.h"
#include "flang/Evaluate/tools.h"
@@ -301,7 +302,11 @@ std::optional<Expr<SomeType>> FoldTransfer(
// Fold a Consequent expression in place.
static void FoldConsequent(
FoldingContext &context, ActualArgument::ConditionalArg::Consequent &cons) {
- if (cons) {
+ if (cons && !IsNamedConstantDesignator(cons->value())) {
+ // A retained named-constant designator keeps its designator form for
+ // storage association; see the corresponding skip in
+ // FoldOperation(FunctionRef). Intrinsic references get their values
+ // through the folded copy made at intrinsic resolution.
cons->value() = Fold(context, std::move(cons->value()));
}
}
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index d065c1e6a6597..7fd6fe792d23e 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -429,8 +429,17 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
} else if (dummyRank == 0 && allowActualArgumentConversions) {
// Extension: pass Hollerith literal to scalar as if it had been BOZ
- if (auto converted{evaluate::HollerithToBOZ(
- foldingContext, actual, dummy.type.type())}) {
+ auto converted{
+ evaluate::HollerithToBOZ(foldingContext, actual, dummy.type.type())};
+ if (!converted && evaluate::IsNamedConstantDesignator(actual)) {
+ // The actual may be a designator of a named constant retained for
+ // storage association; the extension inspects constant values, so
+ // retry with its folded value.
+ auto copy{actual};
+ converted = evaluate::HollerithToBOZ(foldingContext,
+ evaluate::Fold(foldingContext, std::move(copy)), dummy.type.type());
+ }
+ if (converted) {
foldingContext.Warn(common::LanguageFeature::HollerithOrCharacterAsBOZ,
"passing Hollerith or character literal as if it were BOZ"_port_en_US);
actual = *converted;
diff --git a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90 b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
index 43d94d670271b..db89bd9462655 100644
--- a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
+++ b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
@@ -259,3 +259,54 @@ subroutine char_elem_len3()
use mq
call asl3(trip(2))
end subroutine
+
+! ---- Function references (folding must not replace retained designators) ----
+
+module mf
+ implicit none
+ integer, parameter :: fp(4) = [10, 20, 30, 40]
+contains
+ integer function fsum3(x)
+ integer, intent(in) :: x(3)
+ fsum3 = sum(x)
+ end function
+ integer function fsum4(x)
+ integer, intent(in) :: x(4)
+ fsum4 = sum(x)
+ end function
+end module
+
+! Element of a named constant as a FUNCTION actual argument: expression
+! folding of the function reference must not replace the retained designator
+! with its scalar value; the element's address within the declared global
+! reaches the callee (sequence association). The full dataflow is checked:
+! a scalar-constant association cast to an array would also contain a
+! convert and a call, but not this chain.
+! CHECK-LABEL: func.func @_QPfunc_elem_seq
+! CHECK: %[[FADDR:.*]] = fir.address_of(@_QMmfECfp)
+! CHECK: %[[FDECL:.*]]:2 = hlfir.declare %[[FADDR]]
+! CHECK-NOT: hlfir.associate
+! CHECK: %[[FELT:.*]] = hlfir.designate %[[FDECL]]#0 (%{{.*}}) : (!fir.ref<!fir.array<4xi32>>, i64) -> !fir.ref<i32>
+! CHECK-NOT: hlfir.associate
+! CHECK: %[[FCAST:.*]] = fir.convert %[[FELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<3xi32>>
+! CHECK: fir.call @_QMmfPfsum3(%[[FCAST]])
+subroutine func_elem_seq()
+ use mf
+ integer :: r
+ r = fsum3(fp(2))
+ print *, r
+end subroutine
+
+! Whole named-constant array as a FUNCTION actual argument: the declared
+! global's address is passed directly.
+! CHECK-LABEL: func.func @_QPfunc_whole_array
+! CHECK: %[[WADDR:.*]] = fir.address_of(@_QMmfECfp)
+! CHECK: %[[WDECL:.*]]:2 = hlfir.declare %[[WADDR]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK: fir.call @_QMmfPfsum4(%[[WDECL]]#0
+subroutine func_whole_array()
+ use mf
+ integer :: r
+ r = fsum4(fp)
+ print *, r
+end subroutine
diff --git a/flang/test/Semantics/call-parameter-boz.f90 b/flang/test/Semantics/call-parameter-boz.f90
new file mode 100644
index 0000000000000..1f5c1f1c8aa62
--- /dev/null
+++ b/flang/test/Semantics/call-parameter-boz.f90
@@ -0,0 +1,34 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Whollerith-or-character-as-boz
+! The extension that passes a CHARACTER actual to a scalar INTEGER dummy as
+! if it were BOZ must keep working when the actual is an element of a named
+! constant (whose designator is retained for storage association): the
+! conversion inspects the folded value.
+module m
+contains
+ subroutine takes_integer(x)
+ integer, intent(in) :: x
+ end subroutine
+end module
+
+subroutine named_constant_element()
+ use m
+ character(4), parameter :: a(1) = ['abcd']
+ !PORTABILITY: passing Hollerith or character literal as if it were BOZ [-Whollerith-or-character-as-boz]
+ call takes_integer(a(1))
+end subroutine
+
+subroutine literal_and_parenthesized()
+ use m
+ character(4), parameter :: a(1) = ['abcd']
+ !PORTABILITY: passing Hollerith or character literal as if it were BOZ [-Whollerith-or-character-as-boz]
+ call takes_integer('abcd')
+ !PORTABILITY: passing Hollerith or character literal as if it were BOZ [-Whollerith-or-character-as-boz]
+ call takes_integer((a(1)))
+end subroutine
+
+subroutine variable_still_rejected()
+ use m
+ character(4) :: c
+ !ERROR: Actual argument type 'CHARACTER(KIND=1,LEN=4_8)' is not compatible with dummy argument type 'INTEGER(4)'
+ call takes_integer(c)
+end subroutine
>From a418c8cbc6ffb11b120aebef8a73b8e1e2e7925b Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Thu, 17 Sep 2026 04:45:32 -0700
Subject: [PATCH 09/13] [flang] Size sequence-association VALUE temporaries by
the dummy argument
When a scalar array element is associated with an array dummy argument
(storage sequence association, F'2023 15.5.2.12) and a copy is required
(VALUE, or a named constant needing a temporary), the temporary covered
only the element: the callee then read, and could write, past a
one-element allocation. View the storage sequence starting at the
element as an array of the dummy's shape and copy that instead, so the
temporary carries every element the dummy can access.
This applies to variable element actual arguments as well as named
constants (the variable form of the defect predates the named-constant
acceptance). Restricted to constant-shape dummies with matching
non-character element types; other cases keep their previous lowering.
Tests: sequence-sized VALUE temporaries for a named-constant element and
a variable element.
---
flang/lib/Lower/ConvertCall.cpp | 31 +++++++++++-
.../Lower/HLFIR/call-value-sequence-assoc.f90 | 48 +++++++++++++++++++
2 files changed, 77 insertions(+), 2 deletions(-)
create mode 100644 flang/test/Lower/HLFIR/call-value-sequence-assoc.f90
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 13fbc94ad4278..517c8a8969cbc 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1513,8 +1513,35 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
(isParameterObjectOrSubObject(entity) &&
(suggestCopyIn || suggestCopyOut))) {
// Make a copy in a temporary.
- auto copy = hlfir::AsExprOp::create(builder, loc, entity);
- mlir::Type storageType = entity.getType();
+ //
+ // When a scalar array element is associated with an array dummy
+ // argument (storage sequence association, F'2023 15.5.2.12), the
+ // temporary must cover the whole sequence the dummy requires, not
+ // just the element: view the storage sequence starting at the
+ // element as an array of the dummy's shape and copy that.
+ hlfir::Entity source = entity;
+ if (entity.getRank() == 0 && fir::isa_ref_type(entity.getType())) {
+ mlir::Type dummySeqTy = fir::unwrapRefType(dummyType);
+ if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(dummySeqTy);
+ seqTy && !seqTy.hasDynamicExtents() &&
+ seqTy.getEleTy() == fir::unwrapRefType(entity.getType()) &&
+ !mlir::isa<fir::CharacterType>(seqTy.getEleTy())) {
+ mlir::Value seqRef = builder.createConvert(
+ loc, fir::ReferenceType::get(seqTy), entity);
+ llvm::SmallVector<mlir::Value> extents;
+ for (auto extent : seqTy.getShape())
+ extents.push_back(builder.createIntegerConstant(
+ loc, builder.getIndexType(), extent));
+ mlir::Value shape = builder.genShape(loc, extents);
+ auto declare =
+ hlfir::DeclareOp::create(builder, loc, seqRef, ".sequence.assoc",
+ shape, /*typeparams=*/mlir::ValueRange{},
+ /*dummy_scope=*/nullptr);
+ source = hlfir::Entity{declare.getBase()};
+ }
+ }
+ auto copy = hlfir::AsExprOp::create(builder, loc, source);
+ mlir::Type storageType = source.getType();
mlir::NamedAttribute byRefAttr = fir::getAdaptToByRefAttr(builder);
hlfir::AssociateOp associate = hlfir::genAssociateExpr(
loc, builder, hlfir::Entity{copy}, storageType, "", byRefAttr);
diff --git a/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90 b/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90
new file mode 100644
index 0000000000000..028677cdbdc83
--- /dev/null
+++ b/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90
@@ -0,0 +1,48 @@
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+! A scalar array element associated with an array VALUE dummy via storage
+! sequence association (F'2023 15.5.2.12): the temporary that VALUE requires
+! must cover the whole sequence the dummy needs, not just the element. The
+! sequence starting at the element is viewed as an array of the dummy's
+! shape and that array is copied.
+
+module m
+ implicit none
+ integer, parameter :: cp(4) = [5, 6, 7, 8]
+contains
+ subroutine byval3(x)
+ integer, value :: x(3)
+ end subroutine
+end module
+
+! Named-constant element actual argument.
+! CHECK-LABEL: func.func @_QPvalue_seq_parameter
+! CHECK: %[[PADDR:.*]] = fir.address_of(@_QMmECcp)
+! CHECK: %[[PDECL:.*]]:2 = hlfir.declare %[[PADDR]]
+! CHECK: %[[PELT:.*]] = hlfir.designate %[[PDECL]]#0 (%{{.*}}) : (!fir.ref<!fir.array<4xi32>>, i64) -> !fir.ref<i32>
+! CHECK: %[[PSEQ:.*]] = fir.convert %[[PELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<3xi32>>
+! CHECK: %[[PVIEW:.*]]:2 = hlfir.declare %[[PSEQ]](%{{.*}}) {uniq_name = ".sequence.assoc"}
+! CHECK: %[[PCOPY:.*]] = hlfir.as_expr %[[PVIEW]]#0 : (!fir.ref<!fir.array<3xi32>>) -> !hlfir.expr<3xi32>
+! CHECK: %[[PTMP:.*]]:3 = hlfir.associate %[[PCOPY]](%{{.*}}) {adapt.valuebyref} : (!hlfir.expr<3xi32>, !fir.shape<1>) -> (!fir.ref<!fir.array<3xi32>>
+! CHECK: fir.call @_QMmPbyval3(%[[PTMP]]#0)
+! CHECK: hlfir.end_associate %[[PTMP]]#1, %[[PTMP]]#2
+subroutine value_seq_parameter()
+ use m
+ call byval3(cp(2))
+end subroutine
+
+! Variable element actual argument takes the same sequence-sized temporary.
+! CHECK-LABEL: func.func @_QPvalue_seq_variable
+! CHECK: %[[VDECL:.*]]:2 = hlfir.declare %{{.*}} {uniq_name = "_QFvalue_seq_variableEv"}
+! CHECK: %[[VELT:.*]] = hlfir.designate %[[VDECL]]#0 (%{{.*}}) : (!fir.ref<!fir.array<4xi32>>, index) -> !fir.ref<i32>
+! CHECK: %[[VSEQ:.*]] = fir.convert %[[VELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<3xi32>>
+! CHECK: %[[VVIEW:.*]]:2 = hlfir.declare %[[VSEQ]](%{{.*}}) {uniq_name = ".sequence.assoc"}
+! CHECK: %[[VCOPY:.*]] = hlfir.as_expr %[[VVIEW]]#0 : (!fir.ref<!fir.array<3xi32>>) -> !hlfir.expr<3xi32>
+! CHECK: %[[VTMP:.*]]:3 = hlfir.associate %[[VCOPY]](%{{.*}}) {adapt.valuebyref} : (!hlfir.expr<3xi32>, !fir.shape<1>) -> (!fir.ref<!fir.array<3xi32>>
+! CHECK: fir.call @_QMmPbyval3(%[[VTMP]]#0)
+subroutine value_seq_variable()
+ use m
+ integer :: v(4)
+ v = [1, 2, 3, 4]
+ call byval3(v(2))
+end subroutine
>From af71134db233c9ca608b2e7730b5264a73ddc425 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Thu, 17 Sep 2026 05:03:42 -0700
Subject: [PATCH 10/13] [flang] Extend named-constant actual argument test
coverage
Cover the remaining behaviors of named constants as actual arguments:
dynamic-bound strided sections keep their descriptor (strides intact) for
assumed-shape dummies and get a temporary for explicit-shape dummies, with
no copy-out into the constant's storage in any case; a user generic that
shadows an intrinsic still resolves correctly with retained arguments and
intrinsic DIM=/KIND= see the values of named-constant elements (including
with nondefault lower bounds); derived-type element sequences accept
exact-fit boundaries and diagnose exact too-short counts; and the
CHARACTER-as-BOZ extension lowers a named-constant element to the
character's endian-independent integer bits.
---
flang/test/Lower/HLFIR/call-parameter-boz.f90 | 18 +++++
.../Lower/HLFIR/call-parameter-sections.f90 | 67 +++++++++++++++++++
.../Semantics/call-parameter-seq-assoc.f90 | 58 ++++++++++++++++
3 files changed, 143 insertions(+)
create mode 100644 flang/test/Lower/HLFIR/call-parameter-boz.f90
create mode 100644 flang/test/Lower/HLFIR/call-parameter-sections.f90
diff --git a/flang/test/Lower/HLFIR/call-parameter-boz.f90 b/flang/test/Lower/HLFIR/call-parameter-boz.f90
new file mode 100644
index 0000000000000..79596c2c14678
--- /dev/null
+++ b/flang/test/Lower/HLFIR/call-parameter-boz.f90
@@ -0,0 +1,18 @@
+! RUN: %flang_fc1 -emit-hlfir -Whollerith-or-character-as-boz %s -o - | FileCheck %s
+
+! A CHARACTER named-constant element passed to a scalar INTEGER dummy is
+! converted as if it were BOZ (extension); the callee receives the
+! character's bits as an integer constant. 'aaaa' is 0x61616161 =
+! 1633771873 regardless of endianness.
+! CHECK-LABEL: func.func @_QPboz_arg
+! CHECK: %[[BITS:.*]] = arith.constant 1633771873 : i32
+! CHECK: %[[TMP:.*]]:3 = hlfir.associate %[[BITS]] {adapt.valuebyref} : (i32) -> (!fir.ref<i32>, !fir.ref<i32>, i1)
+! CHECK: fir.call @_QFboz_argPti(%[[TMP]]#0)
+subroutine boz_arg()
+ character(4), parameter :: ca(1) = ['aaaa']
+ call ti(ca(1))
+contains
+ subroutine ti(x)
+ integer, intent(in) :: x
+ end subroutine
+end subroutine
diff --git a/flang/test/Lower/HLFIR/call-parameter-sections.f90 b/flang/test/Lower/HLFIR/call-parameter-sections.f90
new file mode 100644
index 0000000000000..24611dcdd5e20
--- /dev/null
+++ b/flang/test/Lower/HLFIR/call-parameter-sections.f90
@@ -0,0 +1,67 @@
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+! Sections of named constants as actual arguments: a dynamic section keeps
+! its descriptor (strides intact) for an assumed-shape dummy, gets a
+! temporary copy for an explicit-shape dummy, and a temporary made from a
+! named constant is never copied back into the constant's storage.
+
+module ms
+ implicit none
+ integer, parameter :: sp(6) = [1, 2, 3, 4, 5, 6]
+contains
+ subroutine expl3(x)
+ integer, intent(in) :: x(3)
+ end subroutine
+ subroutine asmd(x)
+ integer, intent(in) :: x(:)
+ end subroutine
+end module
+
+! Dynamic-bound strided section to an assumed-shape dummy: the descriptor
+! over the named constant's storage is passed directly, strides preserved;
+! no copy in either direction.
+! CHECK-LABEL: func.func @_QPdyn_section_assumed
+! CHECK: %[[A:.*]] = fir.address_of(@_QMmsECsp)
+! CHECK: %[[AD:.*]]:2 = hlfir.declare %[[A]]
+! CHECK: %[[SEC:.*]] = hlfir.designate %[[AD]]#0 (%{{.*}}:%c6{{.*}}:%c2{{.*}}) shape %{{.*}} -> !fir.box<!fir.array<?xi32>>
+! CHECK-NOT: hlfir.as_expr
+! CHECK-NOT: hlfir.copy_in
+! CHECK: fir.call @_QMmsPasmd(%[[SEC]])
+! CHECK-NOT: hlfir.copy_out
+subroutine dyn_section_assumed(i)
+ use ms
+ integer :: i
+ call asmd(sp(i:6:2))
+end subroutine
+
+! The same section to an explicit-shape dummy requires contiguity: a
+! temporary copy is made, and nothing is copied back into the named
+! constant's storage afterwards (the temporary is simply destroyed).
+! CHECK-LABEL: func.func @_QPdyn_section_explicit
+! CHECK: %[[B:.*]] = fir.address_of(@_QMmsECsp)
+! CHECK: %[[BD:.*]]:2 = hlfir.declare %[[B]]
+! CHECK: %[[BSEC:.*]] = hlfir.designate %[[BD]]#0 (%{{.*}}:%c6{{.*}}:%c2{{.*}}) shape
+! CHECK: %[[BEXPR:.*]] = hlfir.as_expr %[[BSEC]]
+! CHECK: %[[BTMP:.*]]:3 = hlfir.associate %[[BEXPR]]({{.*}}) {adapt.valuebyref}
+! CHECK: fir.call @_QMmsPexpl3
+! CHECK-NOT: hlfir.copy_out
+! CHECK: hlfir.end_associate %[[BTMP]]#1, %[[BTMP]]#2
+subroutine dyn_section_explicit(i)
+ use ms
+ integer :: i
+ call expl3(sp(i:6:2))
+end subroutine
+
+! A section with constant bounds is folded to an outlined constant, which
+! is copied to a temporary; still no copy-out.
+! CHECK-LABEL: func.func @_QPconst_strided_explicit
+! CHECK: fir.address_of(@_QQro.3xi4.0)
+! CHECK: hlfir.as_expr
+! CHECK: %[[CTMP:.*]]:3 = hlfir.associate {{.*}} {adapt.valuebyref}
+! CHECK: fir.call @_QMmsPexpl3(%[[CTMP]]#0)
+! CHECK-NOT: hlfir.copy_out
+! CHECK: hlfir.end_associate
+subroutine const_strided_explicit()
+ use ms
+ call expl3(sp(1:6:2))
+end subroutine
diff --git a/flang/test/Semantics/call-parameter-seq-assoc.f90 b/flang/test/Semantics/call-parameter-seq-assoc.f90
index dfdf49823c921..b2b7378d9b596 100644
--- a/flang/test/Semantics/call-parameter-seq-assoc.f90
+++ b/flang/test/Semantics/call-parameter-seq-assoc.f90
@@ -76,3 +76,61 @@ subroutine char_short_sequence()
!ERROR: Actual argument has fewer characters remaining in storage sequence (4) than dummy argument 'c=' (6)
call takes_c2x3(cp(2))
end subroutine
+
+module mdc
+ type :: dt
+ integer :: i
+ character :: c
+ end type
+ type(dt), parameter :: dp(3) = [dt(1, 'a'), dt(2, 'b'), dt(3, 'c')]
+ integer, parameter :: nlb(-1:4) = [1, 2, 3, 4, 5, 6]
+contains
+ subroutine dt3(x)
+ type(dt), intent(in) :: x(3)
+ end subroutine
+ subroutine dt2(x)
+ type(dt), intent(in) :: x(2)
+ end subroutine
+ subroutine int5(x)
+ integer, intent(in) :: x(5)
+ end subroutine
+ subroutine int6(x)
+ integer, intent(in) :: x(6)
+ end subroutine
+end module
+
+subroutine derived_and_lower_bounds()
+ use mdc
+ ! Exact-fit boundary cases are accepted.
+ call dt3(dp(1))
+ call dt2(dp(2))
+ ! An element of a named constant with a nondefault lower bound: five
+ ! elements remain from nlb(0).
+ call int5(nlb(0))
+ !ERROR: Actual argument has fewer elements remaining in storage sequence (2) than dummy argument 'x=' array (3)
+ call dt3(dp(2))
+ !ERROR: Actual argument has fewer elements remaining in storage sequence (5) than dummy argument 'x=' array (6)
+ call int6(nlb(0))
+end subroutine
+
+subroutine generic_vs_intrinsic()
+ ! A user generic named like an intrinsic still resolves correctly with
+ ! retained named-constant arguments, and intrinsic uses see the values
+ ! of named-constant elements (DIM=, KIND=).
+ interface sum
+ procedure mysum
+ end interface
+ integer, parameter :: gp2(-1:2) = [1, 2, 3, 4]
+ integer, parameter :: kk(2) = [4, 8]
+ integer :: a(2, 2)
+ integer :: r(2)
+ a = reshape(gp2, [2, 2])
+ print *, sum(gp2, 7) ! user generic: extra scalar argument
+ r = sum(array=a, dim=gp2(0)) ! intrinsic: DIM= from a named-constant element
+ print *, r, kind(int(1, kind=kk(2)))
+contains
+ integer function mysum(x, y)
+ integer, intent(in) :: x(4), y
+ mysum = x(1) + x(2) + x(3) + x(4) + y
+ end function
+end subroutine
>From 32602cfe80f95d942557976655bcf7030f68a66a Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Thu, 17 Sep 2026 08:07:54 -0700
Subject: [PATCH 11/13] [flang] Size VALUE sequence copies for runtime-shaped
and polymorphic dummies
The sequence-sized temporary introduced for scalar-element actual
arguments associated with array VALUE dummies only handled raw-reference
dummies with compile-time extents. A runtime-shaped explicit-shape dummy
(x(n)) or a polymorphic array dummy still copied a single element and
presented it as a multi-element array, allowing out-of-bounds reads and
writes.
Generalize the sequence view:
- look through box/class dummy types for the sequence type so that
polymorphic array dummies get a sequence-sized copy, with the class
descriptor built over that copy;
- when the dummy extents are not all known at the call site, view and
copy the whole remaining storage sequence of the base array (F'2023
15.5.2.12 p3), computing its extent from the base array bounds and the
element indices. This mirrors the whole-array copy made when the
actual argument is an array, and works for constant and runtime bounds
alike, so it also corrects the equivalent variable-element forms.
Extend the VALUE sequence-association test with runtime-shaped
(parameter and variable), polymorphic, rank-two, zero-extent,
allocatable-component, and overlapping-actual cases.
---
flang/lib/Lower/ConvertCall.cpp | 93 +++++++++---
.../Lower/HLFIR/call-value-sequence-assoc.f90 | 140 ++++++++++++++++++
2 files changed, 215 insertions(+), 18 deletions(-)
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 517c8a8969cbc..bdd1b675b15ad 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1318,6 +1318,47 @@ static bool isParameterObjectOrSubObject(hlfir::Entity entity) {
return foundParameter;
}
+/// If \p element is the address of an array element, generate the number of
+/// elements in the storage sequence that starts at that element and runs to
+/// the end of its base array (F'2023 15.5.2.12 point 3.). Return a null
+/// value when the base array or the element position cannot be identified.
+static mlir::Value genRemainingStorageSequenceExtent(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ hlfir::Entity element) {
+ auto designate = element.getDefiningOp<hlfir::DesignateOp>();
+ if (!designate || designate.getComponent() ||
+ !designate.getSubstring().empty() || designate.getComplexPart() ||
+ llvm::is_contained(designate.getIsTriplet(), true))
+ return {};
+ hlfir::Entity base{designate.getMemref()};
+ unsigned rank = base.getRank();
+ if (rank == 0 || designate.getIndices().size() != rank)
+ return {};
+ // The remaining length is the base array size minus the column-major
+ // offset of the element inside the base array.
+ llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> bounds =
+ hlfir::genBounds(loc, builder, base);
+ mlir::Type idxTy = builder.getIndexType();
+ mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
+ mlir::Value stride = one;
+ mlir::Value offset = builder.createIntegerConstant(loc, idxTy, 0);
+ for (auto [dim, lbub] : llvm::enumerate(bounds)) {
+ mlir::Value lb = builder.createConvert(loc, idxTy, lbub.first);
+ mlir::Value ub = builder.createConvert(loc, idxTy, lbub.second);
+ mlir::Value index =
+ builder.createConvert(loc, idxTy, designate.getIndices()[dim]);
+ mlir::Value dimOffset =
+ mlir::arith::SubIOp::create(builder, loc, index, lb);
+ offset = mlir::arith::AddIOp::create(
+ builder, loc, offset,
+ mlir::arith::MulIOp::create(builder, loc, dimOffset, stride));
+ mlir::Value extent = mlir::arith::AddIOp::create(
+ builder, loc, mlir::arith::SubIOp::create(builder, loc, ub, lb), one);
+ stride = mlir::arith::MulIOp::create(builder, loc, stride, extent);
+ }
+ return mlir::arith::SubIOp::create(builder, loc, stride, offset);
+}
+
/// When dummy is not ALLOCATABLE, POINTER and is not passed in register,
/// prepare the actual argument according to the interface. Do as needed:
/// - address element if this is an array argument in an elemental call.
@@ -1517,27 +1558,43 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
// When a scalar array element is associated with an array dummy
// argument (storage sequence association, F'2023 15.5.2.12), the
// temporary must cover the whole sequence the dummy requires, not
- // just the element: view the storage sequence starting at the
- // element as an array of the dummy's shape and copy that.
+ // just the element. When the dummy extents are all known at the
+ // call site, view the storage sequence starting at the element as
+ // an array of the dummy's shape and copy that. Otherwise, copy the
+ // whole remaining storage sequence of the base array, mirroring the
+ // copy of the whole actual argument that is made when the actual
+ // argument is an array.
hlfir::Entity source = entity;
if (entity.getRank() == 0 && fir::isa_ref_type(entity.getType())) {
- mlir::Type dummySeqTy = fir::unwrapRefType(dummyType);
- if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(dummySeqTy);
- seqTy && !seqTy.hasDynamicExtents() &&
- seqTy.getEleTy() == fir::unwrapRefType(entity.getType()) &&
- !mlir::isa<fir::CharacterType>(seqTy.getEleTy())) {
- mlir::Value seqRef = builder.createConvert(
- loc, fir::ReferenceType::get(seqTy), entity);
+ mlir::Type dummyBaseTy = fir::unwrapRefType(dummyType);
+ if (auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(dummyBaseTy))
+ dummyBaseTy = fir::unwrapRefType(boxTy.getEleTy());
+ mlir::Type eleTy = fir::unwrapRefType(entity.getType());
+ if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(dummyBaseTy);
+ seqTy && seqTy.getEleTy() == eleTy &&
+ !mlir::isa<fir::CharacterType>(eleTy)) {
llvm::SmallVector<mlir::Value> extents;
- for (auto extent : seqTy.getShape())
- extents.push_back(builder.createIntegerConstant(
- loc, builder.getIndexType(), extent));
- mlir::Value shape = builder.genShape(loc, extents);
- auto declare =
- hlfir::DeclareOp::create(builder, loc, seqRef, ".sequence.assoc",
- shape, /*typeparams=*/mlir::ValueRange{},
- /*dummy_scope=*/nullptr);
- source = hlfir::Entity{declare.getBase()};
+ mlir::Type viewTy;
+ if (!seqTy.hasDynamicExtents()) {
+ for (auto extent : seqTy.getShape())
+ extents.push_back(builder.createIntegerConstant(
+ loc, builder.getIndexType(), extent));
+ viewTy = seqTy;
+ } else if (mlir::Value remaining = genRemainingStorageSequenceExtent(
+ loc, builder, entity)) {
+ extents.push_back(remaining);
+ viewTy = fir::SequenceType::get(
+ {fir::SequenceType::getUnknownExtent()}, eleTy);
+ }
+ if (!extents.empty()) {
+ mlir::Value seqRef = builder.createConvert(
+ loc, fir::ReferenceType::get(viewTy), entity);
+ mlir::Value shape = builder.genShape(loc, extents);
+ auto declare = hlfir::DeclareOp::create(
+ builder, loc, seqRef, ".sequence.assoc", shape,
+ /*typeparams=*/mlir::ValueRange{}, /*dummy_scope=*/nullptr);
+ source = hlfir::Entity{declare.getBase()};
+ }
}
}
auto copy = hlfir::AsExprOp::create(builder, loc, source);
diff --git a/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90 b/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90
index 028677cdbdc83..aed9975beef7b 100644
--- a/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90
+++ b/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90
@@ -46,3 +46,143 @@ subroutine value_seq_variable()
v = [1, 2, 3, 4]
call byval3(v(2))
end subroutine
+
+! When the dummy extents are not all known at the call site, the whole
+! remaining storage sequence of the base array is copied instead, and for
+! descriptor dummies the sequence view is what gets boxed.
+
+module m2
+ implicit none
+ type t2
+ integer :: n
+ end type
+ type(t2), parameter :: tp(5) = [t2(1), t2(2), t2(3), t2(4), t2(5)]
+ type td
+ integer, allocatable :: a(:)
+ end type
+contains
+ subroutine byvaln(n, x)
+ integer, intent(in) :: n
+ integer, value :: x(n)
+ end subroutine
+ subroutine byval0(x)
+ integer, value :: x(0)
+ end subroutine
+ subroutine byval22(x)
+ type(t2), value :: x(2, 2)
+ end subroutine
+ subroutine byval_class(x)
+ class(t2), value :: x(2)
+ end subroutine
+ subroutine byval_deep(x)
+ type(td), value :: x(2)
+ end subroutine
+ subroutine byval_two(x, y)
+ integer, value :: x(3), y(4)
+ end subroutine
+end module
+
+! Runtime-shaped dummy: the copied view covers the remaining sequence of the
+! base array (its extent is computed, not a constant).
+! CHECK-LABEL: func.func @_QPvalue_seq_dynamic
+! CHECK: %[[DELT:.*]] = hlfir.designate %{{.*}} (%{{.*}}) : (!fir.ref<!fir.array<4xi32>>, i64) -> !fir.ref<i32>
+! CHECK: %[[DLEN:.*]] = arith.subi %{{[0-9]+}}, %{{[0-9]+}} : index
+! CHECK: %[[DSEQ:.*]] = fir.convert %[[DELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<?xi32>>
+! CHECK: %[[DSHAPE:.*]] = fir.shape %[[DLEN]] : (index) -> !fir.shape<1>
+! CHECK: %[[DVIEW:.*]]:2 = hlfir.declare %[[DSEQ]](%[[DSHAPE]]) {uniq_name = ".sequence.assoc"} : (!fir.ref<!fir.array<?xi32>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.ref<!fir.array<?xi32>>)
+! CHECK: %[[DCOPY:.*]] = hlfir.as_expr %[[DVIEW]]#0 : (!fir.box<!fir.array<?xi32>>) -> !hlfir.expr<?xi32>
+! CHECK: %[[DTMP:.*]]:3 = hlfir.associate %[[DCOPY]](%[[DSHAPE]]) {adapt.valuebyref}
+! CHECK: fir.call @_QMm2Pbyvaln(%{{.*}}, %[[DTMP]]#1)
+! CHECK: hlfir.end_associate %[[DTMP]]#1, %[[DTMP]]#2
+subroutine value_seq_dynamic()
+ use m2
+ integer, parameter :: cp(4) = [5, 6, 7, 8]
+ call byvaln(3, cp(2))
+end subroutine
+
+! Same for a variable element actual argument.
+! CHECK-LABEL: func.func @_QPvalue_seq_dynamic_variable
+! CHECK: %[[EELT:.*]] = hlfir.designate %{{.*}} (%{{.*}}) : (!fir.ref<!fir.array<4xi32>>, index) -> !fir.ref<i32>
+! CHECK: %[[ELEN:.*]] = arith.subi %{{[0-9]+}}, %{{[0-9]+}} : index
+! CHECK: %[[ESEQ:.*]] = fir.convert %[[EELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<?xi32>>
+! CHECK: %[[ESHAPE:.*]] = fir.shape %[[ELEN]] : (index) -> !fir.shape<1>
+! CHECK: %[[EVIEW:.*]]:2 = hlfir.declare %[[ESEQ]](%[[ESHAPE]]) {uniq_name = ".sequence.assoc"}
+! CHECK: %[[ECOPY:.*]] = hlfir.as_expr %[[EVIEW]]#0
+! CHECK: %[[ETMP:.*]]:3 = hlfir.associate %[[ECOPY]](%[[ESHAPE]]) {adapt.valuebyref}
+! CHECK: fir.call @_QMm2Pbyvaln(%{{.*}}, %[[ETMP]]#1)
+subroutine value_seq_dynamic_variable()
+ use m2
+ integer :: v(4)
+ v = [1, 2, 3, 4]
+ call byvaln(3, v(2))
+end subroutine
+
+! Polymorphic dummy: the sequence view has the dummy's static shape and the
+! class descriptor is built over the copy, not over the scalar element.
+! CHECK-LABEL: func.func @_QPvalue_seq_class
+! CHECK: %[[CELT:.*]] = hlfir.designate %{{.*}} (%{{.*}}) : (!fir.ref<!fir.array<5x!fir.type<_QMm2Tt2{n:i32}>>>, i64) -> !fir.ref<!fir.type<_QMm2Tt2{n:i32}>>
+! CHECK: %[[CSEQ:.*]] = fir.convert %[[CELT]] : (!fir.ref<!fir.type<_QMm2Tt2{n:i32}>>) -> !fir.ref<!fir.array<2x!fir.type<_QMm2Tt2{n:i32}>>>
+! CHECK: %[[CVIEW:.*]]:2 = hlfir.declare %[[CSEQ]](%{{.*}}) {uniq_name = ".sequence.assoc"}
+! CHECK: %[[CCOPY:.*]] = hlfir.as_expr %[[CVIEW]]#0 : (!fir.ref<!fir.array<2x!fir.type<_QMm2Tt2{n:i32}>>>) -> !hlfir.expr<2x!fir.type<_QMm2Tt2{n:i32}>>
+! CHECK: %[[CTMP:.*]]:3 = hlfir.associate %[[CCOPY]]
+! CHECK: %[[CBOX:.*]] = fir.embox %[[CTMP]]#0
+! CHECK: fir.call @_QMm2Pbyval_class(%{{.*}}) {{.*}} : (!fir.class<!fir.array<2x!fir.type<_QMm2Tt2{n:i32}>>>) -> ()
+! CHECK: hlfir.end_associate %[[CTMP]]#1, %[[CTMP]]#2
+subroutine value_seq_class()
+ use m2
+ call byval_class(tp(2))
+end subroutine
+
+! Rank-two dummy: multi-dimensional static view of the sequence.
+! CHECK-LABEL: func.func @_QPvalue_seq_rank2
+! CHECK: %[[RSEQ:.*]] = fir.convert %{{.*}} : (!fir.ref<!fir.type<_QMm2Tt2{n:i32}>>) -> !fir.ref<!fir.array<2x2x!fir.type<_QMm2Tt2{n:i32}>>>
+! CHECK: %[[RVIEW:.*]]:2 = hlfir.declare %[[RSEQ]](%{{.*}}) {uniq_name = ".sequence.assoc"}
+! CHECK: %[[RCOPY:.*]] = hlfir.as_expr %[[RVIEW]]#0
+! CHECK: %[[RTMP:.*]]:3 = hlfir.associate %[[RCOPY]]
+! CHECK: fir.call @_QMm2Pbyval22(%[[RTMP]]#0)
+subroutine value_seq_rank2()
+ use m2
+ call byval22(tp(2))
+end subroutine
+
+! Zero-extent dummy boundary.
+! CHECK-LABEL: func.func @_QPvalue_seq_zero
+! CHECK: fir.convert %{{.*}} : (!fir.ref<i32>) -> !fir.ref<!fir.array<0xi32>>
+! CHECK: hlfir.declare %{{.*}} {uniq_name = ".sequence.assoc"}
+! CHECK: fir.call @_QMm2Pbyval0
+subroutine value_seq_zero()
+ use m2
+ integer, parameter :: cp(4) = [5, 6, 7, 8]
+ call byval0(cp(4))
+end subroutine
+
+! Derived type with an allocatable component: the sequence view covers both
+! elements so the VALUE copy deep-copies both elements' components.
+! CHECK-LABEL: func.func @_QPvalue_seq_deep
+! CHECK: %[[PSEQ:.*]] = fir.convert %{{.*}} : (!fir.ref<!fir.type<_QMm2Ttd{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.ref<!fir.array<2x!fir.type<_QMm2Ttd{a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>>
+! CHECK: %[[PVIEW:.*]]:2 = hlfir.declare %[[PSEQ]](%{{.*}}) {uniq_name = ".sequence.assoc"}
+! CHECK: %[[PCOPY:.*]] = hlfir.as_expr %[[PVIEW]]#0
+! CHECK: %[[PTMP:.*]]:3 = hlfir.associate %[[PCOPY]]
+! CHECK: fir.call @_QMm2Pbyval_deep(%[[PTMP]]#0)
+subroutine value_seq_deep()
+ use m2
+ type(td) :: b(3)
+ call byval_deep(b(2))
+end subroutine
+
+! Overlapping element actuals in one call each get their own independent
+! sequence-sized temporary.
+! CHECK-LABEL: func.func @_QPvalue_seq_overlap
+! CHECK: %[[OSEQ1:.*]] = fir.convert %{{.*}} : (!fir.ref<i32>) -> !fir.ref<!fir.array<3xi32>>
+! CHECK: hlfir.declare %[[OSEQ1]](%{{.*}}) {uniq_name = ".sequence.assoc"}
+! CHECK: %[[OTMP1:.*]]:3 = hlfir.associate
+! CHECK: %[[OSEQ2:.*]] = fir.convert %{{.*}} : (!fir.ref<i32>) -> !fir.ref<!fir.array<4xi32>>
+! CHECK: hlfir.declare %[[OSEQ2]](%{{.*}}) {uniq_name = ".sequence.assoc"}
+! CHECK: %[[OTMP2:.*]]:3 = hlfir.associate
+! CHECK: fir.call @_QMm2Pbyval_two(%[[OTMP1]]#0, %[[OTMP2]]#0)
+subroutine value_seq_overlap()
+ use m2
+ integer :: v(4)
+ v = [1, 2, 3, 4]
+ call byval_two(v(2), v(1))
+end subroutine
>From df564e73bd3e123ccbd3373df04a718dc81f2c1a Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Thu, 17 Sep 2026 10:15:08 -0700
Subject: [PATCH 12/13] [flang] Harden VALUE sequence copies: assumed-size,
descriptor rank, components
Three repairs to the sequence-sized VALUE temporaries:
- An assumed-size base array has no usable extent: do not feed its
sentinel extent into the remaining-sequence length (it aborted at
runtime). Fall back to the prior scalar copy, which is only reachable
for variable actual arguments (a named constant cannot be
assumed-size).
- The descriptor type prepared for a boxed dummy was derived from the
scalar actual argument before the copy was made, so the array copy was
packaged through a rank-changing descriptor type cast that corrupted
the descriptor addendum and broke type-bound dispatch in the callee.
Recompute the descriptor type from the sequence view so the copy is
boxed with matching rank and used as a sound source_box by the
sequence-association remapping.
- Extend the sequence view to elements of array components (the storage
sequence is confined to the component, with its own bounds) and to
boxed dummies whose declared element type differs from the actual
argument element type (TYPE(child) to CLASS(parent), intrinsic to
CLASS(*)): the view and copy use the actual argument element type so
the dynamic type and element size are preserved, and the descriptor
with the dummy declared type is created over that copy.
Add lowering tests for all five shapes: assumed-size fallback (no
sequence view from an unknown extent), rank-preserving CLASS packaging,
array-component element with a nondefault lower bound, extension type,
and unlimited polymorphic.
---
flang/lib/Lower/ConvertCall.cpp | 78 ++++++++++--
.../Lower/HLFIR/call-value-sequence-assoc.f90 | 117 ++++++++++++++++++
2 files changed, 184 insertions(+), 11 deletions(-)
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index bdd1b675b15ad..ec2ea8d44aa59 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1318,26 +1318,63 @@ static bool isParameterObjectOrSubObject(hlfir::Entity entity) {
return foundParameter;
}
+/// Does \p shape (a fir.shape or fir.shape_shift, possibly null) contain an
+/// assumed-size sentinel extent?
+static bool isAssumedSizeShape(mlir::Value shape) {
+ auto isAssumedSizeExtent = [](mlir::Value extent) {
+ while (auto convert = extent.getDefiningOp<fir::ConvertOp>())
+ extent = convert.getValue();
+ return extent.getDefiningOp<fir::AssumedSizeExtentOp>() != nullptr;
+ };
+ if (!shape)
+ return false;
+ if (auto shapeOp = shape.getDefiningOp<fir::ShapeOp>())
+ return llvm::any_of(shapeOp.getExtents(), isAssumedSizeExtent);
+ if (auto shapeShiftOp = shape.getDefiningOp<fir::ShapeShiftOp>())
+ return llvm::any_of(shapeShiftOp.getExtents(), isAssumedSizeExtent);
+ return false;
+}
+
/// If \p element is the address of an array element, generate the number of
/// elements in the storage sequence that starts at that element and runs to
-/// the end of its base array (F'2023 15.5.2.12 point 3.). Return a null
-/// value when the base array or the element position cannot be identified.
+/// the end of its base array - or, for an element of an array component, to
+/// the end of that component (F'2023 15.5.2.12 point 3.). Return a null
+/// value when the base array or the element position cannot be identified,
+/// or when the base array is assumed-size (its extent is not a usable
+/// count).
static mlir::Value genRemainingStorageSequenceExtent(mlir::Location loc,
fir::FirOpBuilder &builder,
hlfir::Entity element) {
auto designate = element.getDefiningOp<hlfir::DesignateOp>();
- if (!designate || designate.getComponent() ||
- !designate.getSubstring().empty() || designate.getComplexPart() ||
+ if (!designate || !designate.getSubstring().empty() ||
+ designate.getComplexPart() ||
llvm::is_contained(designate.getIsTriplet(), true))
return {};
hlfir::Entity base{designate.getMemref()};
- unsigned rank = base.getRank();
- if (rank == 0 || designate.getIndices().size() != rank)
+ llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> bounds;
+ if (designate.getComponent()) {
+ // Element of an array component: the storage sequence is confined to
+ // the component of that object (F'2023 9.5.4 "simply contiguous").
+ mlir::Value componentShape = designate.getComponentShape();
+ if (base.getRank() != 0 || !componentShape)
+ return {};
+ bounds = hlfir::genBounds(loc, builder, componentShape);
+ } else {
+ if (base.getRank() == 0)
+ return {};
+ if (auto varIface = base.getDefiningOp<fir::FortranVariableOpInterface>()) {
+ if (isAssumedSizeShape(varIface.getShape()))
+ return {};
+ } else if (!mlir::isa<fir::BaseBoxType>(base.getType())) {
+ // Cannot prove the base array is not assumed-size.
+ return {};
+ }
+ bounds = hlfir::genBounds(loc, builder, base);
+ }
+ if (designate.getIndices().size() != bounds.size())
return {};
// The remaining length is the base array size minus the column-major
// offset of the element inside the base array.
- llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> bounds =
- hlfir::genBounds(loc, builder, base);
mlir::Type idxTy = builder.getIndexType();
mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
mlir::Value stride = one;
@@ -1567,11 +1604,20 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
hlfir::Entity source = entity;
if (entity.getRank() == 0 && fir::isa_ref_type(entity.getType())) {
mlir::Type dummyBaseTy = fir::unwrapRefType(dummyType);
- if (auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(dummyBaseTy))
+ bool dummyIsBoxed = false;
+ if (auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(dummyBaseTy)) {
+ dummyIsBoxed = true;
dummyBaseTy = fir::unwrapRefType(boxTy.getEleTy());
+ }
mlir::Type eleTy = fir::unwrapRefType(entity.getType());
+ // A boxed (polymorphic) dummy may have a compatible declared element
+ // type that differs from the actual argument element type. The view
+ // and copy are made with the actual argument element type so that
+ // the sequence element size and the dynamic type are preserved; the
+ // descriptor with the dummy declared type is created over that copy
+ // below.
if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(dummyBaseTy);
- seqTy && seqTy.getEleTy() == eleTy &&
+ seqTy && (seqTy.getEleTy() == eleTy || dummyIsBoxed) &&
!mlir::isa<fir::CharacterType>(eleTy)) {
llvm::SmallVector<mlir::Value> extents;
mlir::Type viewTy;
@@ -1579,7 +1625,7 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
for (auto extent : seqTy.getShape())
extents.push_back(builder.createIntegerConstant(
loc, builder.getIndexType(), extent));
- viewTy = seqTy;
+ viewTy = fir::SequenceType::get(seqTy.getShape(), eleTy);
} else if (mlir::Value remaining = genRemainingStorageSequenceExtent(
loc, builder, entity)) {
extents.push_back(remaining);
@@ -1594,6 +1640,16 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
builder, loc, seqRef, ".sequence.assoc", shape,
/*typeparams=*/mlir::ValueRange{}, /*dummy_scope=*/nullptr);
source = hlfir::Entity{declare.getBase()};
+ // The descriptor type prepared for a boxed dummy was derived
+ // from the scalar actual argument. Recompute it from the
+ // sequence view so that the copy is packaged with an array
+ // descriptor of matching rank (the sequence-association
+ // remapping uses it as source_box; a rank-changing type cast
+ // would corrupt the descriptor addendum).
+ if (auto baseBoxDummy =
+ mlir::dyn_cast<fir::BaseBoxType>(dummyTypeWithActualRank))
+ dummyTypeWithActualRank = baseBoxDummy.getBoxTypeWithNewShape(
+ hlfir::getFortranElementOrSequenceType(source.getType()));
}
}
}
diff --git a/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90 b/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90
index aed9975beef7b..1a536a543be01 100644
--- a/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90
+++ b/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90
@@ -186,3 +186,120 @@ subroutine value_seq_overlap()
v = [1, 2, 3, 4]
call byval_two(v(2), v(1))
end subroutine
+
+! Assumed-size bases, polymorphic dummies, and array-component elements.
+
+module m3
+ implicit none
+ type tc
+ integer :: a(-1:2)
+ end type
+ type(tc), parameter :: pc(2) = [tc([1,2,3,4]), tc([11,22,33,44])]
+ type tt
+ integer :: id
+ end type
+ type, extends(tt) :: ttx
+ integer :: extra
+ end type
+ type(ttx), parameter :: px(3) = [ttx(1,10), ttx(2,20), ttx(3,30)]
+contains
+ subroutine byvaln(n, x)
+ integer, intent(in) :: n
+ integer, value :: x(n)
+ end subroutine
+ subroutine byval_class1(x)
+ class(tt), value :: x(1)
+ end subroutine
+ subroutine byval_parent2(x)
+ class(tt), value :: x(2)
+ end subroutine
+ subroutine byval_star3(x)
+ class(*), value :: x(3)
+ end subroutine
+end module
+
+! An element of an assumed-size array passed to a runtime-shaped VALUE dummy:
+! the remaining sequence length is unknown, so no sequence view is created
+! (the unknown extent must not become a copy length).
+! CHECK-LABEL: func.func @_QPvalue_seq_assumed_size
+! CHECK: %[[AELT:.*]] = hlfir.designate %{{.*}} (%{{.*}}) : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+! CHECK-NOT: ".sequence.assoc"
+! CHECK: %[[ACOPY:.*]] = hlfir.as_expr %[[AELT]] : (!fir.ref<i32>) -> !hlfir.expr<i32>
+! CHECK-NOT: ".sequence.assoc"
+! CHECK: fir.call @_QMm3Pbyvaln
+subroutine value_seq_assumed_size(a, n)
+ use m3
+ integer :: a(*)
+ integer :: n
+ call byvaln(n, a(2))
+end subroutine
+
+! Polymorphic dummy: the copy is packaged with an array descriptor of
+! matching rank (a rank-changing type cast would corrupt the descriptor
+! addendum and break type-bound dispatch in the callee).
+! CHECK-LABEL: func.func @_QPvalue_seq_class_ranked
+! CHECK: %[[KELT:.*]] = hlfir.designate %{{.*}} (%{{.*}}) : (!fir.ref<!fir.array<3x!fir.type<_QMm3Ttt{id:i32}>>>, index) -> !fir.ref<!fir.type<_QMm3Ttt{id:i32}>>
+! CHECK: %[[KSEQ:.*]] = fir.convert %[[KELT]] : (!fir.ref<!fir.type<_QMm3Ttt{id:i32}>>) -> !fir.ref<!fir.array<1x!fir.type<_QMm3Ttt{id:i32}>>>
+! CHECK: %[[KVIEW:.*]]:2 = hlfir.declare %[[KSEQ]](%{{.*}}) {uniq_name = ".sequence.assoc"}
+! CHECK: %[[KCOPY:.*]] = hlfir.as_expr %[[KVIEW]]#0
+! CHECK: %[[KTMP:.*]]:3 = hlfir.associate %[[KCOPY]]
+! CHECK: %[[KBOX:.*]] = fir.embox %[[KTMP]]#0(%{{.*}}) : {{.*}} -> !fir.box<!fir.array<1x!fir.type<_QMm3Ttt{id:i32}>>>
+! CHECK: %[[KCLASS:.*]] = fir.convert %[[KBOX]] : (!fir.box<!fir.array<1x!fir.type<_QMm3Ttt{id:i32}>>>) -> !fir.class<!fir.array<1x!fir.type<_QMm3Ttt{id:i32}>>>
+! CHECK: fir.embox %{{.*}}(%{{.*}}) source_box %[[KCLASS]]
+! CHECK: fir.call @_QMm3Pbyval_class1(%{{.*}}) {{.*}} : (!fir.class<!fir.array<1x!fir.type<_QMm3Ttt{id:i32}>>>) -> ()
+subroutine value_seq_class_ranked()
+ use m3
+ type(tt) :: v(3)
+ v = [tt(1), tt(2), tt(3)]
+ call byval_class1(v(2))
+end subroutine
+
+! Element of an array component: the remaining sequence is confined to the
+! component (its extent is computed from the component shape, including a
+! nondefault lower bound).
+! CHECK-LABEL: func.func @_QPvalue_seq_component
+! CHECK: %[[CMELT:.*]] = hlfir.designate %{{.*}}{"a"} <%{{.*}}> (%{{.*}}) : (!fir.ref<!fir.type<_QMm3Ttc{a:!fir.array<4xi32>}>>, !fir.shapeshift<1>, index) -> !fir.ref<i32>
+! CHECK: %[[CMLEN:.*]] = arith.subi %{{[0-9]+}}, %{{[0-9]+}} : index
+! CHECK: %[[CMSEQ:.*]] = fir.convert %[[CMELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<?xi32>>
+! CHECK: %[[CMSHAPE:.*]] = fir.shape %[[CMLEN]] : (index) -> !fir.shape<1>
+! CHECK: %[[CMVIEW:.*]]:2 = hlfir.declare %[[CMSEQ]](%[[CMSHAPE]]) {uniq_name = ".sequence.assoc"}
+! CHECK: fir.call @_QMm3Pbyvaln(%{{.*}}, %{{.*}}#1)
+subroutine value_seq_component()
+ use m3
+ call byvaln(3, pc(2)%a(0))
+end subroutine
+
+! TYPE(child) element to CLASS(parent) dummy: the view and copy use the
+! actual argument element type so the dynamic type and element size are
+! preserved; the descriptor uses the dummy declared type over that copy.
+! CHECK-LABEL: func.func @_QPvalue_seq_extension
+! CHECK: %[[XELT:.*]] = hlfir.designate %{{.*}} (%{{.*}}) : {{.*}} -> !fir.ref<!fir.type<_QMm3Tttx{tt:!fir.type<_QMm3Ttt{id:i32}>,extra:i32}>>
+! CHECK: %[[XSEQ:.*]] = fir.convert %[[XELT]] : {{.*}} -> !fir.ref<!fir.array<2x!fir.type<_QMm3Tttx{tt:!fir.type<_QMm3Ttt{id:i32}>,extra:i32}>>>
+! CHECK: %[[XVIEW:.*]]:2 = hlfir.declare %[[XSEQ]](%{{.*}}) {uniq_name = ".sequence.assoc"}
+! CHECK: %[[XCOPY:.*]] = hlfir.as_expr %[[XVIEW]]#0
+! CHECK: %[[XTMP:.*]]:3 = hlfir.associate %[[XCOPY]]
+! CHECK: %[[XBOX:.*]] = fir.embox %[[XTMP]]#0(%{{.*}}) : {{.*}} -> !fir.box<!fir.array<2x!fir.type<_QMm3Tttx{tt:!fir.type<_QMm3Ttt{id:i32}>,extra:i32}>>>
+! CHECK: %[[XCLASS:.*]] = fir.convert %[[XBOX]] : {{.*}} -> !fir.class<!fir.array<2x!fir.type<_QMm3Ttt{id:i32}>>>
+! CHECK: fir.embox %{{.*}} source_box %[[XCLASS]]
+! CHECK: fir.call @_QMm3Pbyval_parent2(%{{.*}}) {{.*}} : (!fir.class<!fir.array<2x!fir.type<_QMm3Ttt{id:i32}>>>) -> ()
+subroutine value_seq_extension()
+ use m3
+ call byval_parent2(px(2))
+end subroutine
+
+! INTEGER element to CLASS(*) dummy: the copy keeps the intrinsic element
+! type; the rebox adds the addendum the unlimited polymorphic dummy needs.
+! CHECK-LABEL: func.func @_QPvalue_seq_unlimited
+! CHECK: %[[UELT:.*]] = hlfir.designate %{{.*}} (%{{.*}}) : (!fir.ref<!fir.array<4xi32>>, i64) -> !fir.ref<i32>
+! CHECK: %[[USEQ:.*]] = fir.convert %[[UELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<3xi32>>
+! CHECK: %[[UVIEW:.*]]:2 = hlfir.declare %[[USEQ]](%{{.*}}) {uniq_name = ".sequence.assoc"}
+! CHECK: %[[UCOPY:.*]] = hlfir.as_expr %[[UVIEW]]#0
+! CHECK: %[[UTMP:.*]]:3 = hlfir.associate %[[UCOPY]]
+! CHECK: %[[UBOX:.*]] = fir.embox %[[UTMP]]#0(%{{.*}}) : {{.*}} -> !fir.box<!fir.array<3xi32>>
+! CHECK: %[[UCLASS:.*]] = fir.rebox %[[UBOX]] : (!fir.box<!fir.array<3xi32>>) -> !fir.class<!fir.array<3xnone>>
+! CHECK: fir.call @_QMm3Pbyval_star3(%{{.*}}) {{.*}} : (!fir.class<!fir.array<3xnone>>) -> ()
+subroutine value_seq_unlimited()
+ use m3
+ integer, parameter :: cp(4) = [5, 6, 7, 8]
+ call byval_star3(cp(2))
+end subroutine
>From 3fc9f8455261137abcb1ab68eae28c47047dbdfc Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Thu, 17 Sep 2026 12:21:41 -0700
Subject: [PATCH 13/13] [flang] Extend VALUE sequence-association test coverage
Cover assumed-size interactions and further polymorphic and component
shapes: an assumed-size base still gets the sequence view when the dummy
extents are static (positive guard control); a runtime rank-two
CLASS(parent) dummy from a TYPE(child) element keeps the child element
type through a rank-one view; an assumed-size TYPE element to a
runtime-shaped CLASS dummy falls back to a rank-consistent scalar
descriptor; a nested rank-two array component with nondefault bounds
computes the remaining extent from the component's own shape; and a REAL
element reaches an OPTIONAL CLASS(*) rank-two dummy through a rebox that
adds the addendum. Also document beside the assumed-size fallback check
that it preserves preexisting behavior that is only correct for
single-element dummies.
---
.../Lower/HLFIR/call-value-sequence-assoc.f90 | 130 ++++++++++++++++++
1 file changed, 130 insertions(+)
diff --git a/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90 b/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90
index 1a536a543be01..afb2b5006ee93 100644
--- a/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90
+++ b/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90
@@ -221,6 +221,10 @@ subroutine byval_star3(x)
! An element of an assumed-size array passed to a runtime-shaped VALUE dummy:
! the remaining sequence length is unknown, so no sequence view is created
! (the unknown extent must not become a copy length).
+! NOTE: the scalar-copy fallback checked here preserves the preexisting
+! behavior, which is only correct when the dummy has at most one element; a
+! complete implementation must obtain the required dummy extents at a
+! suitable argument preparation stage.
! CHECK-LABEL: func.func @_QPvalue_seq_assumed_size
! CHECK: %[[AELT:.*]] = hlfir.designate %{{.*}} (%{{.*}}) : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
! CHECK-NOT: ".sequence.assoc"
@@ -303,3 +307,129 @@ subroutine value_seq_unlimited()
integer, parameter :: cp(4) = [5, 6, 7, 8]
call byval_star3(cp(2))
end subroutine
+
+! Assumed-size interactions, runtime polymorphic rank-two, and nested
+! component bounds.
+
+module m4
+ implicit none
+ type tp4
+ integer :: id
+ end type
+ type, extends(tp4) :: tc4
+ integer :: extra
+ end type
+ type(tc4), parameter :: pk(6) = &
+ [tc4(1,10), tc4(2,20), tc4(3,30), tc4(4,40), tc4(5,50), tc4(6,60)]
+ type inner4
+ integer :: a(-1:0,4:6)
+ end type
+ type outer4
+ integer :: guard
+ type(inner4) :: item(2)
+ end type
+ type(outer4), parameter :: po = outer4(999, [ &
+ inner4(reshape([1,2,3,4,5,6],[2,3])), &
+ inner4(reshape([11,12,13,14,15,16],[2,3]))])
+contains
+ subroutine byvaln4(n, x)
+ integer, intent(in) :: n
+ integer, value :: x(n)
+ end subroutine
+ subroutine byval3s(x)
+ integer, value :: x(3)
+ end subroutine
+ subroutine byval_rank2_parent(n, x)
+ integer, intent(in) :: n
+ class(tp4), value :: x(-1:0, 3:n+2)
+ end subroutine
+ subroutine byval_classn(n, x)
+ integer, intent(in) :: n
+ class(tp4), value :: x(n)
+ end subroutine
+ subroutine byval_opt_star(n, x)
+ integer, intent(in) :: n
+ class(*), value, optional :: x(2, n)
+ end subroutine
+end module
+
+! Positive guard control: an assumed-size base array does not block the
+! sequence view when the dummy extents are static.
+! CHECK-LABEL: func.func @_QPvalue_seq_assumed_size_static
+! CHECK: %[[GELT:.*]] = hlfir.designate %{{.*}} (%{{.*}}) : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+! CHECK: %[[GSEQ:.*]] = fir.convert %[[GELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<3xi32>>
+! CHECK: %[[GVIEW:.*]]:2 = hlfir.declare %[[GSEQ]](%{{.*}}) {uniq_name = ".sequence.assoc"}
+! CHECK: fir.call @_QMm4Pbyval3s
+subroutine value_seq_assumed_size_static(a)
+ use m4
+ integer :: a(*)
+ call byval3s(a(2))
+end subroutine
+
+! Runtime rank-two CLASS(parent) dummy from a TYPE(child) element: the
+! remaining-sequence view keeps the child element type, and the copy is
+! packaged rank one over the view (the sequence-association remapping
+! builds the rank-two dummy descriptor from it).
+! CHECK-LABEL: func.func @_QPvalue_seq_rank2_child
+! CHECK: %[[R2ELT:.*]] = hlfir.designate %{{.*}} (%{{.*}}) : {{.*}} -> !fir.ref<!fir.type<_QMm4Ttc4{{.*}}>>
+! CHECK: %[[R2LEN:.*]] = arith.subi %{{[0-9]+}}, %{{[0-9]+}} : index
+! CHECK: %[[R2SEQ:.*]] = fir.convert %[[R2ELT]] : {{.*}} -> !fir.ref<!fir.array<?x!fir.type<_QMm4Ttc4{{.*}}>>>
+! CHECK: %[[R2VIEW:.*]]:2 = hlfir.declare %[[R2SEQ]](%{{.*}}) {uniq_name = ".sequence.assoc"}
+! CHECK: %[[R2TMP:.*]]:3 = hlfir.associate
+! CHECK: fir.convert %[[R2TMP]]#0 : (!fir.box<!fir.array<?x!fir.type<_QMm4Ttc4{{.*}}>>>) -> !fir.class<!fir.array<?x!fir.type<_QMm4Ttp4{id:i32}>>>
+! CHECK: fir.call @_QMm4Pbyval_rank2_parent
+subroutine value_seq_rank2_child()
+ use m4
+ call byval_rank2_parent(2, pk(2))
+end subroutine
+
+! An element of an assumed-size TYPE array to a runtime-shaped CLASS dummy:
+! no sequence view (unknown remaining length), and the scalar copy is
+! packaged with a scalar descriptor - rank-consistent, so the descriptor
+! addendum stays sound for the one-element case.
+! CHECK-LABEL: func.func @_QPvalue_seq_assumed_size_class
+! CHECK: %[[SCELT:.*]] = hlfir.designate %{{.*}} (%{{.*}}) : (!fir.box<!fir.array<?x!fir.type<_QMm4Ttp4{id:i32}>>>, index) -> !fir.ref<!fir.type<_QMm4Ttp4{id:i32}>>
+! CHECK-NOT: ".sequence.assoc"
+! CHECK: %[[SCCOPY:.*]] = hlfir.as_expr %[[SCELT]] : (!fir.ref<!fir.type<_QMm4Ttp4{id:i32}>>) -> !hlfir.expr<!fir.type<_QMm4Ttp4{id:i32}>>
+! CHECK: %[[SCTMP:.*]]:3 = hlfir.associate %[[SCCOPY]]
+! CHECK: %[[SCBOX:.*]] = fir.embox %[[SCTMP]]#0 : (!fir.ref<!fir.type<_QMm4Ttp4{id:i32}>>) -> !fir.box<!fir.type<_QMm4Ttp4{id:i32}>>
+! CHECK: %[[SCCLASS:.*]] = fir.convert %[[SCBOX]] : (!fir.box<!fir.type<_QMm4Ttp4{id:i32}>>) -> !fir.class<!fir.type<_QMm4Ttp4{id:i32}>>
+! CHECK: fir.embox %{{.*}}(%{{.*}}) source_box %[[SCCLASS]]
+! CHECK: fir.call @_QMm4Pbyval_classn
+subroutine value_seq_assumed_size_class(a, n)
+ use m4
+ type(tp4) :: a(*)
+ integer :: n
+ call byval_classn(n, a(2))
+end subroutine
+
+! Element of a nested rank-two array component with nondefault bounds: the
+! remaining extent is computed from the component's own shape.
+! CHECK-LABEL: func.func @_QPvalue_seq_nested_rank2
+! CHECK: %[[NELT:.*]] = hlfir.designate %{{.*}}{"a"} <%{{.*}}> (%{{.*}}, %{{.*}}) : (!fir.ref<!fir.type<_QMm4Tinner4{a:!fir.array<2x3xi32>}>>, !fir.shapeshift<2>, index, index) -> !fir.ref<i32>
+! CHECK: %[[NLEN:.*]] = arith.subi %{{[0-9]+}}, %{{[0-9]+}} : index
+! CHECK: %[[NSEQ:.*]] = fir.convert %[[NELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<?xi32>>
+! CHECK: %[[NSHAPE:.*]] = fir.shape %[[NLEN]] : (index) -> !fir.shape<1>
+! CHECK: %[[NVIEW:.*]]:2 = hlfir.declare %[[NSEQ]](%[[NSHAPE]]) {uniq_name = ".sequence.assoc"}
+! CHECK: fir.call @_QMm4Pbyvaln4(%{{.*}}, %{{.*}}#1)
+subroutine value_seq_nested_rank2()
+ use m4
+ call byvaln4(3, po%item(2)%a(0,5))
+end subroutine
+
+! REAL element to an OPTIONAL CLASS(*) rank-two runtime dummy (present
+! actual): the view keeps the intrinsic element type and the rebox adds
+! the addendum the unlimited polymorphic dummy needs.
+! CHECK-LABEL: func.func @_QPvalue_seq_optional_star
+! CHECK: %[[OELT:.*]] = hlfir.designate %{{.*}} (%{{.*}}) : (!fir.ref<!fir.array<6xf64>>, i64) -> !fir.ref<f64>
+! CHECK: %[[OLEN:.*]] = arith.subi %{{[0-9]+}}, %{{[0-9]+}} : index
+! CHECK: %[[OSEQ:.*]] = fir.convert %[[OELT]] : (!fir.ref<f64>) -> !fir.ref<!fir.array<?xf64>>
+! CHECK: %[[OVIEW:.*]]:2 = hlfir.declare %[[OSEQ]](%{{.*}}) {uniq_name = ".sequence.assoc"}
+! CHECK: %[[OTMP:.*]]:3 = hlfir.associate
+! CHECK: fir.rebox %[[OTMP]]#0 : (!fir.box<!fir.array<?xf64>>) -> !fir.class<!fir.array<?xnone>>
+! CHECK: fir.call @_QMm4Pbyval_opt_star
+subroutine value_seq_optional_star()
+ use m4
+ real(8), parameter :: pr(6) = [1,2,3,4,5,6]
+ call byval_opt_star(2, pr(2))
+end subroutine
More information about the flang-commits
mailing list