[flang-commits] [flang] [flang] Associate named constant actual arguments with their storage (PR #222986)
Eugene Epshteyn via flang-commits
flang-commits at lists.llvm.org
Thu Sep 17 04:45:48 PDT 2026
https://github.com/eugeneepshteyn updated https://github.com/llvm/llvm-project/pull/222986
>From f16118737f145029de552849a426218ea5f56c20 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Fri, 11 Sep 2026 08:36:06 -0700
Subject: [PATCH 1/9] [flang] Associate named constant actual arguments with
their storage
A designator whose base is a named constant is not a variable, but it
still designates an object with storage. Give it the same copy-in
analysis as a variable instead of the blanket expression treatment:
whether a copy is needed for argument association is decided by
contiguity (physical contiguity, not the IS_CONTIGUOUS() presumption
for named-constant sections), and copy-out is never needed since a
named constant is not definable.
In lowering, make the parameter-object carve-out fire only when the
copy analysis suggests a copy: the temporary remains the right
mechanism when a copy is needed (the entity may be a raw address that
the runtime copy-in cannot take, and compiler-generated copy-out must
never target read-only storage), but when no copy is needed the named
constant's own storage is associated with the dummy argument.
In semantics, retain whole-array and array-element designators of
named constants for actual arguments of procedure references instead
of replacing them by their folded Constant values, so that lowering
sees the declared object rather than an outlined literal. This
implements sequence association for named-constant array elements
(F'2023 15.5.2.12) and makes address-based lookups (e.g. OpenACC
present checks against a module variable registered by declare
copyin) see the declared storage. A parenthesized designator is a
primary (F'2023 R1001) and keeps its folded value. Once a call
resolves to an intrinsic procedure, retained designators are folded
back to their values (intrinsic argument checking inspects constant
values structurally, and the storage identity of a named constant is
irrelevant to an intrinsic procedure).
---
flang/lib/Evaluate/check-expression.cpp | 23 +++-
flang/lib/Evaluate/intrinsics.cpp | 16 +++
flang/lib/Lower/ConvertCall.cpp | 39 +++---
flang/lib/Semantics/expression.cpp | 66 +++++++++-
.../Lower/HLFIR/call-parameter-array-arg.f90 | 114 ++++++++++++++++++
.../Lower/HLFIR/calls-constant-expr-arg.f90 | 13 +-
flang/test/Lower/Intrinsics/ieee_flag.f90 | 44 +++----
flang/test/Lower/call-by-value-attr.f90 | 2 +-
8 files changed, 262 insertions(+), 55 deletions(-)
create mode 100644 flang/test/Lower/HLFIR/call-parameter-array-arg.f90
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 6e4ea495c6ab8..c13e0fef46957 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -1657,8 +1657,21 @@ std::optional<bool> ActualArgNeedsCopy(const ActualArgument *actual,
: nullptr};
const bool forCopyIn{!forCopyOut};
if (!evaluate::IsVariable(*actual)) {
- // Expressions are copy-in, but not copy-out.
- return forCopyIn;
+ // A designator whose base object is a named constant is not a variable,
+ // but it still designates an object with storage. It never needs
+ // copy-out, since a named constant is not definable; whether it needs
+ // copy-in depends on its contiguity, like a variable, so fall through
+ // to the analysis below. Other expressions are copy-in, but not
+ // copy-out.
+ const auto dataRef{ExtractDataRef(
+ *actual, /*intoSubstring=*/true, /*intoComplexPart=*/true)};
+ if (!dataRef ||
+ !semantics::IsNamedConstant(dataRef->GetFirstSymbol().GetUltimate())) {
+ return forCopyIn;
+ }
+ if (forCopyOut) {
+ return false;
+ }
}
if (forCopyOut) {
// F2023 8.5.10 C846/p2/p6: a nonpointer INTENT(IN) dummy and its
@@ -1675,7 +1688,11 @@ std::optional<bool> ActualArgNeedsCopy(const ActualArgument *actual,
}
}
}
- auto maybeContigActual{IsContiguous(*actual, fc)};
+ // Copy decisions depend on the actual argument's physical contiguity,
+ // so do not let sections of named constants be presumed contiguous here
+ // (they are for IS_CONTIGUOUS(), but their storage is what it is).
+ auto maybeContigActual{
+ IsContiguous(*actual, fc, /*namedConstantSectionsAreContiguous=*/false)};
if (dummyObj) { // Explict interface
CopyInOutExplicitInterface check{fc, *actual, *dummyObj};
if (forCopyOut && check.HasIntentIn()) {
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 88874f7ef08e8..4b0d493959ec9 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -3962,6 +3962,22 @@ static bool CheckAtomicDefineAndRef(FoldingContext &context,
// Applies any semantic checks peculiar to an intrinsic.
// TODO: Move the rest of these checks to Semantics/check-call.cpp.
static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
+ // Actual arguments may have been retained in named-constant designator
+ // form for the benefit of nonintrinsic calls (storage association); the
+ // checks below inspect constant values structurally, so fold such
+ // arguments back to their values first.
+ for (auto &arg : call.arguments) {
+ if (arg && !arg->isAlternateReturn()) {
+ if (Expr<SomeType> * expr{arg->UnwrapExpr()}) {
+ if (auto dataRef{ExtractDataRef(
+ *expr, /*intoSubstring=*/true, /*intoComplexPart=*/true)};
+ dataRef &&
+ IsNamedConstant(dataRef->GetFirstSymbol().GetUltimate())) {
+ *expr = Fold(context, std::move(*expr));
+ }
+ }
+ }
+ }
bool ok{true};
const std::string &name{call.specificIntrinsic.name};
if (name == "allocated") {
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 19678e429249b..13fbc94ad4278 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1387,19 +1387,24 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
bool mustDoCopyIn{false};
bool mustDoCopyOut{false};
+ // Default to suggesting a copy when the copy analysis does not run, so
+ // that the parameter-object temporary below stays conservative in
+ // contexts that disable the analysis.
+ bool suggestCopyIn{true};
+ bool suggestCopyOut{true};
if (callContext.doCopyIn) {
Fortran::evaluate::FoldingContext &foldingContext{
callContext.converter.getFoldingContext()};
- bool suggestCopyIn = Fortran::evaluate::ActualArgNeedsCopy(
- arg.entity, arg.characteristics, foldingContext,
- /*forCopyOut=*/false)
- .value_or(true);
- bool suggestCopyOut = Fortran::evaluate::ActualArgNeedsCopy(
- arg.entity, arg.characteristics, foldingContext,
- /*forCopyOut=*/true)
- .value_or(true);
+ suggestCopyIn = Fortran::evaluate::ActualArgNeedsCopy(
+ arg.entity, arg.characteristics, foldingContext,
+ /*forCopyOut=*/false)
+ .value_or(true);
+ suggestCopyOut = Fortran::evaluate::ActualArgNeedsCopy(
+ arg.entity, arg.characteristics, foldingContext,
+ /*forCopyOut=*/true)
+ .value_or(true);
mustDoCopyIn = actual.isArray() && suggestCopyIn;
mustDoCopyOut = actual.isArray() && suggestCopyOut;
}
@@ -1496,13 +1501,17 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
if (mustSetDynamicTypeToDummyType)
entity = genSetDynamicTypeToDummyType(entity);
if (arg.hasValueAttribute() ||
- // Constant expressions might be lowered as variables with
- // 'parameter' attribute. Even though the constant expressions
- // are not definable and explicit assignments to them are not
- // possible, we have to create a temporary copies when we pass
- // them down the call stack because of potential compiler
- // generated writes in copy-out.
- isParameterObjectOrSubObject(entity)) {
+ // Named constants and constant expressions might be lowered as
+ // variables with the 'parameter' attribute. Whether a copy is
+ // needed for argument association is decided by the copy-in/copy-out
+ // analysis like for any other object; but when a copy is needed, it
+ // must be made via a temporary rather than via the runtime copy-in
+ // machinery below, both because the entity may be a raw address
+ // (genCopyIn requires a descriptor) and because compiler-generated
+ // copy-out must never target the read-only storage of a
+ // non-definable actual argument.
+ (isParameterObjectOrSubObject(entity) &&
+ (suggestCopyIn || suggestCopyOut))) {
// Make a copy in a temporary.
auto copy = hlfir::AsExprOp::create(builder, loc, entity);
mlir::Type storageType = entity.getType();
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 0a73c108094d0..8b67b4318bcef 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -45,6 +45,8 @@ using common::LanguageFeature;
using common::NumericOperator;
using common::TypeCategory;
+static void FoldNamedConstantActuals(FoldingContext &, ActualArguments &);
+
static inline std::string ToUpperCase(std::string_view str) {
return parser::ToUpperCaseLetters(str);
}
@@ -3480,6 +3482,7 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
CallCharacteristics{name.source.ToString(), isSubroutine},
localArguments, GetFoldingContext())}) {
CheckBadExplicitType(*specificCall, *symbol);
+ FoldNamedConstantActuals(GetFoldingContext(), specificCall->arguments);
return CalleeAndArguments{
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
std::move(specificCall->arguments)};
@@ -3510,6 +3513,7 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
CallCharacteristics{name.ToString(), isSubroutine}, arguments,
GetFoldingContext())}) {
CheckBadExplicitType(*specificCall, *symbol);
+ FoldNamedConstantActuals(GetFoldingContext(), specificCall->arguments);
return CalleeAndArguments{
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
std::move(specificCall->arguments)};
@@ -4925,11 +4929,34 @@ MaybeExpr ExpressionAnalyzer::MakeFunctionRef(parser::CharBlock callSite,
return std::nullopt;
}
+// Fold actual arguments that were retained in named-constant designator form
+// (see ArgumentAnalyzer::AnalyzeExprOrWholeAssumedSizeArray) once the callee
+// has resolved to an intrinsic procedure. Intrinsic argument checking and
+// intrinsic folding inspect constant values structurally, and the storage
+// identity of a named constant is irrelevant to an intrinsic procedure.
+static void FoldNamedConstantActuals(
+ FoldingContext &context, ActualArguments &arguments) {
+ for (auto &arg : arguments) {
+ if (arg && !arg->isAlternateReturn()) {
+ if (Expr<SomeType> * expr{arg->UnwrapExpr()}) {
+ if (auto dataRef{ExtractDataRef(
+ *expr, /*intoSubstring=*/true, /*intoComplexPart=*/true)};
+ dataRef &&
+ semantics::IsNamedConstant(
+ dataRef->GetFirstSymbol().GetUltimate())) {
+ *expr = Fold(context, std::move(*expr));
+ }
+ }
+ }
+ }
+}
+
MaybeExpr ExpressionAnalyzer::MakeFunctionRef(
parser::CharBlock intrinsic, ActualArguments &&arguments) {
if (std::optional<SpecificCall> specificCall{
context_.intrinsics().Probe(CallCharacteristics{intrinsic.ToString()},
arguments, GetFoldingContext())}) {
+ FoldNamedConstantActuals(GetFoldingContext(), specificCall->arguments);
return MakeFunctionRef(intrinsic,
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
std::move(specificCall->arguments));
@@ -5856,7 +5883,44 @@ MaybeExpr ArgumentAnalyzer::AnalyzeExprOrWholeAssumedSizeArray(
}
}
auto restorer{context_.AllowNullPointer()};
- return context_.Analyze(expr);
+ MaybeExpr result{context_.Analyze(expr)};
+ // For actual arguments of procedure references, retain a designator whose
+ // base is a named constant in designator form instead of replacing it by
+ // its folded Constant value, so that lowering associates the dummy argument
+ // with the named constant's storage. This matters for sequence association
+ // of an array element actual argument (F'2023 15.5.2.12) and whenever the
+ // dummy's address is meaningful (e.g. OpenACC/OpenMP present checks).
+ // The inner Analyze calls below do not apply the outer folding performed
+ // by Analyze(parser::Expr), and folding still sees through the retained
+ // designator wherever a constant value is needed later.
+ if (isProcedureCall_ && result) {
+ // Look only at an expression that is itself a designator: a
+ // parenthesized designator is a primary, i.e. an expression
+ // (F'2023 R1001), and must keep its folded value.
+ if (const auto *designator{
+ std::get_if<common::Indirection<parser::Designator>>(&expr.u)}) {
+ if (const auto *name{parser::Unwrap<parser::Name>(designator->value())}) {
+ // Whole named-constant array.
+ if (name->symbol &&
+ semantics::IsNamedConstant(name->symbol->GetUltimate()) &&
+ name->symbol->Rank() > 0) {
+ return context_.Analyze(*name);
+ }
+ } else if (result->Rank() == 0) {
+ // Named-constant array element (or array component of a scalar
+ // named constant of derived type), e.g. a(1) or pt%arr(1).
+ if (const auto *ae{
+ parser::Unwrap<parser::ArrayElement>(designator->value())}) {
+ const auto &baseName{parser::GetFirstName(ae->Base())};
+ if (baseName.symbol &&
+ semantics::IsNamedConstant(baseName.symbol->GetUltimate())) {
+ return context_.Analyze(*ae);
+ }
+ }
+ }
+ }
+ }
+ return result;
}
bool ArgumentAnalyzer::AreConformable() const {
diff --git a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90 b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
new file mode 100644
index 0000000000000..8491392cfe27c
--- /dev/null
+++ b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
@@ -0,0 +1,114 @@
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+! Test that named constant (PARAMETER) array actual arguments are associated
+! with the named constant's storage instead of a temporary copy, when no copy
+! is required for argument association (F'2023 15.5.2.12). A copy is still
+! made whenever argument association requires one (non-contiguous actual,
+! polymorphic dummy, VALUE dummy, or a true constant expression).
+
+module m
+ implicit none
+ integer, parameter :: gp(4) = [1, 2, 3, 4]
+contains
+ subroutine expl(x)
+ integer, intent(in) :: x(4)
+ end subroutine
+ subroutine asmd(x)
+ integer, intent(in) :: x(:)
+ end subroutine
+ subroutine poly(x)
+ class(*), intent(in) :: x(:)
+ end subroutine
+ subroutine byval(x)
+ integer, value :: x(4)
+ end subroutine
+end module
+
+! Whole named-constant array to an explicit-shape dummy: the address of the
+! named constant's global is passed directly; no temporary, no copy-in.
+! CHECK-LABEL: func.func @_QPwhole_explicit_shape
+! CHECK: %[[ADDR:.*]] = fir.address_of(@_QMmECgp) : !fir.ref<!fir.array<4xi32>>
+! CHECK: %[[DECL:.*]]:2 = hlfir.declare %[[ADDR]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK-NOT: hlfir.copy_in
+! CHECK: fir.call @_QMmPexpl(%[[DECL]]#0
+subroutine whole_explicit_shape()
+ use m
+ call expl(gp)
+end subroutine
+
+! Whole named-constant array to an assumed-shape dummy: a descriptor over the
+! named constant's storage; still no temporary.
+! CHECK-LABEL: func.func @_QPwhole_assumed_shape
+! CHECK: %[[ADDR:.*]] = fir.address_of(@_QMmECgp)
+! CHECK: %[[DECL:.*]]:2 = hlfir.declare %[[ADDR]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[BOX:.*]] = fir.embox %[[DECL]]#0
+! CHECK-NOT: hlfir.as_expr
+! CHECK: fir.call @_QMmPasmd
+subroutine whole_assumed_shape()
+ use m
+ call asmd(gp)
+end subroutine
+
+! Named-constant array element to an explicit-shape dummy (sequence
+! association): the element's address is passed; no scalar temporary.
+! CHECK-LABEL: func.func @_QPelement_seq_assoc
+! CHECK: %[[EADDR:.*]] = fir.address_of(@_QMmECgp)
+! CHECK: %[[EDECL:.*]]:2 = hlfir.declare %[[EADDR]]
+! CHECK: %[[ELT:.*]] = hlfir.designate %[[EDECL]]#0 (%{{.*}}) : (!fir.ref<!fir.array<4xi32>>, i64) -> !fir.ref<i32>
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[ECAST:.*]] = fir.convert %[[ELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<4xi32>>
+! CHECK: fir.call @_QMmPexpl(%[[ECAST]])
+subroutine element_seq_assoc()
+ use m
+ call expl(gp(2))
+end subroutine
+
+! Polymorphic assumed-shape dummy: no contiguity requirement, so no copy is
+! needed (same as for a variable actual argument); the descriptor is built
+! over the named constant's storage.
+! CHECK-LABEL: func.func @_QPpoly_dummy
+! CHECK: %[[PADDR:.*]] = fir.address_of(@_QMmECgp)
+! CHECK: %[[PDECL:.*]]:2 = hlfir.declare %[[PADDR]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[PBOX:.*]] = fir.embox %[[PDECL]]#0
+! CHECK: %[[PCLS:.*]] = fir.rebox %[[PBOX]] : (!fir.box<!fir.array<4xi32>>) -> !fir.class<!fir.array<?xnone>>
+! CHECK: fir.call @_QMmPpoly(%[[PCLS]]
+subroutine poly_dummy()
+ use m
+ call poly(gp)
+end subroutine
+
+! A parenthesized named constant is a constant expression, not a designator
+! (a parenthesized designator is a primary, R1001): it is still materialized
+! into a temporary.
+! CHECK-LABEL: func.func @_QPparen_expr
+! CHECK: fir.address_of(@_QQro.4xi4.0)
+! CHECK: %[[PAREN_TMP:.*]]:3 = hlfir.associate {{.*}} {adapt.valuebyref}
+! CHECK: fir.call @_QMmPexpl(%[[PAREN_TMP]]#0
+subroutine paren_expr()
+ use m
+ call expl((gp))
+end subroutine
+
+! VALUE dummy: always a copy.
+! CHECK-LABEL: func.func @_QPvalue_dummy
+! CHECK: hlfir.as_expr
+! CHECK: fir.call @_QMmPbyval
+subroutine value_dummy()
+ use m
+ call byval(gp)
+end subroutine
+
+! Implicit interface: the whole named-constant array's address is passed
+! directly (known contiguous).
+! CHECK-LABEL: func.func @_QPimplicit_iface
+! CHECK: fir.address_of(@_QMmECgp)
+! CHECK-NOT: hlfir.as_expr
+! CHECK: fir.call @_QPext_sub
+subroutine implicit_iface()
+ use m
+ external :: ext_sub
+ call ext_sub(gp)
+end subroutine
diff --git a/flang/test/Lower/HLFIR/calls-constant-expr-arg.f90 b/flang/test/Lower/HLFIR/calls-constant-expr-arg.f90
index 2186bda79a46f..b6a19bd013c97 100644
--- a/flang/test/Lower/HLFIR/calls-constant-expr-arg.f90
+++ b/flang/test/Lower/HLFIR/calls-constant-expr-arg.f90
@@ -84,9 +84,10 @@ subroutine foo(x)
! CHECK: %[[VAL_19:.*]]:2 = hlfir.declare %[[VAL_18]] {{.*}}
! CHECK: %[[VAL_25:.*]] = hlfir.designate %[[VAL_19]]#0 {{.*}}
! CHECK: %[[VAL_26:.*]]:2 = hlfir.declare %[[VAL_25]] {uniq_name = "_QFtest_associateEb"} : (!fir.box<!fir.array<1xf32>>) -> (!fir.box<!fir.array<1xf32>>, !fir.box<!fir.array<1xf32>>)
-! CHECK: %[[VAL_27:.*]] = hlfir.as_expr %[[VAL_26]]#0 : (!fir.box<!fir.array<1xf32>>) -> !hlfir.expr<1xf32>
-! CHECK: %[[VAL_30:.*]]:3 = hlfir.associate %[[VAL_27]]({{.*}}) {adapt.valuebyref} : (!hlfir.expr<1xf32>, !fir.shape<1>) -> (!fir.ref<!fir.array<1xf32>>, !fir.ref<!fir.array<1xf32>>, i1)
-! CHECK: %[[VAL_31:.*]] = fir.embox %[[VAL_30]]
-! CHECK: %[[VAL_32:.*]] = fir.convert %[[VAL_31]] : (!fir.box<!fir.array<1xf32>>) -> !fir.box<!fir.array<?xf32>>
-! CHECK: fir.call @_QPfoo(%[[VAL_32]]) {{.*}} : (!fir.box<!fir.array<?xf32>>) -> ()
-! CHECK: hlfir.end_associate %[[VAL_30]]#1, %[[VAL_30]]#2 : !fir.ref<!fir.array<1xf32>>, i1
+! No copy: the dummy argument is assumed shape, so the (possibly discontiguous)
+! descriptor over the named constant's storage is passed directly, and there is
+! no copy-out because the actual argument is not definable.
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_26]]#0 : (!fir.box<!fir.array<1xf32>>) -> !fir.box<!fir.array<?xf32>>
+! CHECK: fir.call @_QPfoo(%[[VAL_27]]) {{.*}} : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK-NOT: hlfir.copy_out
diff --git a/flang/test/Lower/Intrinsics/ieee_flag.f90 b/flang/test/Lower/Intrinsics/ieee_flag.f90
index acf3fedae4181..12b04879656e5 100644
--- a/flang/test/Lower/Intrinsics/ieee_flag.f90
+++ b/flang/test/Lower/Intrinsics/ieee_flag.f90
@@ -157,10 +157,8 @@
! CHECK: %[[V_158:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
print*, '[overflow[T], invalid[F]]: ', v2
- ! CHECK: %[[V_165:[0-9]+]] = fir.address_of(@_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4) : !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
- ! CHECK: %[[V_166:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_166]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.convert %[[V_312]] : (i8) -> i32
@@ -173,9 +171,8 @@
! CHECK: }
call ieee_set_flag(ieee_usual, .true.)
- ! CHECK: %[[V_167:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_167]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_64]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
@@ -191,11 +188,10 @@
! CHECK: %[[V_168:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
print*, '[overflow[T], divide_by_zero[T], invalid[T]]: ', v_usual
- ! CHECK: %[[V_178:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
- ! CHECK: %[[V_179:[0-9]+]] = fir.address_of(@_QQro.3xl4.5) : !fir.ref<!fir.array<3x!fir.logical<4>>>
- ! CHECK: %[[V_180:[0-9]+]] = fir.declare %[[V_179]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3xl4.5"} : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.logical<4>>>
+ ! CHECK: %[[V_179:[0-9]+]] = fir.address_of(@_QQro.3xl4.4) : !fir.ref<!fir.array<3x!fir.logical<4>>>
+ ! CHECK: %[[V_180:[0-9]+]] = fir.declare %[[V_179]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3xl4.4"} : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.logical<4>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_178]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_180]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<!fir.logical<4>>
! CHECK: %[[V_313:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
@@ -211,9 +207,8 @@
! CHECK: }
call ieee_set_flag(ieee_usual, [.true., .false., .true.])
- ! CHECK: %[[V_181:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_181]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_64]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
@@ -229,10 +224,8 @@
! CHECK: %[[V_182:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
print*, '[overflow[T], divide_by_zero[F], invalid[T]]: ', v_usual
- ! CHECK: %[[V_189:[0-9]+]] = fir.address_of(@_QQro.5x_QM__fortran_builtinsT__builtin_ieee_flag_type.6) : !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
- ! CHECK: %[[V_190:[0-9]+]] = fir.declare %[[V_189]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_builtinsT__builtin_ieee_flag_type.6"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_190]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_2]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.convert %[[V_312]] : (i8) -> i32
@@ -245,9 +238,8 @@
! CHECK: }
call ieee_set_flag(ieee_all, .false.)
- ! CHECK: %[[V_191:[0-9]+]] = fir.declare %[[V_189]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_builtinsT__builtin_ieee_flag_type.6"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_191]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_2]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
@@ -399,9 +391,8 @@
! CHECK: %[[V_277:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
print*, '[overflow[T], invalid[F]]: ', v2
- ! CHECK: %[[V_283:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_283]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.convert %[[V_312]] : (i8) -> i32
@@ -414,9 +405,8 @@
! CHECK: }
call ieee_set_halting_mode(ieee_usual, .true.)
- ! CHECK: %[[V_284:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_284]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_64]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
@@ -433,10 +423,9 @@
! CHECK: %[[V_285:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
print*, '[overflow[T], divide_by_zero[T], invalid[T]]: ', v_usual
- ! CHECK: %[[V_291:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
- ! CHECK: %[[V_292:[0-9]+]] = fir.declare %[[V_179]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3xl4.5"} : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.logical<4>>>
+ ! CHECK: %[[V_292:[0-9]+]] = fir.declare %[[V_179]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3xl4.4"} : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.logical<4>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_291]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_292]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<!fir.logical<4>>
! CHECK: %[[V_313:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
@@ -452,9 +441,8 @@
! CHECK: }
call ieee_set_halting_mode(ieee_usual, [.true., .false., .true.])
- ! CHECK: %[[V_293:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_293]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_55]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_64]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
@@ -471,9 +459,8 @@
! CHECK: %[[V_294:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
print*, '[overflow[T], divide_by_zero[F], invalid[T]]: ', v_usual
- ! CHECK: %[[V_300:[0-9]+]] = fir.declare %[[V_189]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_builtinsT__builtin_ieee_flag_type.6"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_300]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_2]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.convert %[[V_312]] : (i8) -> i32
@@ -486,9 +473,8 @@
! CHECK: }
call ieee_set_halting_mode(ieee_all, .true.)
- ! CHECK: %[[V_301:[0-9]+]] = fir.declare %[[V_189]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_builtinsT__builtin_ieee_flag_type.6"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>
! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
- ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_301]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_2]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], _QM__fortran_builtinsT__builtin_ieee_flag_type.flag : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>) -> !fir.ref<i8>
! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
diff --git a/flang/test/Lower/call-by-value-attr.f90 b/flang/test/Lower/call-by-value-attr.f90
index 9b9076722828e..e28d1ee1baa56 100644
--- a/flang/test/Lower/call-by-value-attr.f90
+++ b/flang/test/Lower/call-by-value-attr.f90
@@ -61,7 +61,7 @@ subroutine takes_array_value(v)
end interface
integer, parameter :: p(100) = 42
call takes_array_value(p)
- ! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare {{.*}}"_QQro.100xi4.2"
+ ! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare {{.*}}"_QFtest_litteral_copies_1ECp"
! CHECK: %[[VAL_8:.*]] = hlfir.as_expr %[[VAL_7]]#0 : (!fir.ref<!fir.array<100xi32>>) -> !hlfir.expr<100xi32>
! CHECK: %[[VAL_9:.*]]:3 = hlfir.associate %[[VAL_8]](%{{.*}}) {adapt.valuebyref} : (!hlfir.expr<100xi32>, !fir.shape<1>) -> (!fir.ref<!fir.array<100xi32>>, !fir.ref<!fir.array<100xi32>>, i1)
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]]#0 : (!fir.ref<!fir.array<100xi32>>) -> !fir.ref<!fir.array<4xi32>>
>From 059af6ff7db33da2f051854b905aff0f00c5b6f8 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Fri, 11 Sep 2026 10:00:11 -0700
Subject: [PATCH 2/9] [flang] Test named constants of derived type as actual
arguments
Add derived-type coverage to the named-constant actual argument test:
whole constant array to explicit-shape and assumed-shape dummies and an
element of a constant array (all associated directly with the named
constant's storage), an array-component element of a scalar named
constant passed to an array dummy (sequence association), and the two
shapes that keep the temporary-copy behavior (a whole scalar named
constant and a whole array component of a scalar named constant).
---
.../Lower/HLFIR/call-parameter-array-arg.f90 | 93 +++++++++++++++++++
1 file changed, 93 insertions(+)
diff --git a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90 b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
index 8491392cfe27c..281b3b7b1d1ae 100644
--- a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
+++ b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
@@ -112,3 +112,96 @@ subroutine implicit_iface()
external :: ext_sub
call ext_sub(gp)
end subroutine
+
+! ---- Named constants of derived type ----
+
+module md
+ implicit none
+ type :: t
+ integer :: k
+ integer :: a(3)
+ end type
+ type(t), parameter :: ds = t(7, [1, 2, 3])
+ type(t), parameter :: dc(2) = [t(1, [1, 2, 3]), t(2, [4, 5, 6])]
+contains
+ subroutine dt_scalar(x)
+ type(t), intent(in) :: x
+ end subroutine
+ subroutine dt_array(x)
+ type(t), intent(in) :: x(2)
+ end subroutine
+ subroutine dt_assumed(x)
+ type(t), intent(in) :: x(:)
+ end subroutine
+ subroutine int_array(x)
+ integer, intent(in) :: x(3)
+ end subroutine
+end module
+
+! Whole derived-type named-constant array to an explicit-shape dummy: direct.
+! CHECK-LABEL: func.func @_QPderived_whole_array
+! CHECK: %[[DA:.*]] = fir.address_of(@_QMmdECdc)
+! CHECK: %[[DAD:.*]]:2 = hlfir.declare %[[DA]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK: fir.call @_QMmdPdt_array(%[[DAD]]#0
+subroutine derived_whole_array()
+ use md
+ call dt_array(dc)
+end subroutine
+
+! Whole derived-type named-constant array to an assumed-shape dummy: a
+! descriptor over the named constant's storage.
+! CHECK-LABEL: func.func @_QPderived_assumed_shape
+! CHECK: %[[DB:.*]] = fir.address_of(@_QMmdECdc)
+! CHECK: %[[DBD:.*]]:2 = hlfir.declare %[[DB]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[DBOX:.*]] = fir.embox %[[DBD]]#0
+! CHECK-NOT: hlfir.as_expr
+! CHECK: fir.call @_QMmdPdt_assumed
+subroutine derived_assumed_shape()
+ use md
+ call dt_assumed(dc)
+end subroutine
+
+! Element of a derived-type named-constant array to a scalar dummy: the
+! element's address is passed.
+! CHECK-LABEL: func.func @_QPderived_array_element
+! CHECK: %[[DC:.*]] = fir.address_of(@_QMmdECdc)
+! CHECK: %[[DCD:.*]]:2 = hlfir.declare %[[DC]]
+! CHECK: %[[DELT:.*]] = hlfir.designate %[[DCD]]#0 (%{{.*}})
+! CHECK-NOT: hlfir.as_expr
+! CHECK: fir.call @_QMmdPdt_scalar(%[[DELT]])
+subroutine derived_array_element()
+ use md
+ call dt_scalar(dc(2))
+end subroutine
+
+! Array-component element of a scalar derived-type named constant, passed to
+! an array dummy (sequence association): the element's address is passed.
+! CHECK-LABEL: func.func @_QPderived_component_element
+! CHECK: %[[DS:.*]] = fir.address_of(@_QMmdECds)
+! CHECK: %[[DSD:.*]]:2 = hlfir.declare %[[DS]]
+! CHECK: %[[DCELT:.*]] = hlfir.designate %[[DSD]]#0{"a"} <%{{.*}}> (%c1{{.*}}) : {{.*}} -> !fir.ref<i32>
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[DCAST:.*]] = fir.convert %[[DCELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<3xi32>>
+! CHECK: fir.call @_QMmdPint_array(%[[DCAST]])
+subroutine derived_component_element()
+ use md
+ call int_array(ds%a(1))
+end subroutine
+
+! A whole SCALAR derived-type named constant and a whole array COMPONENT of a
+! scalar named constant are not (yet) retained in designator form: they keep
+! the temporary-copy behavior.
+! CHECK-LABEL: func.func @_QPderived_scalar_and_component
+! CHECK: hlfir.as_expr
+! CHECK: hlfir.associate {{.*}} {adapt.valuebyref}
+! CHECK: fir.call @_QMmdPdt_scalar
+! CHECK: hlfir.as_expr
+! CHECK: hlfir.associate {{.*}} {adapt.valuebyref}
+! CHECK: fir.call @_QMmdPint_array
+subroutine derived_scalar_and_component()
+ use md
+ call dt_scalar(ds)
+ call int_array(ds%a)
+end subroutine
>From c5b2e0305ae5efdebfa3cd950ac26caa880931b4 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Tue, 15 Sep 2026 09:16:36 -0700
Subject: [PATCH 3/9] [flang] Fold retained named-constant actuals when a call
resolves to an intrinsic
Replace the per-site folding of retained named-constant designators with a
single presence-gated fold at IntrinsicProcTable::Probe entry: when an actual
argument retains a named-constant designator, probe with a folded copy, so
that intrinsic matching, argument checking, and the special handlers all see
constant values, while a failed probe leaves the caller's original arguments
untouched for subsequent nonintrinsic resolution. This also covers checks
that ran before the previous per-site folds (e.g. the DIM= range checks and
the special handlers), which could otherwise silently skip diagnostics.
The PowerPC vector intrinsics are resolved as module procedures, not through
Probe, and both their semantic checks and PowerPC lowering require constant
values; fold at the point where the call commits to the __ppc_ resolution.
Also diagnose, rather than CHECK(), a constant expression whose value is not
statically known in CheckArgumentIsConstantExprInRange, as defense in depth.
The folding helpers are exported from Evaluate (AnyNamedConstantActualArguments,
FoldNamedConstantActualArguments) next to ActualArgNeedsCopy.
---
.../include/flang/Evaluate/check-expression.h | 9 +++++
flang/lib/Evaluate/check-expression.cpp | 34 +++++++++++++++++
flang/lib/Evaluate/intrinsics.cpp | 32 ++++++++--------
flang/lib/Semantics/expression.cpp | 37 +++++--------------
.../PowerPC/ppc-vec-shift-parameter.f90 | 21 +++++++++++
.../PowerPC/ppc-vector-intrinsics.f90 | 9 +++++
6 files changed, 98 insertions(+), 44 deletions(-)
create mode 100644 flang/test/Integration/PowerPC/ppc-vec-shift-parameter.f90
diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h
index c837a7d72e8b1..2b8cb4ea457eb 100644
--- a/flang/include/flang/Evaluate/check-expression.h
+++ b/flang/include/flang/Evaluate/check-expression.h
@@ -177,6 +177,15 @@ extern template bool IsErrorExpr(const Expr<SomeType> &);
std::optional<parser::Message> CheckStatementFunction(
const Symbol &, const Expr<SomeType> &, FoldingContext &);
+// Actual arguments of procedure references may retain designators of named
+// constants (rather than their folded values) so that lowering can associate
+// dummy arguments with the named constant's storage. Intrinsic argument
+// matching, checking, and folding inspect constant values structurally, so
+// such arguments must be folded back to values once a call is known to
+// resolve to an intrinsic procedure.
+bool AnyNamedConstantActualArguments(const ActualArguments &);
+void FoldNamedConstantActualArguments(FoldingContext &, ActualArguments &);
+
std::optional<bool> ActualArgNeedsCopy(const ActualArgument *,
const characteristics::DummyArgument *, FoldingContext &, bool forCopyOut);
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index c13e0fef46957..0f24689cf79de 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -1643,6 +1643,40 @@ class CopyInOutExplicitInterface {
// perspective, meaning that for copy-in the caller need to do the copy
// before calling the callee. Similarly, for copy-out the caller is expected
// to do the copy after the callee returns.
+static bool IsNamedConstantDesignator(const Expr<SomeType> &expr) {
+ if (auto dataRef{ExtractDataRef(
+ expr, /*intoSubstring=*/true, /*intoComplexPart=*/true)}) {
+ return semantics::IsNamedConstant(dataRef->GetFirstSymbol().GetUltimate());
+ }
+ return false;
+}
+
+bool AnyNamedConstantActualArguments(const ActualArguments &arguments) {
+ for (const auto &arg : arguments) {
+ if (arg && !arg->isAlternateReturn()) {
+ if (const Expr<SomeType> *expr{arg->UnwrapExpr()}) {
+ if (IsNamedConstantDesignator(*expr)) {
+ return true;
+ }
+ }
+ }
+ }
+ return false;
+}
+
+void FoldNamedConstantActualArguments(
+ FoldingContext &context, ActualArguments &arguments) {
+ for (auto &arg : arguments) {
+ if (arg && !arg->isAlternateReturn()) {
+ if (Expr<SomeType> * expr{arg->UnwrapExpr()}) {
+ if (IsNamedConstantDesignator(*expr)) {
+ *expr = Fold(context, std::move(*expr));
+ }
+ }
+ }
+ }
+}
+
std::optional<bool> ActualArgNeedsCopy(const ActualArgument *actual,
const characteristics::DummyArgument *dummy, FoldingContext &fc,
bool forCopyOut) {
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 4b0d493959ec9..e6f39ae89ab05 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -3962,22 +3962,6 @@ static bool CheckAtomicDefineAndRef(FoldingContext &context,
// Applies any semantic checks peculiar to an intrinsic.
// TODO: Move the rest of these checks to Semantics/check-call.cpp.
static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
- // Actual arguments may have been retained in named-constant designator
- // form for the benefit of nonintrinsic calls (storage association); the
- // checks below inspect constant values structurally, so fold such
- // arguments back to their values first.
- for (auto &arg : call.arguments) {
- if (arg && !arg->isAlternateReturn()) {
- if (Expr<SomeType> * expr{arg->UnwrapExpr()}) {
- if (auto dataRef{ExtractDataRef(
- *expr, /*intoSubstring=*/true, /*intoComplexPart=*/true)};
- dataRef &&
- IsNamedConstant(dataRef->GetFirstSymbol().GetUltimate())) {
- *expr = Fold(context, std::move(*expr));
- }
- }
- }
- }
bool ok{true};
const std::string &name{call.specificIntrinsic.name};
if (name == "allocated") {
@@ -4495,6 +4479,22 @@ std::string IntrinsicProcTable::GetGenericIntrinsicName(
std::optional<SpecificCall> IntrinsicProcTable::Probe(
const CallCharacteristics &call, ActualArguments &arguments,
FoldingContext &context) const {
+ // Actual arguments may retain designators of named constants for the
+ // benefit of storage association in nonintrinsic calls (see
+ // ArgumentAnalyzer::AnalyzeExprOrWholeAssumedSizeArray). Intrinsic
+ // matching, argument checking, and the special handlers inspect constant
+ // values structurally, so probe with a folded copy of such arguments.
+ // On success the SpecificCall carries the folded arguments; on failure
+ // the caller's original arguments are left untouched for subsequent
+ // nonintrinsic resolution. (Note a pre-existing quirk, unchanged here:
+ // Match() moves arguments while rearranging them and can still fail late,
+ // so a failed match can leave a probe's working vector partially moved
+ // from; using a copy confines that to the copy.)
+ if (AnyNamedConstantActualArguments(arguments)) {
+ ActualArguments folded{arguments};
+ FoldNamedConstantActualArguments(context, folded);
+ return DEREF(impl_.get()).Probe(call, folded, context);
+ }
return DEREF(impl_.get()).Probe(call, arguments, context);
}
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 8b67b4318bcef..20e20b91c4efb 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -45,8 +45,6 @@ using common::LanguageFeature;
using common::NumericOperator;
using common::TypeCategory;
-static void FoldNamedConstantActuals(FoldingContext &, ActualArguments &);
-
static inline std::string ToUpperCase(std::string_view str) {
return parser::ToUpperCaseLetters(str);
}
@@ -3482,7 +3480,6 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
CallCharacteristics{name.source.ToString(), isSubroutine},
localArguments, GetFoldingContext())}) {
CheckBadExplicitType(*specificCall, *symbol);
- FoldNamedConstantActuals(GetFoldingContext(), specificCall->arguments);
return CalleeAndArguments{
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
std::move(specificCall->arguments)};
@@ -3491,6 +3488,12 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
if (resolution) {
if (context_.GetPPCBuiltinsScope() &&
resolution->name().ToString().rfind("__ppc_", 0) == 0) {
+ // The PowerPC intrinsic checks and PowerPC lowering require constant
+ // values for some arguments; now that the call is committed to this
+ // resolution, fold any named-constant designators that were retained
+ // for storage association.
+ evaluate::FoldNamedConstantActualArguments(
+ GetFoldingContext(), arguments);
semantics::CheckPPCIntrinsic(
*symbol, *resolution, arguments, GetFoldingContext());
}
@@ -3513,7 +3516,6 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
CallCharacteristics{name.ToString(), isSubroutine}, arguments,
GetFoldingContext())}) {
CheckBadExplicitType(*specificCall, *symbol);
- FoldNamedConstantActuals(GetFoldingContext(), specificCall->arguments);
return CalleeAndArguments{
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
std::move(specificCall->arguments)};
@@ -4929,34 +4931,11 @@ MaybeExpr ExpressionAnalyzer::MakeFunctionRef(parser::CharBlock callSite,
return std::nullopt;
}
-// Fold actual arguments that were retained in named-constant designator form
-// (see ArgumentAnalyzer::AnalyzeExprOrWholeAssumedSizeArray) once the callee
-// has resolved to an intrinsic procedure. Intrinsic argument checking and
-// intrinsic folding inspect constant values structurally, and the storage
-// identity of a named constant is irrelevant to an intrinsic procedure.
-static void FoldNamedConstantActuals(
- FoldingContext &context, ActualArguments &arguments) {
- for (auto &arg : arguments) {
- if (arg && !arg->isAlternateReturn()) {
- if (Expr<SomeType> * expr{arg->UnwrapExpr()}) {
- if (auto dataRef{ExtractDataRef(
- *expr, /*intoSubstring=*/true, /*intoComplexPart=*/true)};
- dataRef &&
- semantics::IsNamedConstant(
- dataRef->GetFirstSymbol().GetUltimate())) {
- *expr = Fold(context, std::move(*expr));
- }
- }
- }
- }
-}
-
MaybeExpr ExpressionAnalyzer::MakeFunctionRef(
parser::CharBlock intrinsic, ActualArguments &&arguments) {
if (std::optional<SpecificCall> specificCall{
context_.intrinsics().Probe(CallCharacteristics{intrinsic.ToString()},
arguments, GetFoldingContext())}) {
- FoldNamedConstantActuals(GetFoldingContext(), specificCall->arguments);
return MakeFunctionRef(intrinsic,
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
std::move(specificCall->arguments));
@@ -5896,7 +5875,9 @@ MaybeExpr ArgumentAnalyzer::AnalyzeExprOrWholeAssumedSizeArray(
if (isProcedureCall_ && result) {
// Look only at an expression that is itself a designator: a
// parenthesized designator is a primary, i.e. an expression
- // (F'2023 R1001), and must keep its folded value.
+ // (F'2023 R1001), and must keep its folded value. Substring actual
+ // arguments (the F'2023 15.5.2.12 p4 form of character sequence
+ // association) are not retained here and keep their folded values.
if (const auto *designator{
std::get_if<common::Indirection<parser::Designator>>(&expr.u)}) {
if (const auto *name{parser::Unwrap<parser::Name>(designator->value())}) {
diff --git a/flang/test/Integration/PowerPC/ppc-vec-shift-parameter.f90 b/flang/test/Integration/PowerPC/ppc-vec-shift-parameter.f90
new file mode 100644
index 0000000000000..b259a35fd7337
--- /dev/null
+++ b/flang/test/Integration/PowerPC/ppc-vec-shift-parameter.f90
@@ -0,0 +1,21 @@
+!===----------------------------------------------------------------------===!
+! This directory can be used to add Integration tests involving multiple
+! stages of the compiler (for eg. from Fortran to LLVM IR). It should not
+! contain executable tests. We should only add tests here sparingly and only
+! if there is no other way to test. Repeat this message in each test that is
+! added to this directory and sub-directories.
+!===----------------------------------------------------------------------===!
+
+! RUN: %flang_fc1 -emit-llvm %s -triple ppc64le-unknown-linux -o - | FileCheck %s
+! REQUIRES: target=powerpc{{.*}}
+
+! The shift amount of vec_sld must reach PowerPC lowering as a constant even
+! when it is written as an element of a named constant (which the front end
+! may keep in designator form for storage association).
+subroutine test_sld_parameter(arg1, arg2, r)
+ vector(integer(4)) :: arg1, arg2, r
+ integer, parameter :: sh(1) = [2]
+ r = vec_sld(arg1, arg2, sh(1))
+end subroutine
+! CHECK-LABEL: @test_sld_parameter_
+! CHECK: shufflevector <16 x i8> %{{[0-9]+}}, <16 x i8> %{{[0-9]+}}, <16 x i32>
diff --git a/flang/test/Semantics/PowerPC/ppc-vector-intrinsics.f90 b/flang/test/Semantics/PowerPC/ppc-vector-intrinsics.f90
index e0df315fa57df..bb80bcd0d792c 100644
--- a/flang/test/Semantics/PowerPC/ppc-vector-intrinsics.f90
+++ b/flang/test/Semantics/PowerPC/ppc-vector-intrinsics.f90
@@ -5,6 +5,15 @@ program test
vector(integer(4)) :: arg1, arg2, r
vector(real(4)) :: rr
integer :: i
+ integer, parameter :: sh(1) = [2]
+ integer, parameter :: shbad(1) = [17]
+
+! An element of a named constant is a constant expression whose value must be
+! usable by the range check (it is folded when the call commits to the PowerPC
+! intrinsic), not a crash.
+ r = vec_sld(arg1, arg2, sh(1))
+!ERROR: Argument #3 must be a constant expression in range 0 to 15
+ r = vec_sld(arg1, arg2, shbad(1))
!ERROR: Actual argument #3 must be a constant expression
r = vec_sld(arg1, arg2, i)
>From 9eadb37cdb9ab6f1ab05edac5aecd4287e86e5d6 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Tue, 15 Sep 2026 09:16:37 -0700
Subject: [PATCH 4/9] [flang] Diagnose short storage sequences for
named-constant array elements
A named constant has no storage offsets, so the DesignatorFolder-based
storage-sequence extent check (F'2023 15.5.2.12 p6) silently skipped named
constant array element actual arguments; compute the remaining sequence from
the constant's shape, lower bounds, and constant subscripts instead, so that
passing a too-short remainder to an explicit-shape dummy is diagnosed the
same way it is for variables.
Also correct the element sequence-association case in
call-parameter-array-arg.f90 to use a dummy whose extent matches the
remaining sequence, and add semantics tests covering the accepted element
association, the short-sequence diagnostic, INTENT definability rejection,
and the DIM= range check on a named-constant argument.
---
flang/lib/Semantics/check-call.cpp | 69 ++++++++++++++++++-
.../Lower/HLFIR/call-parameter-array-arg.f90 | 13 ++--
.../Semantics/call-parameter-seq-assoc.f90 | 54 +++++++++++++++
3 files changed, 130 insertions(+), 6 deletions(-)
create mode 100644 flang/test/Semantics/call-parameter-seq-assoc.f90
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 2fd7ff5ac1a5c..b12c8bd604b10 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -706,9 +706,67 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
} else if (actualRank == 0) {
if (evaluate::IsArrayElement(actual)) {
// Actual argument is a scalar array element
+ std::optional<std::int64_t> namedConstElements;
+ if (auto dataRef{evaluate::ExtractDataRef(actual)}) {
+ // A named constant has no storage offsets, so FoldDesignator
+ // below cannot measure it; compute the remaining storage
+ // sequence from the constant subscripts of a whole-symbol
+ // array element reference instead.
+ if (const auto *aRef{
+ std::get_if<evaluate::ArrayRef>(&dataRef->u)}) {
+ const Symbol &ncBase{aRef->base().GetLastSymbol()};
+ if (IsNamedConstant(ncBase.GetUltimate()) &&
+ aRef->base().IsSymbol()) {
+ if (auto extents{evaluate::GetConstantExtents(
+ foldingContext, &ncBase)}) {
+ evaluate::Shape lbShape{evaluate::GetLBOUNDs(aRef->base())};
+ std::int64_t linear{0}, stride{1}, total{1};
+ bool ok{extents->size() == aRef->subscript().size() &&
+ extents->size() == lbShape.size()};
+ for (std::size_t d{0}; ok && d < extents->size(); ++d) {
+ auto lb{lbShape[d]
+ ? evaluate::ToInt64(evaluate::Fold(
+ foldingContext, std::move(*lbShape[d])))
+ : std::nullopt};
+ const auto *ssExpr{
+ std::get_if<evaluate::IndirectSubscriptIntegerExpr>(
+ &aRef->subscript()[d].u)};
+ auto ss{ssExpr
+ ? evaluate::ToInt64(evaluate::Fold(foldingContext,
+ common::Clone(ssExpr->value())))
+ : std::nullopt};
+ if (lb && ss) {
+ linear += (*ss - *lb) * stride;
+ stride *= (*extents)[d];
+ total *= (*extents)[d];
+ } else {
+ ok = false;
+ }
+ }
+ if (ok && linear >= 0 && linear < total) {
+ namedConstElements = total - linear;
+ }
+ }
+ }
+ }
+ }
evaluate::DesignatorFolder folder{
context.foldingContext(), /*getLastComponent=*/true};
- if (auto actualOffset{folder.FoldDesignator(actual)}) {
+ if (namedConstElements) {
+ if (*namedConstElements < *dummySize) {
+ if (extentErrors) {
+ messages.Say(
+ "Actual argument has fewer elements remaining in storage sequence (%jd) than %s array (%jd)"_err_en_US,
+ static_cast<std::intmax_t>(*namedConstElements),
+ dummyName, static_cast<std::intmax_t>(*dummySize));
+ } else {
+ foldingContext.Warn(common::UsageWarning::ShortArrayActual,
+ "Actual argument has fewer elements remaining in storage sequence (%jd) than %s array (%jd)"_warn_en_US,
+ static_cast<std::intmax_t>(*namedConstElements),
+ dummyName, static_cast<std::intmax_t>(*dummySize));
+ }
+ }
+ } else if (auto actualOffset{folder.FoldDesignator(actual)}) {
std::optional<std::int64_t> actualElements;
if (IsAllocatableOrPointer(actualOffset->symbol())) {
// don't use actualOffset->symbol().size()!
@@ -2567,7 +2625,14 @@ bool CheckArgumentIsConstantExprInRange(
// for the intrinsic's argument should have been check prior. This is just
// a conversion so that we can read the constant value.
auto scalarValue{evaluate::ToInt64(argExpr)};
- CHECK(scalarValue.has_value());
+ if (!scalarValue) {
+ // A constant expression whose value is not statically known here (e.g.
+ // a designator that was not folded); diagnose rather than crash.
+ messages.Say(
+ "Actual argument #%d must be a constant integer expression"_err_en_US,
+ index + 1);
+ return false;
+ }
if (*scalarValue < lowerBound || *scalarValue > upperBound) {
messages.Say(
diff --git a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90 b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
index 281b3b7b1d1ae..d7fae1773ab93 100644
--- a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
+++ b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
@@ -13,6 +13,9 @@ module m
subroutine expl(x)
integer, intent(in) :: x(4)
end subroutine
+ subroutine expl3(x)
+ integer, intent(in) :: x(3)
+ end subroutine
subroutine asmd(x)
integer, intent(in) :: x(:)
end subroutine
@@ -52,17 +55,19 @@ subroutine whole_assumed_shape()
end subroutine
! Named-constant array element to an explicit-shape dummy (sequence
-! association): the element's address is passed; no scalar temporary.
+! association, F'2023 15.5.2.12): the element's address is passed; no scalar
+! temporary. The dummy extent (3) matches the sequence remaining from gp(2)
+! per 15.5.2.12 p6.
! CHECK-LABEL: func.func @_QPelement_seq_assoc
! CHECK: %[[EADDR:.*]] = fir.address_of(@_QMmECgp)
! CHECK: %[[EDECL:.*]]:2 = hlfir.declare %[[EADDR]]
! CHECK: %[[ELT:.*]] = hlfir.designate %[[EDECL]]#0 (%{{.*}}) : (!fir.ref<!fir.array<4xi32>>, i64) -> !fir.ref<i32>
! CHECK-NOT: hlfir.as_expr
-! CHECK: %[[ECAST:.*]] = fir.convert %[[ELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<4xi32>>
-! CHECK: fir.call @_QMmPexpl(%[[ECAST]])
+! CHECK: %[[ECAST:.*]] = fir.convert %[[ELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<3xi32>>
+! CHECK: fir.call @_QMmPexpl3(%[[ECAST]])
subroutine element_seq_assoc()
use m
- call expl(gp(2))
+ call expl3(gp(2))
end subroutine
! Polymorphic assumed-shape dummy: no contiguity requirement, so no copy is
diff --git a/flang/test/Semantics/call-parameter-seq-assoc.f90 b/flang/test/Semantics/call-parameter-seq-assoc.f90
new file mode 100644
index 0000000000000..6b4a90f9be56d
--- /dev/null
+++ b/flang/test/Semantics/call-parameter-seq-assoc.f90
@@ -0,0 +1,54 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Named constants (PARAMETER) as actual arguments: element sequence
+! association is accepted (F'2023 15.5.2.12), short sequences and attempts
+! to modify the dummy are still diagnosed, and intrinsic argument checks
+! that need constant values still fire.
+module m
+ integer, parameter :: gp(4) = [1, 2, 3, 4]
+ integer, parameter :: d1(1) = [5]
+contains
+ subroutine expl3(x)
+ integer, intent(in) :: x(3)
+ end subroutine
+ subroutine expl4(x)
+ integer, intent(in) :: x(4)
+ end subroutine
+ subroutine modifies(x)
+ integer, intent(inout) :: x(3)
+ end subroutine
+ subroutine outputs(x)
+ integer, intent(out) :: x(3)
+ end subroutine
+end module
+
+subroutine accepted()
+ use m
+ ! Element of a named constant to an explicit-shape dummy whose extent
+ ! matches the remaining sequence: conforming, no error.
+ call expl3(gp(2))
+end subroutine
+
+subroutine short_sequence()
+ use m
+ !ERROR: Actual argument has fewer elements remaining in storage sequence (3) than dummy argument 'x=' array (4)
+ call expl4(gp(2))
+end subroutine
+
+subroutine not_definable()
+ use m
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+ !BECAUSE: 'gp' is not a variable
+ call modifies(gp(2))
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+ !BECAUSE: 'gp' is not a variable
+ call outputs(gp(2))
+end subroutine
+
+subroutine intrinsic_dim_check()
+ use m
+ real :: a(2, 3)
+ ! A named-constant DIM= argument out of range must still be diagnosed
+ ! (the designator is folded back to a value for intrinsic checking).
+ !ERROR: The value of DIM= (5) may not be greater than 2
+ print *, sum(a, dim=d1(1))
+end subroutine
>From 9476502c90a87bef031c4a54d834f45d5171f966 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Wed, 16 Sep 2026 07:10:23 -0700
Subject: [PATCH 5/9] [flang][NFC] Reuse IsNamedConstantDesignator in
ActualArgNeedsCopy
The named-constant-designator test in ActualArgNeedsCopy duplicated the
logic of the IsNamedConstantDesignator helper defined just above it; use
the helper. Behaviorally identical: the helper takes the unwrapped
expression rather than the ActualArgument, and the only actual argument
without an expression is an assumed-type passthrough, whose dummy symbol
is never a named constant (and a named constant cannot be assumed-type),
so both paths return forCopyIn for it.
---
flang/lib/Evaluate/check-expression.cpp | 6 ++----
1 file changed, 2 insertions(+), 4 deletions(-)
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 0f24689cf79de..46dccab02df86 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -1697,10 +1697,8 @@ std::optional<bool> ActualArgNeedsCopy(const ActualArgument *actual,
// copy-in depends on its contiguity, like a variable, so fall through
// to the analysis below. Other expressions are copy-in, but not
// copy-out.
- const auto dataRef{ExtractDataRef(
- *actual, /*intoSubstring=*/true, /*intoComplexPart=*/true)};
- if (!dataRef ||
- !semantics::IsNamedConstant(dataRef->GetFirstSymbol().GetUltimate())) {
+ const Expr<SomeType> *expr{actual->UnwrapExpr()};
+ if (!expr || !IsNamedConstantDesignator(*expr)) {
return forCopyIn;
}
if (forCopyOut) {
>From 3d0d35564d9abd0a0a599a3d76a2a39e8db43b12 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Wed, 16 Sep 2026 07:57:58 -0700
Subject: [PATCH 6/9] [flang] Fold named-constant designators in
DesignatorFolder on request
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Replace the hand-rolled remaining-storage-sequence computation for named
constant array elements in check-call.cpp with an opt-in DesignatorFolder
capability: with foldNamedConstants set, the folder resolves a named
constant through its ultimate symbol and folds its designators to
(offset, size) within the constant's own storage sequence, exactly as it
already does for variables (the size comes from the type and constant
extents, not from a storage assignment). Clients that map real memory,
like DATA statement initialization, keep the default and are unchanged.
Both storage-sequence extent checks in check-call.cpp opt in, which also
extends the CHARACTER storage sequence check (F'2023 15.5.2.12 p4) to
named constant elements — previously it silently skipped them — and both
checks now handle use- and host-associated named constants. A shared
ObjectTotalBytes helper measures named constants from their type and
extents where a variable's symbol size would be used.
---
.../include/flang/Evaluate/fold-designator.h | 12 +-
flang/lib/Evaluate/fold-designator.cpp | 22 ++--
flang/lib/Semantics/check-call.cpp | 117 +++++++-----------
.../Semantics/call-parameter-seq-assoc.f90 | 24 ++++
4 files changed, 91 insertions(+), 84 deletions(-)
diff --git a/flang/include/flang/Evaluate/fold-designator.h b/flang/include/flang/Evaluate/fold-designator.h
index 919f3c6db547b..32bb26588407a 100644
--- a/flang/include/flang/Evaluate/fold-designator.h
+++ b/flang/include/flang/Evaluate/fold-designator.h
@@ -59,8 +59,15 @@ class OffsetSymbol {
// corresponding to an element in array element order.
class DesignatorFolder {
public:
- explicit DesignatorFolder(FoldingContext &c, bool getLastComponent = false)
- : context_{c}, getLastComponent_{getLastComponent} {}
+ // A named constant has no storage assignment, but its designators can
+ // still be folded to (offset, size) within the constant's own storage
+ // sequence, which storage sequence association checks need; opt in with
+ // foldNamedConstants. Clients that map real memory (e.g. DATA statement
+ // initialization) must keep the default.
+ explicit DesignatorFolder(FoldingContext &c, bool getLastComponent = false,
+ bool foldNamedConstants = false)
+ : context_{c}, getLastComponent_{getLastComponent},
+ foldNamedConstants_{foldNamedConstants} {}
bool isEmpty() const { return isEmpty_; }
bool isOutOfRange() const { return isOutOfRange_; }
@@ -158,6 +165,7 @@ class DesignatorFolder {
FoldingContext &context_;
bool getLastComponent_{false};
+ bool foldNamedConstants_{false};
ConstantSubscript elementNumber_{0}; // zero-based
bool isEmpty_{false};
bool isOutOfRange_{false};
diff --git a/flang/lib/Evaluate/fold-designator.cpp b/flang/lib/Evaluate/fold-designator.cpp
index d7751ec389917..00559ea1f4e93 100644
--- a/flang/lib/Evaluate/fold-designator.cpp
+++ b/flang/lib/Evaluate/fold-designator.cpp
@@ -15,22 +15,30 @@ DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(OffsetSymbol)
std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
const Symbol &symbol, ConstantSubscript which) {
- if (!getLastComponent_ && IsAllocatableOrPointer(symbol)) {
+ // A named constant is used through its ultimate symbol: the local alias
+ // of a use- or host-associated named constant has no object details of
+ // its own. Variables are deliberately not resolved this way here, so
+ // that the default behavior is unchanged.
+ const Symbol *object{&symbol};
+ if (foldNamedConstants_ && IsNamedConstant(symbol.GetUltimate())) {
+ object = &symbol.GetUltimate();
+ }
+ if (!getLastComponent_ && IsAllocatableOrPointer(*object)) {
// A pointer may appear as a DATA statement object if it is the
// rightmost symbol in a designator and has no subscripts.
// An allocatable may appear if its initializer is NULL().
if (which > 0) {
isEmpty_ = true;
} else {
- return OffsetSymbol{symbol, symbol.size()};
+ return OffsetSymbol{*object, object->size()};
}
- } else if (symbol.has<semantics::ObjectEntityDetails>() &&
- !IsNamedConstant(symbol)) {
- if (auto type{DynamicType::From(symbol)}) {
- if (auto extents{GetConstantExtents(context_, symbol)}) {
+ } else if (object->has<semantics::ObjectEntityDetails>() &&
+ (foldNamedConstants_ || !IsNamedConstant(*object))) {
+ if (auto type{DynamicType::From(*object)}) {
+ if (auto extents{GetConstantExtents(context_, *object)}) {
if (auto bytes{ToInt64(
type->MeasureSizeInBytes(context_, GetRank(*extents) > 0))}) {
- OffsetSymbol result{symbol, static_cast<std::size_t>(*bytes)};
+ OffsetSymbol result{*object, static_cast<std::size_t>(*bytes)};
if (which < GetSize(*extents)) {
result.Augment(*bytes * which);
return result;
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index b12c8bd604b10..d065c1e6a6597 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -132,6 +132,29 @@ void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
// F'2023 15.5.2.12p1: "Sequence association only applies when the dummy
// argument is an explicit-shape or assumed-size array."
+// Total size in bytes of a whole object for storage-sequence checks.
+// A named constant has no storage assignment (symbol.size() is zero), so
+// measure it from its type and constant extents instead.
+static std::optional<std::int64_t> ObjectTotalBytes(
+ const Symbol &symbol, evaluate::FoldingContext &foldingContext) {
+ if (std::size_t bytes{symbol.size()}) {
+ return static_cast<std::int64_t>(bytes);
+ }
+ if (const Symbol &ultimate{symbol.GetUltimate()}; IsNamedConstant(ultimate)) {
+ if (auto type{evaluate::DynamicType::From(ultimate)}) {
+ if (auto extents{
+ evaluate::GetConstantExtents(foldingContext, &ultimate)}) {
+ if (auto bytes{evaluate::ToInt64(evaluate::Fold(foldingContext,
+ type->MeasureSizeInBytes(
+ foldingContext, evaluate::GetRank(*extents) > 0)))}) {
+ return *bytes * evaluate::GetSize(*extents);
+ }
+ }
+ }
+ }
+ return std::nullopt;
+}
+
static bool CanAssociateWithStorageSequence(
const characteristics::DummyDataObject &dummy) {
return !dummy.type.attrs().test(
@@ -186,14 +209,17 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
foldingContext, evaluate::GetSize(dummy.type.shape())))}) {
auto dummyChars{*dummySize * *dummyLength};
if (actualType.Rank() == 0 && !actualIsAssumedRank) {
- evaluate::DesignatorFolder folder{
- context.foldingContext(), /*getLastComponent=*/true};
+ evaluate::DesignatorFolder folder{context.foldingContext(),
+ /*getLastComponent=*/true, /*foldNamedConstants=*/true};
if (auto actualOffset{folder.FoldDesignator(actual)}) {
std::int64_t actualChars{*actualLength};
+ auto totalBytes{
+ ObjectTotalBytes(actualOffset->symbol(), foldingContext)};
if (IsAllocatableOrPointer(actualOffset->symbol())) {
- // don't use actualOffset->symbol().size()!
- } else if (static_cast<std::size_t>(actualOffset->offset()) >=
- actualOffset->symbol().size() ||
+ // don't use the symbol's size!
+ } else if (!totalBytes ||
+ static_cast<std::int64_t>(actualOffset->offset()) >=
+ *totalBytes ||
!evaluate::IsContiguous(
actualOffset->symbol(), foldingContext)
.value_or(false)) {
@@ -204,9 +230,7 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
*actualLength;
}
} else {
- actualChars = (static_cast<std::int64_t>(
- actualOffset->symbol().size()) -
- actualOffset->offset()) /
+ actualChars = (*totalBytes - actualOffset->offset()) /
actualType.type().kind();
}
if (actualChars < dummyChars) {
@@ -706,72 +730,17 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
} else if (actualRank == 0) {
if (evaluate::IsArrayElement(actual)) {
// Actual argument is a scalar array element
- std::optional<std::int64_t> namedConstElements;
- if (auto dataRef{evaluate::ExtractDataRef(actual)}) {
- // A named constant has no storage offsets, so FoldDesignator
- // below cannot measure it; compute the remaining storage
- // sequence from the constant subscripts of a whole-symbol
- // array element reference instead.
- if (const auto *aRef{
- std::get_if<evaluate::ArrayRef>(&dataRef->u)}) {
- const Symbol &ncBase{aRef->base().GetLastSymbol()};
- if (IsNamedConstant(ncBase.GetUltimate()) &&
- aRef->base().IsSymbol()) {
- if (auto extents{evaluate::GetConstantExtents(
- foldingContext, &ncBase)}) {
- evaluate::Shape lbShape{evaluate::GetLBOUNDs(aRef->base())};
- std::int64_t linear{0}, stride{1}, total{1};
- bool ok{extents->size() == aRef->subscript().size() &&
- extents->size() == lbShape.size()};
- for (std::size_t d{0}; ok && d < extents->size(); ++d) {
- auto lb{lbShape[d]
- ? evaluate::ToInt64(evaluate::Fold(
- foldingContext, std::move(*lbShape[d])))
- : std::nullopt};
- const auto *ssExpr{
- std::get_if<evaluate::IndirectSubscriptIntegerExpr>(
- &aRef->subscript()[d].u)};
- auto ss{ssExpr
- ? evaluate::ToInt64(evaluate::Fold(foldingContext,
- common::Clone(ssExpr->value())))
- : std::nullopt};
- if (lb && ss) {
- linear += (*ss - *lb) * stride;
- stride *= (*extents)[d];
- total *= (*extents)[d];
- } else {
- ok = false;
- }
- }
- if (ok && linear >= 0 && linear < total) {
- namedConstElements = total - linear;
- }
- }
- }
- }
- }
- evaluate::DesignatorFolder folder{
- context.foldingContext(), /*getLastComponent=*/true};
- if (namedConstElements) {
- if (*namedConstElements < *dummySize) {
- if (extentErrors) {
- messages.Say(
- "Actual argument has fewer elements remaining in storage sequence (%jd) than %s array (%jd)"_err_en_US,
- static_cast<std::intmax_t>(*namedConstElements),
- dummyName, static_cast<std::intmax_t>(*dummySize));
- } else {
- foldingContext.Warn(common::UsageWarning::ShortArrayActual,
- "Actual argument has fewer elements remaining in storage sequence (%jd) than %s array (%jd)"_warn_en_US,
- static_cast<std::intmax_t>(*namedConstElements),
- dummyName, static_cast<std::intmax_t>(*dummySize));
- }
- }
- } else if (auto actualOffset{folder.FoldDesignator(actual)}) {
+ evaluate::DesignatorFolder folder{context.foldingContext(),
+ /*getLastComponent=*/true, /*foldNamedConstants=*/true};
+ if (auto actualOffset{folder.FoldDesignator(actual)}) {
std::optional<std::int64_t> actualElements;
+ auto totalBytes{
+ ObjectTotalBytes(actualOffset->symbol(), foldingContext)};
if (IsAllocatableOrPointer(actualOffset->symbol())) {
- // don't use actualOffset->symbol().size()!
- } else if (static_cast<std::size_t>(actualOffset->offset()) >=
- actualOffset->symbol().size() ||
+ // don't use the symbol's size!
+ } else if (!totalBytes ||
+ static_cast<std::int64_t>(actualOffset->offset()) >=
+ *totalBytes ||
!evaluate::IsContiguous(
actualOffset->symbol(), foldingContext)
.value_or(false)) {
@@ -783,9 +752,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
actualSymType->MeasureSizeInBytes(
foldingContext, false)))};
actualSymTypeBytes && *actualSymTypeBytes > 0) {
- actualElements = (static_cast<std::int64_t>(
- actualOffset->symbol().size()) -
- actualOffset->offset()) /
+ actualElements = (*totalBytes - actualOffset->offset()) /
*actualSymTypeBytes;
}
}
diff --git a/flang/test/Semantics/call-parameter-seq-assoc.f90 b/flang/test/Semantics/call-parameter-seq-assoc.f90
index 6b4a90f9be56d..dfdf49823c921 100644
--- a/flang/test/Semantics/call-parameter-seq-assoc.f90
+++ b/flang/test/Semantics/call-parameter-seq-assoc.f90
@@ -52,3 +52,27 @@ subroutine intrinsic_dim_check()
!ERROR: The value of DIM= (5) may not be greater than 2
print *, sum(a, dim=d1(1))
end subroutine
+
+module mc
+ character(len=4), parameter :: cp(2) = ['abcd', 'efgh']
+contains
+ subroutine takes_c2x2(c)
+ character(len=2), intent(in) :: c(2)
+ end subroutine
+ subroutine takes_c2x3(c)
+ character(len=2), intent(in) :: c(3)
+ end subroutine
+end module
+
+subroutine char_accepted()
+ use mc
+ ! Character storage sequence association (F'2023 15.5.2.12 p4): the 4
+ ! characters remaining from cp(2) exactly fill the 2x2-character dummy.
+ call takes_c2x2(cp(2))
+end subroutine
+
+subroutine char_short_sequence()
+ use mc
+ !ERROR: Actual argument has fewer characters remaining in storage sequence (4) than dummy argument 'c=' (6)
+ call takes_c2x3(cp(2))
+end subroutine
>From a7f1c380c73db0c85fa53d5ddd605042523c1acc Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Wed, 16 Sep 2026 10:09:38 -0700
Subject: [PATCH 7/9] [flang] Test character named-constant elements with
assumed-length dummies
Cover character storage sequence association (F'2023 15.5.2.12 p4) of a
named-constant array element with an assumed-length explicit-shape array
dummy: the element is designated directly in the named constant's storage
and passed as a boxchar carrying the element length, with no temporary and
no outlined copy. Covered for one- and multi-character element types.
---
.../Lower/HLFIR/call-parameter-array-arg.f90 | 49 +++++++++++++++++++
1 file changed, 49 insertions(+)
diff --git a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90 b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
index d7fae1773ab93..43d94d670271b 100644
--- a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
+++ b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
@@ -210,3 +210,52 @@ subroutine derived_scalar_and_component()
call dt_scalar(ds)
call int_array(ds%a)
end subroutine
+
+! ---- Character named-constant elements and assumed-length dummies ----
+
+module mq
+ implicit none
+ character(len=1), parameter :: letters(8) = &
+ ['p', 'q', 'r', 's', 't', 'u', 'v', 'w']
+ character(len=3), parameter :: trip(4) = ['abc', 'def', 'ghi', 'jkl']
+contains
+ subroutine asl1(x)
+ character(*), intent(in) :: x(8)
+ end subroutine
+ subroutine asl3(x)
+ character(*), intent(in) :: x(3)
+ end subroutine
+end module
+
+! Element of a character named constant passed to an assumed-length
+! explicit-shape array dummy (character storage sequence association,
+! F'2023 15.5.2.12 p4): the element is designated directly in the named
+! constant's storage and passed as a boxchar carrying the element length;
+! no temporary and no outlined copy.
+! CHECK-LABEL: func.func @_QPchar_elem_assumed_len
+! CHECK: %[[LADDR:.*]] = fir.address_of(@_QMmqECletters)
+! CHECK: %[[LDECL:.*]]:2 = hlfir.declare %[[LADDR]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[LELT:.*]] = hlfir.designate %[[LDECL]]#0 (%{{.*}}) typeparams %c1{{.*}} : (!fir.ref<!fir.array<8x!fir.char<1>>>, i64, index) -> !fir.ref<!fir.char<1>>
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[LBOX:.*]] = fir.emboxchar %[[LELT]], %c1{{.*}} : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
+! CHECK: fir.call @_QMmqPasl1(%[[LBOX]])
+subroutine char_elem_assumed_len()
+ use mq
+ call asl1(letters(1))
+end subroutine
+
+! Same with a multi-character element type: the boxchar carries the
+! named constant's element length (3).
+! CHECK-LABEL: func.func @_QPchar_elem_len3
+! CHECK: %[[TADDR:.*]] = fir.address_of(@_QMmqECtrip)
+! CHECK: %[[TDECL:.*]]:2 = hlfir.declare %[[TADDR]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[TELT:.*]] = hlfir.designate %[[TDECL]]#0 (%{{.*}}) typeparams %c3{{.*}} : (!fir.ref<!fir.array<4x!fir.char<1,3>>>, i64, index) -> !fir.ref<!fir.char<1,3>>
+! CHECK-NOT: hlfir.as_expr
+! CHECK: %[[TBOX:.*]] = fir.emboxchar %[[TELT]], %c3{{.*}} : (!fir.ref<!fir.char<1,3>>, index) -> !fir.boxchar<1>
+! CHECK: fir.call @_QMmqPasl3(%[[TBOX]])
+subroutine char_elem_len3()
+ use mq
+ call asl3(trip(2))
+end subroutine
>From 4dc632bc38661a80a401e20ce90f5c935f5421c5 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Thu, 17 Sep 2026 04:45:31 -0700
Subject: [PATCH 8/9] [flang] Keep retained named-constant designators through
function-reference folding
Expression folding of a nonintrinsic function reference folds its actual
arguments in place, which replaced a retained named-constant designator
with its scalar value: the element sequence accepted by semantics then
reached lowering as a one-element scalar association cast to an array.
Skip that refold for named-constant designators of nonintrinsic function
references (and in the conditional-argument consequent folding), so
function references get the same storage association CALL statements get;
intrinsic references still fold, and their argument values come through
the folded copy made at intrinsic resolution.
Also fold a copy of a retained named-constant designator in the
Hollerith/CHARACTER-as-BOZ conversion extension, which inspects constant
values structurally and otherwise stopped accepting a named-constant
CHARACTER element passed to a scalar INTEGER dummy.
IsNamedConstantDesignator is now exported from Evaluate for these uses.
Tests: function-reference element sequence association and whole-array
dataflow; the BOZ extension with named-constant, literal, and
parenthesized actuals plus a variable negative control.
---
.../include/flang/Evaluate/check-expression.h | 1 +
flang/lib/Evaluate/check-expression.cpp | 2 +-
flang/lib/Evaluate/fold-implementation.h | 11 ++++
flang/lib/Evaluate/fold.cpp | 7 ++-
flang/lib/Semantics/check-call.cpp | 13 ++++-
.../Lower/HLFIR/call-parameter-array-arg.f90 | 51 +++++++++++++++++++
flang/test/Semantics/call-parameter-boz.f90 | 34 +++++++++++++
7 files changed, 115 insertions(+), 4 deletions(-)
create mode 100644 flang/test/Semantics/call-parameter-boz.f90
diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h
index 2b8cb4ea457eb..3003179699faa 100644
--- a/flang/include/flang/Evaluate/check-expression.h
+++ b/flang/include/flang/Evaluate/check-expression.h
@@ -183,6 +183,7 @@ std::optional<parser::Message> CheckStatementFunction(
// matching, checking, and folding inspect constant values structurally, so
// such arguments must be folded back to values once a call is known to
// resolve to an intrinsic procedure.
+bool IsNamedConstantDesignator(const Expr<SomeType> &);
bool AnyNamedConstantActualArguments(const ActualArguments &);
void FoldNamedConstantActualArguments(FoldingContext &, ActualArguments &);
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 46dccab02df86..db4cf137b5eb0 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -1643,7 +1643,7 @@ class CopyInOutExplicitInterface {
// perspective, meaning that for copy-in the caller need to do the copy
// before calling the callee. Similarly, for copy-out the caller is expected
// to do the copy after the callee returns.
-static bool IsNamedConstantDesignator(const Expr<SomeType> &expr) {
+bool IsNamedConstantDesignator(const Expr<SomeType> &expr) {
if (auto dataRef{ExtractDataRef(
expr, /*intoSubstring=*/true, /*intoComplexPart=*/true)}) {
return semantics::IsNamedConstant(dataRef->GetFirstSymbol().GetUltimate());
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index f89fb1601176e..03414f1e789e0 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -16,6 +16,7 @@
#include "flang/Common/template.h"
#include "flang/Common/unwrap.h"
#include "flang/Evaluate/characteristics.h"
+#include "flang/Evaluate/check-expression.h"
#include "flang/Evaluate/common.h"
#include "flang/Evaluate/constant.h"
#include "flang/Evaluate/expression.h"
@@ -1377,6 +1378,16 @@ Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) {
if (arg && arg->GetConditionalArg()) {
FoldConditionalArg(context, arg);
} else if (auto *expr{UnwrapExpr<Expr<SomeType>>(arg)}) {
+ if (!intrinsic && IsNamedConstantDesignator(*expr)) {
+ // A designator of a named constant retained as the actual argument
+ // of a nonintrinsic function reference stays in designator form so
+ // that lowering can associate the dummy argument with the named
+ // constant's storage (in particular for element sequence
+ // association); folding it here would replace it with its scalar
+ // value. Intrinsic references still fold, since intrinsic folding
+ // inspects constant values.
+ continue;
+ }
*expr = Fold(context, std::move(*expr));
}
}
diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp
index f20d32077602d..6cf5a654b648d 100644
--- a/flang/lib/Evaluate/fold.cpp
+++ b/flang/lib/Evaluate/fold.cpp
@@ -9,6 +9,7 @@
#include "flang/Evaluate/fold.h"
#include "fold-implementation.h"
#include "flang/Evaluate/characteristics.h"
+#include "flang/Evaluate/check-expression.h"
#include "flang/Evaluate/initial-image.h"
#include "flang/Evaluate/tools.h"
@@ -301,7 +302,11 @@ std::optional<Expr<SomeType>> FoldTransfer(
// Fold a Consequent expression in place.
static void FoldConsequent(
FoldingContext &context, ActualArgument::ConditionalArg::Consequent &cons) {
- if (cons) {
+ if (cons && !IsNamedConstantDesignator(cons->value())) {
+ // A retained named-constant designator keeps its designator form for
+ // storage association; see the corresponding skip in
+ // FoldOperation(FunctionRef). Intrinsic references get their values
+ // through the folded copy made at intrinsic resolution.
cons->value() = Fold(context, std::move(cons->value()));
}
}
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index d065c1e6a6597..7fd6fe792d23e 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -429,8 +429,17 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
} else if (dummyRank == 0 && allowActualArgumentConversions) {
// Extension: pass Hollerith literal to scalar as if it had been BOZ
- if (auto converted{evaluate::HollerithToBOZ(
- foldingContext, actual, dummy.type.type())}) {
+ auto converted{
+ evaluate::HollerithToBOZ(foldingContext, actual, dummy.type.type())};
+ if (!converted && evaluate::IsNamedConstantDesignator(actual)) {
+ // The actual may be a designator of a named constant retained for
+ // storage association; the extension inspects constant values, so
+ // retry with its folded value.
+ auto copy{actual};
+ converted = evaluate::HollerithToBOZ(foldingContext,
+ evaluate::Fold(foldingContext, std::move(copy)), dummy.type.type());
+ }
+ if (converted) {
foldingContext.Warn(common::LanguageFeature::HollerithOrCharacterAsBOZ,
"passing Hollerith or character literal as if it were BOZ"_port_en_US);
actual = *converted;
diff --git a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90 b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
index 43d94d670271b..db89bd9462655 100644
--- a/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
+++ b/flang/test/Lower/HLFIR/call-parameter-array-arg.f90
@@ -259,3 +259,54 @@ subroutine char_elem_len3()
use mq
call asl3(trip(2))
end subroutine
+
+! ---- Function references (folding must not replace retained designators) ----
+
+module mf
+ implicit none
+ integer, parameter :: fp(4) = [10, 20, 30, 40]
+contains
+ integer function fsum3(x)
+ integer, intent(in) :: x(3)
+ fsum3 = sum(x)
+ end function
+ integer function fsum4(x)
+ integer, intent(in) :: x(4)
+ fsum4 = sum(x)
+ end function
+end module
+
+! Element of a named constant as a FUNCTION actual argument: expression
+! folding of the function reference must not replace the retained designator
+! with its scalar value; the element's address within the declared global
+! reaches the callee (sequence association). The full dataflow is checked:
+! a scalar-constant association cast to an array would also contain a
+! convert and a call, but not this chain.
+! CHECK-LABEL: func.func @_QPfunc_elem_seq
+! CHECK: %[[FADDR:.*]] = fir.address_of(@_QMmfECfp)
+! CHECK: %[[FDECL:.*]]:2 = hlfir.declare %[[FADDR]]
+! CHECK-NOT: hlfir.associate
+! CHECK: %[[FELT:.*]] = hlfir.designate %[[FDECL]]#0 (%{{.*}}) : (!fir.ref<!fir.array<4xi32>>, i64) -> !fir.ref<i32>
+! CHECK-NOT: hlfir.associate
+! CHECK: %[[FCAST:.*]] = fir.convert %[[FELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<3xi32>>
+! CHECK: fir.call @_QMmfPfsum3(%[[FCAST]])
+subroutine func_elem_seq()
+ use mf
+ integer :: r
+ r = fsum3(fp(2))
+ print *, r
+end subroutine
+
+! Whole named-constant array as a FUNCTION actual argument: the declared
+! global's address is passed directly.
+! CHECK-LABEL: func.func @_QPfunc_whole_array
+! CHECK: %[[WADDR:.*]] = fir.address_of(@_QMmfECfp)
+! CHECK: %[[WDECL:.*]]:2 = hlfir.declare %[[WADDR]]
+! CHECK-NOT: hlfir.as_expr
+! CHECK: fir.call @_QMmfPfsum4(%[[WDECL]]#0
+subroutine func_whole_array()
+ use mf
+ integer :: r
+ r = fsum4(fp)
+ print *, r
+end subroutine
diff --git a/flang/test/Semantics/call-parameter-boz.f90 b/flang/test/Semantics/call-parameter-boz.f90
new file mode 100644
index 0000000000000..1f5c1f1c8aa62
--- /dev/null
+++ b/flang/test/Semantics/call-parameter-boz.f90
@@ -0,0 +1,34 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Whollerith-or-character-as-boz
+! The extension that passes a CHARACTER actual to a scalar INTEGER dummy as
+! if it were BOZ must keep working when the actual is an element of a named
+! constant (whose designator is retained for storage association): the
+! conversion inspects the folded value.
+module m
+contains
+ subroutine takes_integer(x)
+ integer, intent(in) :: x
+ end subroutine
+end module
+
+subroutine named_constant_element()
+ use m
+ character(4), parameter :: a(1) = ['abcd']
+ !PORTABILITY: passing Hollerith or character literal as if it were BOZ [-Whollerith-or-character-as-boz]
+ call takes_integer(a(1))
+end subroutine
+
+subroutine literal_and_parenthesized()
+ use m
+ character(4), parameter :: a(1) = ['abcd']
+ !PORTABILITY: passing Hollerith or character literal as if it were BOZ [-Whollerith-or-character-as-boz]
+ call takes_integer('abcd')
+ !PORTABILITY: passing Hollerith or character literal as if it were BOZ [-Whollerith-or-character-as-boz]
+ call takes_integer((a(1)))
+end subroutine
+
+subroutine variable_still_rejected()
+ use m
+ character(4) :: c
+ !ERROR: Actual argument type 'CHARACTER(KIND=1,LEN=4_8)' is not compatible with dummy argument type 'INTEGER(4)'
+ call takes_integer(c)
+end subroutine
>From a418c8cbc6ffb11b120aebef8a73b8e1e2e7925b Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Thu, 17 Sep 2026 04:45:32 -0700
Subject: [PATCH 9/9] [flang] Size sequence-association VALUE temporaries by
the dummy argument
When a scalar array element is associated with an array dummy argument
(storage sequence association, F'2023 15.5.2.12) and a copy is required
(VALUE, or a named constant needing a temporary), the temporary covered
only the element: the callee then read, and could write, past a
one-element allocation. View the storage sequence starting at the
element as an array of the dummy's shape and copy that instead, so the
temporary carries every element the dummy can access.
This applies to variable element actual arguments as well as named
constants (the variable form of the defect predates the named-constant
acceptance). Restricted to constant-shape dummies with matching
non-character element types; other cases keep their previous lowering.
Tests: sequence-sized VALUE temporaries for a named-constant element and
a variable element.
---
flang/lib/Lower/ConvertCall.cpp | 31 +++++++++++-
.../Lower/HLFIR/call-value-sequence-assoc.f90 | 48 +++++++++++++++++++
2 files changed, 77 insertions(+), 2 deletions(-)
create mode 100644 flang/test/Lower/HLFIR/call-value-sequence-assoc.f90
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 13fbc94ad4278..517c8a8969cbc 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1513,8 +1513,35 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
(isParameterObjectOrSubObject(entity) &&
(suggestCopyIn || suggestCopyOut))) {
// Make a copy in a temporary.
- auto copy = hlfir::AsExprOp::create(builder, loc, entity);
- mlir::Type storageType = entity.getType();
+ //
+ // When a scalar array element is associated with an array dummy
+ // argument (storage sequence association, F'2023 15.5.2.12), the
+ // temporary must cover the whole sequence the dummy requires, not
+ // just the element: view the storage sequence starting at the
+ // element as an array of the dummy's shape and copy that.
+ hlfir::Entity source = entity;
+ if (entity.getRank() == 0 && fir::isa_ref_type(entity.getType())) {
+ mlir::Type dummySeqTy = fir::unwrapRefType(dummyType);
+ if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(dummySeqTy);
+ seqTy && !seqTy.hasDynamicExtents() &&
+ seqTy.getEleTy() == fir::unwrapRefType(entity.getType()) &&
+ !mlir::isa<fir::CharacterType>(seqTy.getEleTy())) {
+ mlir::Value seqRef = builder.createConvert(
+ loc, fir::ReferenceType::get(seqTy), entity);
+ llvm::SmallVector<mlir::Value> extents;
+ for (auto extent : seqTy.getShape())
+ extents.push_back(builder.createIntegerConstant(
+ loc, builder.getIndexType(), extent));
+ mlir::Value shape = builder.genShape(loc, extents);
+ auto declare =
+ hlfir::DeclareOp::create(builder, loc, seqRef, ".sequence.assoc",
+ shape, /*typeparams=*/mlir::ValueRange{},
+ /*dummy_scope=*/nullptr);
+ source = hlfir::Entity{declare.getBase()};
+ }
+ }
+ auto copy = hlfir::AsExprOp::create(builder, loc, source);
+ mlir::Type storageType = source.getType();
mlir::NamedAttribute byRefAttr = fir::getAdaptToByRefAttr(builder);
hlfir::AssociateOp associate = hlfir::genAssociateExpr(
loc, builder, hlfir::Entity{copy}, storageType, "", byRefAttr);
diff --git a/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90 b/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90
new file mode 100644
index 0000000000000..028677cdbdc83
--- /dev/null
+++ b/flang/test/Lower/HLFIR/call-value-sequence-assoc.f90
@@ -0,0 +1,48 @@
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+! A scalar array element associated with an array VALUE dummy via storage
+! sequence association (F'2023 15.5.2.12): the temporary that VALUE requires
+! must cover the whole sequence the dummy needs, not just the element. The
+! sequence starting at the element is viewed as an array of the dummy's
+! shape and that array is copied.
+
+module m
+ implicit none
+ integer, parameter :: cp(4) = [5, 6, 7, 8]
+contains
+ subroutine byval3(x)
+ integer, value :: x(3)
+ end subroutine
+end module
+
+! Named-constant element actual argument.
+! CHECK-LABEL: func.func @_QPvalue_seq_parameter
+! CHECK: %[[PADDR:.*]] = fir.address_of(@_QMmECcp)
+! CHECK: %[[PDECL:.*]]:2 = hlfir.declare %[[PADDR]]
+! CHECK: %[[PELT:.*]] = hlfir.designate %[[PDECL]]#0 (%{{.*}}) : (!fir.ref<!fir.array<4xi32>>, i64) -> !fir.ref<i32>
+! CHECK: %[[PSEQ:.*]] = fir.convert %[[PELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<3xi32>>
+! CHECK: %[[PVIEW:.*]]:2 = hlfir.declare %[[PSEQ]](%{{.*}}) {uniq_name = ".sequence.assoc"}
+! CHECK: %[[PCOPY:.*]] = hlfir.as_expr %[[PVIEW]]#0 : (!fir.ref<!fir.array<3xi32>>) -> !hlfir.expr<3xi32>
+! CHECK: %[[PTMP:.*]]:3 = hlfir.associate %[[PCOPY]](%{{.*}}) {adapt.valuebyref} : (!hlfir.expr<3xi32>, !fir.shape<1>) -> (!fir.ref<!fir.array<3xi32>>
+! CHECK: fir.call @_QMmPbyval3(%[[PTMP]]#0)
+! CHECK: hlfir.end_associate %[[PTMP]]#1, %[[PTMP]]#2
+subroutine value_seq_parameter()
+ use m
+ call byval3(cp(2))
+end subroutine
+
+! Variable element actual argument takes the same sequence-sized temporary.
+! CHECK-LABEL: func.func @_QPvalue_seq_variable
+! CHECK: %[[VDECL:.*]]:2 = hlfir.declare %{{.*}} {uniq_name = "_QFvalue_seq_variableEv"}
+! CHECK: %[[VELT:.*]] = hlfir.designate %[[VDECL]]#0 (%{{.*}}) : (!fir.ref<!fir.array<4xi32>>, index) -> !fir.ref<i32>
+! CHECK: %[[VSEQ:.*]] = fir.convert %[[VELT]] : (!fir.ref<i32>) -> !fir.ref<!fir.array<3xi32>>
+! CHECK: %[[VVIEW:.*]]:2 = hlfir.declare %[[VSEQ]](%{{.*}}) {uniq_name = ".sequence.assoc"}
+! CHECK: %[[VCOPY:.*]] = hlfir.as_expr %[[VVIEW]]#0 : (!fir.ref<!fir.array<3xi32>>) -> !hlfir.expr<3xi32>
+! CHECK: %[[VTMP:.*]]:3 = hlfir.associate %[[VCOPY]](%{{.*}}) {adapt.valuebyref} : (!hlfir.expr<3xi32>, !fir.shape<1>) -> (!fir.ref<!fir.array<3xi32>>
+! CHECK: fir.call @_QMmPbyval3(%[[VTMP]]#0)
+subroutine value_seq_variable()
+ use m
+ integer :: v(4)
+ v = [1, 2, 3, 4]
+ call byval3(v(2))
+end subroutine
More information about the flang-commits
mailing list