Cold-Air-Networks/mirror-llvm-project
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 7

[flang] Implemented the RANK clause of an attr-spec, per the Fortran 2023 Standard (#176979)

Browse source 
This implements the RANK clause per the Fortran 2023 Standard. This
includes both the parsing/semantics and un-parsing functionality. It is
a fairly straight-forward change.

An executable test was added that tests the examples from the Fortran
2023 What's New document.

check-flang, check-flang-rt, and llvm-lit tests have been executed
against this change.

---------

Co-authored-by: Kevin Wyatt <kwyatt@hpe.com>
This commit is contained in:
kwyatt-ext 2026-01-27 10:16:17 -06:00 committed by GitHub
parent 24862c2b60
commit 79f5bc4927
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
9 changed files with 206 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
flang/docs/FortranStandardsSupport.md
View file

@ -56,7 +56,7 @@ status of all important Fortran 2023 features. The table entries are based on th
| Simple procedures | N | |
| Using integer arrays to specify subscripts | N | |
| Using integer arrays to specify rank and bound of an array | N | |
| Using an integer constant to specify rank | N | |
| Using an integer constant to specify rank | Y | |
| Reduction specifier for do concurrent | P | Syntax is accepted |
| Enumerations | N | |

1
flang/include/flang/Parser/dump-parse-tree.h
View file

@ -843,6 +843,7 @@ public:
NODE(parser, ProgramUnit)
NODE(parser, Protected)
NODE(parser, ProtectedStmt)
NODE(parser, RankClause)
NODE(parser, ReadStmt)
NODE(parser, RealLiteralConstant)
NODE(RealLiteralConstant, Real)

9
flang/include/flang/Parser/parse-tree.h
View file

@ -1340,12 +1340,17 @@ struct IntentSpec {
WRAPPER_CLASS_BOILERPLATE(IntentSpec, Intent);
};
// F2023_R829 rank-clause ->
// scalar-int-constant-expr
WRAPPER_CLASS(RankClause, ScalarIntConstantExpr);
// R802 attr-spec ->
// access-spec | ALLOCATABLE | ASYNCHRONOUS |
// CODIMENSION lbracket coarray-spec rbracket | CONTIGUOUS |
// DIMENSION ( array-spec ) | EXTERNAL | INTENT ( intent-spec ) |
// INTRINSIC | language-binding-spec | OPTIONAL | PARAMETER | POINTER |
// PROTECTED | SAVE | TARGET | VALUE | VOLATILE |
// PROTECTED | RANK ( scalar-int-constant-expr ) | SAVE | TARGET |
// VALUE | VOLATILE |
// (CUDA) CONSTANT | DEVICE | MANAGED | PINNED | SHARED | TEXTURE
EMPTY_CLASS(Asynchronous);
EMPTY_CLASS(External);
@ -1361,7 +1366,7 @@ struct AttrSpec {
UNION_CLASS_BOILERPLATE(AttrSpec);
std::variant<AccessSpec, Allocatable, Asynchronous, CoarraySpec, Contiguous,
ArraySpec, External, IntentSpec, Intrinsic, LanguageBindingSpec, Optional,
Parameter, Pointer, Protected, Save, Target, Value, Volatile,
Parameter, Pointer, Protected, RankClause, Save, Target, Value, Volatile,
common::CUDADataAttr>
u;
};

5
flang/lib/Parser/Fortran-parsers.cpp
View file

@ -700,7 +700,8 @@ TYPE_PARSER(
// CODIMENSION lbracket coarray-spec rbracket | CONTIGUOUS |
// DIMENSION ( array-spec ) | EXTERNAL | INTENT ( intent-spec ) |
// INTRINSIC | language-binding-spec | OPTIONAL | PARAMETER | POINTER |
// PROTECTED | SAVE | TARGET | VALUE | VOLATILE |
// PROTECTED | RANK ( scalar-int-constant-expr ) | SAVE | TARGET |
// VALUE | VOLATILE |
// CUDA-data-attr
TYPE_PARSER(construct<AttrSpec>(accessSpec) ||
construct<AttrSpec>(allocatable) ||
@ -714,6 +715,8 @@ TYPE_PARSER(construct<AttrSpec>(accessSpec) ||
construct<AttrSpec>(languageBindingSpec) || construct<AttrSpec>(optional) ||
construct<AttrSpec>(construct<Parameter>("PARAMETER"_tok)) ||
construct<AttrSpec>(pointer) || construct<AttrSpec>(protectedAttr) ||
construct<AttrSpec>("RANK" >>
construct<RankClause>(parenthesized(scalarIntConstantExpr))) ||
construct<AttrSpec>(save) ||
construct<AttrSpec>(construct<Target>("TARGET"_tok)) ||
construct<AttrSpec>(construct<Value>("VALUE"_tok)) ||

2
flang/lib/Parser/unparse.cpp
View file

@ -511,6 +511,7 @@ public:
common::visit(common::visitors{
[&](const CoarraySpec &) { Word("CODIMENSION["); },
[&](const ArraySpec &) { Word("DIMENSION("); },
[&](const RankClause &) { Word("RANK("); },
[](const auto &) {},
},
x.u);
@ -519,6 +520,7 @@ public:
common::visit(common::visitors{
[&](const CoarraySpec &) { Put(']'); },
[&](const ArraySpec &) { Put(')'); },
[&](const RankClause &) { Put(')'); },
[](const auto &) {},
},
x.u);

23
flang/lib/Semantics/resolve-names.cpp
View file

@ -14,6 +14,7 @@
#include "resolve-directives.h"
#include "resolve-names-utils.h"
#include "rewrite-parse-tree.h"
#include "flang/Common/Fortran-consts.h"
#include "flang/Common/indirection.h"
#include "flang/Common/restorer.h"
#include "flang/Common/visit.h"
@ -445,6 +446,7 @@ private:
// 6. POINTER(p,x(10))
class ArraySpecVisitor : public virtual BaseVisitor {
public:
void Post(const parser::RankClause &);
void Post(const parser::ArraySpec &);
void Post(const parser::ComponentArraySpec &);
void Post(const parser::CoarraySpec &);
@ -2723,6 +2725,27 @@ bool ImplicitRulesVisitor::HandleImplicitNone(
// ArraySpecVisitor implementation
void ArraySpecVisitor::Post(const parser::RankClause &x) {
// RANK(n) is equivalent to DIMENSION with n deferred shape specs (:)
CHECK(arraySpec_.empty());
// Evaluate the rank value (must be a constant expression)
if (auto rank{EvaluateInt64(context(), x.v)}) {
if (*rank < 0 || *rank > common::maxRank) {
Say(currStmtSource().value(),
"RANK value (%lld) must be between 0 and %d"_err_en_US,
static_cast<long long>(*rank), common::maxRank);
} else {
// Create n deferred shape specs (:)
for (int i = 0; i < *rank; ++i) {
arraySpec_.push_back(ShapeSpec::MakeDeferred());
}
}
} else {
Say("RANK value must be a constant expression"_err_en_US);
}
}
void ArraySpecVisitor::Post(const parser::ArraySpec &x) {
CHECK(arraySpec_.empty());
arraySpec_ = AnalyzeArraySpec(context(), x);

66
flang/test/Lower/rank-clause02.f90 Normal file
View file

@ -0,0 +1,66 @@
! Test the new RANK clause. This uses the examples from the F2023 Standard and
! related explanation documents. This test verifies that RANK clause correctly
! sets the rank of variables in HLFIR lowering output.
!
! RUN: %flang_fc1 -emit-hlfir -o - %s | FileCheck %s
! CHECK-LABEL: func.func @_QQmain() attributes {fir.bindc_name = "RANK_CLAUSE02"}
program rank_clause02
implicit none
! CHECK-DAG: %{{.*}} = fir.address_of(@_QFEx0) : !fir.ref<!fir.array<10x10x10x!fir.logical<4>>>
! CHECK-DAG: %{{.*}} = fir.address_of(@_QFEarray1) : !fir.ref<!fir.array<10x10xi32>>
logical :: X0(10,10,10)
integer :: array1(10,10)
interface
subroutine sub02(arg1)
integer, rank(2) :: arg1
end subroutine
end interface
call sub01(X0)
call sub02(array1)
contains
! CHECK-LABEL: func.func private @_QFPsub01(
! CHECK-SAME: %[[X3_ALLOC:.*]]: !fir.box<!fir.array<?x?x?x!fir.logical<4>>>{{.*}})
subroutine sub01(X3)
! CHECK: %[[X0_ALLOC:.*]] = fir.alloca !fir.array<10x10x10xi32>
! CHECK: %[[X0_DECL:.*]]:2 = hlfir.declare %[[X0_ALLOC]]
integer :: X0(10,10,10)
! CHECK: %[[X1_ALLOC:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x?x?x!fir.logical<4>>>>
! CHECK: %[[X1_DECL:.*]]:2 = hlfir.declare %[[X1_ALLOC]] {{{.*}}fortran_attrs = #fir.var_attrs<allocatable>{{.*}}} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x?x?x!fir.logical<4>>>>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?x?x?x!fir.logical<4>>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x?x?x!fir.logical<4>>>>>)
logical, rank(rank(X0)), allocatable :: X1 ! Rank 3, deferred shape
! CHECK: %[[X2_ALLOC:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x?xcomplex<f32>>>>
! CHECK: %[[X2_DECL:.*]]:2 = hlfir.declare %[[X2_ALLOC]] {{{.*}}fortran_attrs = #fir.var_attrs<pointer>{{.*}}} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xcomplex<f32>>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xcomplex<f32>>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xcomplex<f32>>>>>)
complex, rank(2), pointer :: X2 ! Rank 2, deferred-shape
! CHECK: %[[X3_DECL:.*]]:2 = hlfir.declare %[[X3_ALLOC]] dummy_scope %{{.*}} arg 1 {{.*}}: (!fir.box<!fir.array<?x?x?x!fir.logical<4>>>, !fir.dscope) -> (!fir.box<!fir.array<?x?x?x!fir.logical<4>>>, !fir.box<!fir.array<?x?x?x!fir.logical<4>>>)
logical, rank(rank(X0)) :: X3 ! Rank 3, assumed-shape
! CHECK: %[[X4_ALLOC:.*]] = fir.alloca !fir.box<!fir.heap<f32>>
! CHECK: %[[X4_DECL:.*]]:2 = hlfir.declare %[[X4_ALLOC]] {{{.*}}fortran_attrs = #fir.var_attrs<allocatable>{{.*}}} : (!fir.ref<!fir.box<!fir.heap<f32>>>) -> (!fir.ref<!fir.box<!fir.heap<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>)
real, rank(0) :: X4 ! Scalar
allocatable :: X4
end subroutine
end program
! CHECK-LABEL: func.func @_QPsub02(
! CHECK-SAME: %[[A_ALLOC:.*]]: !fir.box<!fir.array<?x?xi32>>{{.*}})
subroutine sub02(A)
! CHECK: %[[A_DECL:.*]]:2 = hlfir.declare %[[A_ALLOC]] dummy_scope %{{.*}} arg 1 {{.*}}: (!fir.box<!fir.array<?x?xi32>>, !fir.dscope) -> (!fir.box<!fir.array<?x?xi32>>, !fir.box<!fir.array<?x?xi32>>)
integer, rank(2) :: A
! CHECK: %[[B_ALLOC:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x?xi32>>>
! CHECK: %[[B_DECL:.*]]:2 = hlfir.declare %[[B_ALLOC]] {{{.*}}fortran_attrs = #fir.var_attrs<allocatable>{{.*}}} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>)
integer, allocatable, rank(2) :: B
end subroutine

32
flang/test/Parser/unparse-rank-clause.f90 Normal file
View file

@ -0,0 +1,32 @@
! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
! Test unparsing of RANK clause in array declaration statements
subroutine test_rank_clause(X3)
integer :: X0(10,10,10)
logical, rank(rank(X0)), allocatable :: X1 ! Rank 3, deferred shape
complex, rank(2), pointer :: X2 ! Rank 2, deferred-shape
logical, rank(rank(X0)) :: X3 ! Rank 3, assumed-shape
real, allocatable, rank(0) :: X4 ! Scalar
if (rank(X1) == 3 .and. rank(X2) == 2 .and. rank(X3) == 3 .and. &
rank(X4) == 0) then
print *, "PASS"
else
print *, "FAIL"
endif
end subroutine
! CHECK: SUBROUTINE test_rank_clause (x3)
! CHECK: INTEGER x0(10_4,10_4,10_4)
! CHECK: LOGICAL, RANK(3_4), ALLOCATABLE :: x1
! CHECK: COMPLEX, RANK(2_4), POINTER :: x2
! CHECK: LOGICAL, RANK(3_4) :: x3
! CHECK: REAL, ALLOCATABLE, RANK(0_4) :: x4
! CHECK: IF (.true._4) THEN
! CHECK: PRINT *, "PASS"
! CHECK: ELSE
! CHECK: PRINT *, "FAIL"
! CHECK: END IF
! CHECK: END SUBROUTINE

70
flang/test/Semantics/rank-clause01.f90 Normal file
View file

@ -0,0 +1,70 @@
! Test the new RANK clause. This uses the examples from the F2023 Standard and
! related explanation documents.
!
! RUN: %python %S/test_errors.py %s %flang_fc1
program rank_clause01
implicit none
logical :: X0(10,10,10)
integer :: array1(10,10)
interface
subroutine sub02(arg1)
integer, rank(2) :: arg1
end subroutine
end interface
call sub01(X0)
call sub02(array1)
call sub_errors()
contains
subroutine sub01(X3)
integer :: X0(10,10,10)
logical, rank(rank(X0)), allocatable :: X1 ! Rank 3, deferred shape
complex, rank(2), pointer :: X2 ! Rank 2, deferred-shape
logical, rank(rank(X0)) :: X3 ! Rank 3, assumed-shape
real, rank(0) :: X4 ! Scalar
allocatable :: X4
if (rank(X1) == 3 .and. rank(X2) == 2 .and. rank(X3) == 3 .and. &
rank(X4) == 0) then
print *, "PASS"
else
print *, "FAIL"
endif
end subroutine
subroutine sub_errors()
integer :: not_constant
! Rank below range
!ERROR: RANK value (-1) must be between 0 and 15
integer, rank(-1) :: err_rank01
! Rank above range
!ERROR: RANK value (16) must be between 0 and 15
integer, rank(16) :: err_rank02
! Non-Constant
!ERROR: RANK value must be a constant expression
!ERROR: Must be a constant value
integer, rank(not_constant) :: err_rank03
end subroutine
end program
subroutine sub02(A)
integer, rank(2) :: A
integer, allocatable, rank(2) :: B
if (rank(A) == rank(B)) then
print *, "PASS"
else
print *, "FAIL"
endif
end subroutine