[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
Wed Sep 23 00:21:30 PDT 2026
https://github.com/eugeneepshteyn updated https://github.com/llvm/llvm-project/pull/222986
>From e4727b7886e3bb05a6e2d0b1d9916265cb9bdf4d 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/15] [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 6e4ea495c6ab8d..c13e0fef469579 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 88874f7ef08e88..4b0d493959ec92 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 8c70c8145b8200..285cad7ae6553e 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1392,19 +1392,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;
}
@@ -1498,13 +1503,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 800b3cc8082354..bc344c9660a345 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);
}
@@ -3550,6 +3552,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)};
@@ -3580,6 +3583,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)};
@@ -4999,11 +5003,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));
@@ -5930,7 +5957,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 00000000000000..8491392cfe27c7
--- /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 7e992bea91c8bc..ab8175eaaf255d 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 acf3fedae41818..12b04879656e5b 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 9b9076722828ee..e28d1ee1baa562 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 bc3eb881b5e071deb32b8aa0c4d6c793c7bfbe35 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/15] [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 8491392cfe27c7..281b3b7b1d1aec 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 db1c3d4e2c6a71c6579e5ca54338411cf72fd61f 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/15] [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 c837a7d72e8b18..2b8cb4ea457ebe 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 c13e0fef469579..0f24689cf79de4 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 4b0d493959ec92..e6f39ae89ab053 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 bc344c9660a345..4d62cdcb61c1a6 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);
}
@@ -3552,7 +3550,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)};
@@ -3561,6 +3558,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());
}
@@ -3583,7 +3586,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)};
@@ -5003,34 +5005,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));
@@ -5970,7 +5949,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 00000000000000..b259a35fd73379
--- /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 e0df315fa57dff..bb80bcd0d792c1 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 845de47b894e76066ad3bd917ddfb6f64b0ac1fc 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/15] [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 2fd7ff5ac1a5c9..b12c8bd604b10d 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 281b3b7b1d1aec..d7fae1773ab934 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 00000000000000..6b4a90f9be56da
--- /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 805ff2bda20167c352ccace5aabaad11471827c4 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/15] [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 0f24689cf79de4..46dccab02df86e 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 b958ff1094479eb61c21d5b0008cae6567147c95 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/15] [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 919f3c6db547ba..32bb26588407a5 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 d7751ec3899173..00559ea1f4e936 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 b12c8bd604b10d..d065c1e6a65971 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 6b4a90f9be56da..dfdf49823c921d 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 a016244309070b868f776e0d10b992f2637d4206 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/15] [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 d7fae1773ab934..43d94d670271b1 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 c64749de93e07ecae4fb46e0b9665cc2ff7f6d6b 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/15] [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 2b8cb4ea457ebe..3003179699faa6 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 46dccab02df86e..db4cf137b5eb00 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 f89fb1601176e2..03414f1e789e08 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 f20d32077602df..6cf5a654b648de 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 d065c1e6a65971..7fd6fe792d23e2 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 43d94d670271b1..db89bd94626559 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 00000000000000..1f5c1f1c8aa623
--- /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 57e2b3120fd721ab5dcb41389c7cabc05b3415d4 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 09/15] [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 00000000000000..79596c2c146785
--- /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 00000000000000..24611dcdd5e20b
--- /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 dfdf49823c921d..b2b7378d9b5969 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 50ff0574ea32e87aa92cbe125dde047d1290ed55 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Fri, 18 Sep 2026 09:21:56 -0700
Subject: [PATCH 10/15] [flang] Keep rejecting named-constant elements for
VALUE array dummies
An array VALUE dummy argument requires a temporary covering the whole
storage sequence supplied by an array element actual argument, and
lowering does not create one yet (llvm-project#224636 tracks that
preexisting problem, which is reproducible with variable actual
arguments). Retaining named-constant designators would newly accept the
named-constant element form and route it into that miscompile, so keep
diagnosing it - with a 'not yet' message - until #224636 is fixed. Whole
named-constant arrays and variable elements are unaffected.
---
flang/lib/Semantics/check-call.cpp | 13 ++++++++++++
.../Semantics/call-parameter-seq-assoc.f90 | 21 +++++++++++++++++++
2 files changed, 34 insertions(+)
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 7fd6fe792d23e2..40cee8ef3a068a 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -681,6 +681,19 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
"Polymorphic scalar may not be associated with a %s array"_err_en_US,
dummyName);
}
+ if (actualIsArrayElement &&
+ dummy.attrs.test(characteristics::DummyDataObject::Attr::Value) &&
+ evaluate::IsNamedConstantDesignator(actual)) {
+ // TODO(llvm-project#224636): lowering does not yet create a
+ // temporary covering the whole storage sequence for an array
+ // VALUE dummy argument, so the element sequence association
+ // that retaining the named constant designator enables would
+ // be miscompiled. Keep rejecting it until that is fixed.
+ basicError = true;
+ messages.Say(
+ "Named constant array element actual argument may not yet be associated with a VALUE %s array"_err_en_US,
+ dummyName);
+ }
bool isOkBecauseContiguous{
context.IsEnabled(
common::LanguageFeature::ContiguousOkForSeqAssociation) &&
diff --git a/flang/test/Semantics/call-parameter-seq-assoc.f90 b/flang/test/Semantics/call-parameter-seq-assoc.f90
index b2b7378d9b5969..57799efeaa83a5 100644
--- a/flang/test/Semantics/call-parameter-seq-assoc.f90
+++ b/flang/test/Semantics/call-parameter-seq-assoc.f90
@@ -134,3 +134,24 @@ integer function mysum(x, y)
mysum = x(1) + x(2) + x(3) + x(4) + y
end function
end subroutine
+
+subroutine value_dummy_not_yet()
+ ! An array VALUE dummy needs a temporary covering the whole storage
+ ! sequence, which lowering does not create yet (llvm-project#224636):
+ ! the named-constant element form stays rejected for now, while whole
+ ! named-constant arrays and variable elements are unaffected.
+ use m
+ integer :: v(4)
+ interface
+ subroutine byval3(x)
+ integer, value :: x(3)
+ end subroutine
+ subroutine byval4(x)
+ integer, value :: x(4)
+ end subroutine
+ end interface
+ !ERROR: Named constant array element actual argument may not yet be associated with a VALUE dummy argument 'x=' array
+ call byval3(gp(2))
+ call byval4(gp) ! whole array: accepted
+ call byval3(v(2)) ! variable element: accepted (preexisting behavior)
+end subroutine
>From 22a7e1871814529021613cf316b921fb085311c4 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Fri, 18 Sep 2026 11:54:35 -0700
Subject: [PATCH 11/15] [flang][NFC] Use the not-yet-implemented message form
for the VALUE guard
Reword the temporary rejection of named-constant elements associated with
VALUE array dummies to the _todo_en_US 'not yet implemented' form used
elsewhere in semantics.
---
flang/lib/Semantics/check-call.cpp | 2 +-
flang/test/Semantics/call-parameter-seq-assoc.f90 | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 40cee8ef3a068a..0171965a1919c7 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -691,7 +691,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
// be miscompiled. Keep rejecting it until that is fixed.
basicError = true;
messages.Say(
- "Named constant array element actual argument may not yet be associated with a VALUE %s array"_err_en_US,
+ "sequence association of a named constant array element with a VALUE %s array"_todo_en_US,
dummyName);
}
bool isOkBecauseContiguous{
diff --git a/flang/test/Semantics/call-parameter-seq-assoc.f90 b/flang/test/Semantics/call-parameter-seq-assoc.f90
index 57799efeaa83a5..d3c7d34dcdd5e7 100644
--- a/flang/test/Semantics/call-parameter-seq-assoc.f90
+++ b/flang/test/Semantics/call-parameter-seq-assoc.f90
@@ -150,7 +150,7 @@ subroutine byval4(x)
integer, value :: x(4)
end subroutine
end interface
- !ERROR: Named constant array element actual argument may not yet be associated with a VALUE dummy argument 'x=' array
+ !ERROR: not yet implemented: sequence association of a named constant array element with a VALUE dummy argument 'x=' array
call byval3(gp(2))
call byval4(gp) ! whole array: accepted
call byval3(v(2)) ! variable element: accepted (preexisting behavior)
>From 5d769bfd7b959094a81f99bb4ec69d9ce582b0cb Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Tue, 22 Sep 2026 08:43:45 -0700
Subject: [PATCH 12/15] [flang][NFC] Drop the redundant -triple from the
PowerPC vec_sld test
The test is already gated on REQUIRES: target=powerpc, so it only runs
where the default target is PowerPC, and its check does not depend on
the vector element order. Match the other tests in the directory.
---
flang/test/Integration/PowerPC/ppc-vec-shift-parameter.f90 | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/test/Integration/PowerPC/ppc-vec-shift-parameter.f90 b/flang/test/Integration/PowerPC/ppc-vec-shift-parameter.f90
index b259a35fd73379..491a2f935f682a 100644
--- a/flang/test/Integration/PowerPC/ppc-vec-shift-parameter.f90
+++ b/flang/test/Integration/PowerPC/ppc-vec-shift-parameter.f90
@@ -6,7 +6,7 @@
! added to this directory and sub-directories.
!===----------------------------------------------------------------------===!
-! RUN: %flang_fc1 -emit-llvm %s -triple ppc64le-unknown-linux -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-llvm %s -o - | FileCheck %s
! REQUIRES: target=powerpc{{.*}}
! The shift amount of vec_sld must reach PowerPC lowering as a constant even
>From 426dbaa45b459473d6ca327b722cf7ee6432ba6e Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Tue, 22 Sep 2026 09:18:32 -0700
Subject: [PATCH 13/15] [flang] Fold LBOUND of implied-shape named constants
with nondefault lower bounds
GetLowerBound with LBOUND semantics requires an explicit upper bound to
prove that a dimension with a lower bound other than 1 is not empty. An
implied-shape named constant has no explicit upper bound, so its lower
bound came back unknown. Two consequences: the designator folder gave up,
so the storage sequence check for an element of such a constant used as
an actual argument was silently skipped and a too-short sequence was
accepted; and omitted-bound sections of such constants (p(:)) were not
constant expressions, so size(p(:)), ubound(p(:),1), shape(p2(:,0)) and
array expressions over them were rejected in constant contexts. Use the
initializer's extent instead.
Add implied-shape cases (rank 1 with default and nondefault lower bound,
rank 2) to the sequence association test, and a folding test for the
omitted-bound sections (rank 1, rank 2, empty).
---
flang/lib/Evaluate/shape.cpp | 10 +++++++
.../Evaluate/fold-implied-shape-section.f90 | 22 ++++++++++++++
.../Semantics/call-parameter-seq-assoc.f90 | 29 +++++++++++++++++++
3 files changed, 61 insertions(+)
create mode 100644 flang/test/Evaluate/fold-implied-shape-section.f90
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index f0fba61a25bde3..cff059ba7b113a 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -302,6 +302,16 @@ class GetLowerBoundHelper
ok = false;
}
}
+ } else if (IsImpliedShape(symbol) && object->init()) {
+ // Implied-shape named constant: there is no explicit upper
+ // bound, but the extent is known from the initializer.
+ if (auto extent{ToInt64(
+ GetExtent(base, dimension_, invariantOnly_))}) {
+ if (*extent <= 0) {
+ return Result{1};
+ }
+ ok = true;
+ }
}
return ok ? *lbound : Result{};
} else {
diff --git a/flang/test/Evaluate/fold-implied-shape-section.f90 b/flang/test/Evaluate/fold-implied-shape-section.f90
new file mode 100644
index 00000000000000..4ce7553918fe73
--- /dev/null
+++ b/flang/test/Evaluate/fold-implied-shape-section.f90
@@ -0,0 +1,22 @@
+! RUN: %python %S/test_folding.py %s %flang_fc1
+! Omitted-bound sections of implied-shape named constants with nondefault
+! lower bounds are constant expressions: LBOUND of the whole array is the
+! declared lower bound (1 for an empty dimension, F'2023 16.9.119 p5), and
+! the bounds of a section are 1-based.
+module m
+ integer, parameter :: p0(0:*) = [1, 2, 3]
+ integer, parameter :: p2(2:*, 0:*) = reshape([1, 2, 3, 4, 5, 6], [2, 3])
+ integer, parameter :: e(5:*) = [integer::]
+ logical, parameter :: test_p0_whole_lb = lbound(p0, 1) == 0
+ logical, parameter :: test_p0_size = size(p0(:)) == 3
+ logical, parameter :: test_p0_lb = lbound(p0(:), 1) == 1
+ logical, parameter :: test_p0_ub = ubound(p0(:), 1) == 3
+ logical, parameter :: test_p0_vals = all(p0(:) == [1, 2, 3])
+ logical, parameter :: test_p2_whole_lb = all(lbound(p2) == [2, 0])
+ logical, parameter :: test_p2_size = size(p2(:, :)) == 6
+ logical, parameter :: test_p2_shape = all(shape(p2(:, :)) == [2, 3])
+ logical, parameter :: test_p2_ub = ubound(p2(:, 1), 1) == 2
+ logical, parameter :: test_e_lb = lbound(e, 1) == 1
+ logical, parameter :: test_e_sec_lb = lbound(e(:), 1) == 1
+ logical, parameter :: test_e_size = size(e(:)) == 0
+end module
diff --git a/flang/test/Semantics/call-parameter-seq-assoc.f90 b/flang/test/Semantics/call-parameter-seq-assoc.f90
index d3c7d34dcdd5e7..fa4ffc97ff0f0f 100644
--- a/flang/test/Semantics/call-parameter-seq-assoc.f90
+++ b/flang/test/Semantics/call-parameter-seq-assoc.f90
@@ -155,3 +155,32 @@ subroutine byval4(x)
call byval4(gp) ! whole array: accepted
call byval3(v(2)) ! variable element: accepted (preexisting behavior)
end subroutine
+
+module mimplied
+ ! Implied-shape named constants: the storage-sequence check must see their
+ ! extents (from the initializer) and their lower bounds, including
+ ! nondefault ones and rank > 1.
+ integer, parameter :: ip1(*) = [1, 2, 3, 4]
+ integer, parameter :: ip0(0:*) = [1, 2, 3, 4]
+ integer, parameter :: ip2(0:*, *) = reshape([1, 2, 3, 4, 5, 6], [2, 3])
+contains
+ subroutine expl3i(x)
+ integer, intent(in) :: x(3)
+ end subroutine
+ subroutine expl6i(x)
+ integer, intent(in) :: x(6)
+ end subroutine
+end module
+
+subroutine implied_shape()
+ use mimplied
+ call expl3i(ip1(2)) ! remaining 3: conforming
+ call expl3i(ip0(1)) ! remaining 3: conforming
+ call expl3i(ip2(1, 1)) ! remaining 5: conforming
+ !ERROR: Actual argument has fewer elements remaining in storage sequence (2) than dummy argument 'x=' array (3)
+ call expl3i(ip1(3))
+ !ERROR: Actual argument has fewer elements remaining in storage sequence (2) than dummy argument 'x=' array (3)
+ call expl3i(ip0(2))
+ !ERROR: Actual argument has fewer elements remaining in storage sequence (4) than dummy argument 'x=' array (6)
+ call expl6i(ip2(0, 2))
+end subroutine
>From 21eb81fbac3e0348ee2752a8684f5c2a8a2f65c1 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Tue, 22 Sep 2026 12:51:35 -0700
Subject: [PATCH 14/15] [flang] Run the actual argument copy analysis
regardless of copy-in mode
Whether a named constant actual argument needs a temporary is decided by
ActualArgNeedsCopy, which only needs the actual argument and the dummy
characteristics. Run it unconditionally instead of defaulting to a copy
in the contexts that disable the copy-in/copy-out machinery (defined
assignment lowering); only mustDoCopyIn/mustDoCopyOut stay gated on it.
No output change is expected: ordinary defined assignment never reaches
the parameter branch (the right-hand side is an expression and is not
retained), and where it is reached (OpenMP declare-reduction initializer
and combiner lowering, with a folded constant right-hand side) the
analysis gives the same copy-in answer the default gave.
Add a test documenting the defined assignment lowering with a named
constant right-hand side.
---
flang/lib/Lower/ConvertCall.cpp | 32 ++++-----
.../HLFIR/call-parameter-defined-assign.f90 | 70 +++++++++++++++++++
2 files changed, 85 insertions(+), 17 deletions(-)
create mode 100644 flang/test/Lower/HLFIR/call-parameter-defined-assign.f90
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 285cad7ae6553e..19c354b6e43ef2 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1390,26 +1390,24 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
passingPolymorphicToNonPolymorphic &&
(actual.isArray() || mlir::isa<fir::BaseBoxType>(dummyType));
+ // The copy analysis only needs the actual argument and the dummy
+ // characteristics, so it also drives the parameter-object temporary below
+ // in contexts that do not use the copy-in/copy-out machinery.
+ Fortran::evaluate::FoldingContext &foldingContext{
+ callContext.converter.getFoldingContext()};
+ const bool suggestCopyIn{
+ Fortran::evaluate::ActualArgNeedsCopy(arg.entity, arg.characteristics,
+ foldingContext,
+ /*forCopyOut=*/false)
+ .value_or(true)};
+ const bool suggestCopyOut{
+ Fortran::evaluate::ActualArgNeedsCopy(arg.entity, arg.characteristics,
+ foldingContext,
+ /*forCopyOut=*/true)
+ .value_or(true)};
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()};
-
- 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;
}
diff --git a/flang/test/Lower/HLFIR/call-parameter-defined-assign.f90 b/flang/test/Lower/HLFIR/call-parameter-defined-assign.f90
new file mode 100644
index 00000000000000..80d3674c9977f2
--- /dev/null
+++ b/flang/test/Lower/HLFIR/call-parameter-defined-assign.f90
@@ -0,0 +1,70 @@
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+! Defined assignment with a named-constant right-hand side. Assignment
+! operands are expressions, not procedure-reference arguments, so the named
+! constant arrives folded (an outlined constant) and the defined assignment
+! is lowered through hlfir.region_assign; the copy analysis that drives the
+! parameter-object temporary in ordinary calls sees nothing to copy here, and
+! no temporary is made inside the user_defined_assign region.
+
+module mda
+ implicit none
+ type t
+ integer :: val
+ end type
+ type(t), parameter :: cp = t(3)
+ type(t), parameter :: cpa(2) = [t(1), t(2)]
+ interface assignment(=)
+ module procedure custom_assign
+ module procedure custom_assign_array
+ end interface
+contains
+ subroutine custom_assign(lhs, rhs)
+ type(t), intent(out) :: lhs
+ type(t), intent(in) :: rhs
+ lhs%val = rhs%val * 10
+ end subroutine
+ subroutine custom_assign_array(lhs, rhs)
+ type(t), intent(out) :: lhs(:)
+ type(t), intent(in) :: rhs(:)
+ lhs%val = rhs%val * 10
+ end subroutine
+end module
+
+! CHECK-LABEL: func.func @_QPdefined_assign_scalar_parameter
+! CHECK: hlfir.region_assign {
+! CHECK: %[[RHS:.*]] = fir.address_of(@_QQro._QMmdaTt.0)
+! CHECK: %[[RHSD:.*]]:2 = hlfir.declare %[[RHS]] {fortran_attrs = #fir.var_attrs<parameter>
+! CHECK: hlfir.yield %[[RHSD]]#0
+! CHECK: } to {
+! CHECK: } user_defined_assign (%[[ARG0:.*]]: !fir.ref<!fir.type<_QMmdaTt{val:i32}>>) to (%[[ARG1:.*]]: !fir.ref<!fir.type<_QMmdaTt{val:i32}>>) {
+! CHECK-NOT: hlfir.as_expr
+! CHECK-NOT: hlfir.associate
+! CHECK: fir.call @_QMmdaPcustom_assign(%[[ARG1]], %[[ARG0]])
+subroutine defined_assign_scalar_parameter()
+ use mda
+ type(t) :: x
+ x = cp
+end subroutine
+
+! CHECK-LABEL: func.func @_QPdefined_assign_array_parameter
+! CHECK: hlfir.region_assign {
+! CHECK: %[[ARHS:.*]] = fir.address_of(@_QQro.2x_QMmdaTt.1)
+! CHECK: %[[ARHSD:.*]]:2 = hlfir.declare %[[ARHS]](%{{.*}}) {fortran_attrs = #fir.var_attrs<parameter>
+! CHECK: hlfir.yield %[[ARHSD]]#0
+! CHECK: } to {
+! CHECK: } user_defined_assign (%[[AARG0:.*]]: !fir.ref<!fir.array<2x!fir.type<_QMmdaTt{val:i32}>>>) to (%[[AARG1:.*]]: !fir.ref<!fir.array<2x!fir.type<_QMmdaTt{val:i32}>>>) {
+! CHECK-NOT: hlfir.as_expr
+! CHECK-NOT: hlfir.associate
+! CHECK: %[[LHSBOX:.*]] = fir.embox %[[AARG1]]
+! CHECK: %[[LHS:.*]] = fir.convert %[[LHSBOX]]
+! CHECK: %[[RHSBOX:.*]] = fir.embox %[[AARG0]]
+! CHECK: %[[RHS2:.*]] = fir.convert %[[RHSBOX]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK-NOT: hlfir.associate
+! CHECK: fir.call @_QMmdaPcustom_assign_array(%[[LHS]], %[[RHS2]])
+subroutine defined_assign_array_parameter()
+ use mda
+ type(t) :: y(2)
+ y = cpa
+end subroutine
>From 63701f89b53daea64203ae8c3fee108475ce8065 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Tue, 22 Sep 2026 12:51:39 -0700
Subject: [PATCH 15/15] [flang] Retain named constant array sections as actual
arguments too
Sections of a named constant with constant bounds were folded to values
and lowered as outlined read-only temporaries, so a call with such a
section did not refer to the constant's storage even though a section
with non-constant bounds did. Retain them like whole named constant
arrays and array elements: a contiguous section is passed directly, a
noncontiguous section keeps its descriptor for an assumed-shape dummy
and is copied into a temporary for an explicit-shape dummy (never copied
back), and vector-subscripted sections and components of sections go
through the ordinary value path. Intrinsic argument folding and the
semantic checks on sections are unchanged.
Update the sections lowering test for the new shapes (including an
omitted-bound section of an implied-shape constant, which now folds to a
static extent) and add section cases to the semantics test.
---
flang/lib/Semantics/expression.cpp | 9 +-
.../Lower/HLFIR/call-parameter-sections.f90 | 115 ++++++++++++++++--
.../Semantics/call-parameter-seq-assoc.f90 | 28 +++++
3 files changed, 136 insertions(+), 16 deletions(-)
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 4d62cdcb61c1a6..0733f3e17bc6ae 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -5961,9 +5961,12 @@ MaybeExpr ArgumentAnalyzer::AnalyzeExprOrWholeAssumedSizeArray(
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).
+ } else {
+ // Named-constant array element or section (or array component of a
+ // scalar named constant of derived type), e.g. a(1), a(1:3), a(2:*),
+ // pt%arr(1). A section with a vector subscript or a component of a
+ // section is retained too; those are not contiguous, and lowering
+ // copies them like any other actual argument that needs a copy.
if (const auto *ae{
parser::Unwrap<parser::ArrayElement>(designator->value())}) {
const auto &baseName{parser::GetFirstName(ae->Base())};
diff --git a/flang/test/Lower/HLFIR/call-parameter-sections.f90 b/flang/test/Lower/HLFIR/call-parameter-sections.f90
index 24611dcdd5e20b..967c4bafe30421 100644
--- a/flang/test/Lower/HLFIR/call-parameter-sections.f90
+++ b/flang/test/Lower/HLFIR/call-parameter-sections.f90
@@ -1,13 +1,21 @@
! 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.
+! Sections of named constants as actual arguments are associated with the
+! constant's storage like any other section: a contiguous section is passed
+! directly, a noncontiguous section keeps its descriptor (strides intact) for
+! an assumed-shape dummy and 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. Vector-subscripted sections and components
+! of sections are not contiguous and go through a temporary.
module ms
implicit none
integer, parameter :: sp(6) = [1, 2, 3, 4, 5, 6]
+ integer, parameter :: p0(0:*) = [1, 2, 3]
+ type t
+ integer :: arr(2)
+ end type
+ type(t), parameter :: pts(3) = [t([1, 2]), t([3, 4]), t([5, 6])]
contains
subroutine expl3(x)
integer, intent(in) :: x(3)
@@ -23,7 +31,7 @@ subroutine asmd(x)
! 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: %[[SEC:.*]] = hlfir.designate %[[AD]]#0 (%{{.*}}:%{{.*}}:%{{.*}}) shape %{{.*}} -> !fir.box<!fir.array<?xi32>>
! CHECK-NOT: hlfir.as_expr
! CHECK-NOT: hlfir.copy_in
! CHECK: fir.call @_QMmsPasmd(%[[SEC]])
@@ -40,7 +48,7 @@ subroutine dyn_section_assumed(i)
! 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: %[[BSEC:.*]] = hlfir.designate %[[BD]]#0 (%{{.*}}:%{{.*}}:%{{.*}}) shape
! CHECK: %[[BEXPR:.*]] = hlfir.as_expr %[[BSEC]]
! CHECK: %[[BTMP:.*]]:3 = hlfir.associate %[[BEXPR]]({{.*}}) {adapt.valuebyref}
! CHECK: fir.call @_QMmsPexpl3
@@ -52,16 +60,97 @@ subroutine dyn_section_explicit(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.
+! Contiguous section with constant bounds to an explicit-shape dummy: the
+! constant's storage is passed directly (no outlined constant, no copy).
+! CHECK-LABEL: func.func @_QPconst_contig_explicit
+! CHECK: %[[C:.*]] = fir.address_of(@_QMmsECsp)
+! CHECK: %[[CD:.*]]:2 = hlfir.declare %[[C]]
+! CHECK-NOT: _QQro
+! CHECK: %[[CSEC:.*]] = hlfir.designate %[[CD]]#0 (%{{.*}}:%{{.*}}:%c1{{.*}}) shape %{{.*}} -> !fir.ref<!fir.array<3xi32>>
+! CHECK-NOT: hlfir.as_expr
+! CHECK: fir.call @_QMmsPexpl3(%[[CSEC]])
+subroutine const_contig_explicit()
+ use ms
+ call expl3(sp(2:4))
+end subroutine
+
+! Strided section with constant bounds to an assumed-shape dummy: descriptor
+! over the constant's storage, no copy.
+! CHECK-LABEL: func.func @_QPconst_strided_assumed
+! CHECK: %[[S:.*]] = fir.address_of(@_QMmsECsp)
+! CHECK: %[[SD:.*]]:2 = hlfir.declare %[[S]]
+! CHECK-NOT: _QQro
+! CHECK: %[[SSEC:.*]] = hlfir.designate %[[SD]]#0 (%{{.*}}:%{{.*}}:%{{.*}}) shape %{{.*}} -> !fir.box<!fir.array<3xi32>>
+! CHECK-NOT: hlfir.as_expr
+! CHECK-NOT: hlfir.copy_in
+! CHECK: fir.call @_QMmsPasmd
+! CHECK-NOT: hlfir.copy_out
+subroutine const_strided_assumed()
+ use ms
+ call asmd(sp(1:6:2))
+end subroutine
+
+! Strided section with constant bounds to an explicit-shape dummy: copied
+! from the constant's storage into 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: %[[E:.*]] = fir.address_of(@_QMmsECsp)
+! CHECK: %[[ED:.*]]:2 = hlfir.declare %[[E]]
+! CHECK-NOT: _QQro
+! CHECK: %[[ESEC:.*]] = hlfir.designate %[[ED]]#0 (%{{.*}}:%{{.*}}:%{{.*}}) shape %{{.*}} -> !fir.box<!fir.array<3xi32>>
+! CHECK: %[[EEXPR:.*]] = hlfir.as_expr %[[ESEC]]
+! CHECK: %[[ETMP:.*]]:3 = hlfir.associate %[[EEXPR]]({{.*}}) {adapt.valuebyref}
+! CHECK: fir.call @_QMmsPexpl3(%[[ETMP]]#0)
! CHECK-NOT: hlfir.copy_out
-! CHECK: hlfir.end_associate
+! CHECK: hlfir.end_associate %[[ETMP]]#1, %[[ETMP]]#2
subroutine const_strided_explicit()
use ms
call expl3(sp(1:6:2))
end subroutine
+
+! Vector-subscripted section: the elements are gathered from the constant's
+! storage into a temporary (the outlined constant is the subscript vector).
+! CHECK-LABEL: func.func @_QPvector_subscript_explicit
+! CHECK: %[[V:.*]] = fir.address_of(@_QMmsECsp)
+! CHECK: %[[VD:.*]]:2 = hlfir.declare %[[V]]
+! CHECK: %[[VGATHER:.*]] = hlfir.elemental %{{.*}} unordered : (!fir.shape<1>) -> !hlfir.expr<3xi32>
+! CHECK: hlfir.designate %[[VD]]#0 (%{{.*}}) : (!fir.ref<!fir.array<6xi32>>, i64) -> !fir.ref<i32>
+! CHECK: %[[VTMP:.*]]:3 = hlfir.associate %[[VGATHER]]({{.*}}) {adapt.valuebyref}
+! CHECK: fir.call @_QMmsPexpl3(%[[VTMP]]#0)
+! CHECK-NOT: hlfir.copy_out
+! CHECK: hlfir.end_associate %[[VTMP]]#1, %[[VTMP]]#2
+subroutine vector_subscript_explicit()
+ use ms
+ call expl3(sp([1, 3, 5]))
+end subroutine
+
+! Component of a section of a derived-type named constant: noncontiguous,
+! so a temporary is made from the constant's storage; no copy-out.
+! CHECK-LABEL: func.func @_QPcomponent_of_section
+! CHECK: %[[P:.*]] = fir.address_of(@_QMmsECpts)
+! CHECK: %[[PD:.*]]:2 = hlfir.declare %[[P]]
+! CHECK: %[[PSEC:.*]] = hlfir.designate %[[PD]]#0 (%{{.*}}:%{{.*}}:%c1{{.*}}) shape %{{.*}} -> !fir.ref<!fir.array<3x!fir.type<_QMmsTt{arr:!fir.array<2xi32>}>>>
+! CHECK: %[[PCOMP:.*]] = hlfir.designate %[[PSEC]]{"arr"} <%{{.*}}> (%c1{{.*}}) shape %{{.*}} -> !fir.box<!fir.array<3xi32>>
+! CHECK: %[[PEXPR:.*]] = hlfir.as_expr %[[PCOMP]]
+! CHECK: %[[PTMP:.*]]:3 = hlfir.associate %[[PEXPR]]({{.*}}) {adapt.valuebyref}
+! CHECK: fir.call @_QMmsPexpl3(%[[PTMP]]#0)
+! CHECK-NOT: hlfir.copy_out
+! CHECK: hlfir.end_associate %[[PTMP]]#1, %[[PTMP]]#2
+subroutine component_of_section()
+ use ms
+ call expl3(pts(1:3)%arr(1))
+end subroutine
+
+! Omitted-bound section of an implied-shape named constant with a nondefault
+! lower bound: its bounds fold, so it is a contiguous section with a static
+! extent and the constant's storage is passed directly.
+! CHECK-LABEL: func.func @_QPimplied_omitted_bound
+! CHECK: %[[I:.*]] = fir.address_of(@_QMmsECp0)
+! CHECK: %[[ID:.*]]:2 = hlfir.declare %[[I]]
+! CHECK-NOT: _QQro
+! CHECK: %[[ISEC:.*]] = hlfir.designate %[[ID]]#0 (%c0{{.*}}:%{{.*}}:%c1{{.*}}) shape %{{.*}} -> !fir.ref<!fir.array<3xi32>>
+! CHECK-NOT: hlfir.as_expr
+! CHECK: fir.call @_QMmsPexpl3(%[[ISEC]])
+subroutine implied_omitted_bound()
+ use ms
+ call expl3(p0(:))
+end subroutine
diff --git a/flang/test/Semantics/call-parameter-seq-assoc.f90 b/flang/test/Semantics/call-parameter-seq-assoc.f90
index fa4ffc97ff0f0f..4e5d1b8802d2fd 100644
--- a/flang/test/Semantics/call-parameter-seq-assoc.f90
+++ b/flang/test/Semantics/call-parameter-seq-assoc.f90
@@ -184,3 +184,31 @@ subroutine implied_shape()
!ERROR: Actual argument has fewer elements remaining in storage sequence (4) than dummy argument 'x=' array (6)
call expl6i(ip2(0, 2))
end subroutine
+
+subroutine section_shapes()
+ ! Sections of named constants are retained too: the ordinary array checks
+ ! apply to them (element counts, definability), and a section passed to a
+ ! VALUE array dummy is a complete element sequence copied as a whole.
+ use m
+ interface
+ subroutine expl5(x)
+ integer, intent(in) :: x(5)
+ end subroutine
+ subroutine inout5(x)
+ integer, intent(inout) :: x(5)
+ end subroutine
+ subroutine byval2(x)
+ integer, value :: x(2)
+ end subroutine
+ end interface
+ integer, parameter :: gp10(10) = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
+ call expl5(gp10(1:5)) ! conforming
+ call expl5(gp10(6:10)) ! conforming (exactly 5)
+ call expl5(gp10(1:10:2)) ! conforming (5 elements, noncontiguous: copied)
+ call byval2(gp(1:2)) ! section to a VALUE array dummy: whole-section copy
+ !ERROR: Actual argument array has fewer elements (3) than dummy argument 'x=' array (5)
+ call expl5(gp10(8:10))
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+ !ERROR: 'gp10' is not a variable
+ call inout5(gp10(1:5))
+end subroutine
More information about the flang-commits
mailing list