[flang-commits] [flang] [flang] Extension: accept "var*length(bounds)" (PR #117399)
via flang-commits
flang-commits at lists.llvm.org
Fri Nov 22 15:14:20 PST 2024
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-parser
Author: Peter Klausler (klausler)
<details>
<summary>Changes</summary>
A character length specifier in an entity declaration or a component declaration is required by the standard to follow any array bounds or coarray bounds that are present. Several Fortran compilers allow the character length specifier to follow the name and appear before the bounds.
Fixes https://github.com/llvm/llvm-project/issues/117372.
---
Full diff: https://github.com/llvm/llvm-project/pull/117399.diff
5 Files Affected:
- (modified) flang/docs/Extensions.md (+3)
- (modified) flang/include/flang/Parser/parse-tree.h (+18-3)
- (modified) flang/lib/Parser/Fortran-parsers.cpp (+26-12)
- (modified) flang/lib/Parser/type-parsers.h (+1)
- (added) flang/test/Parser/decl-char-length.f90 (+17)
``````````diff
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index f85a3eb39ed191..4b4b516d0fb691 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -391,6 +391,9 @@ end
has the SAVE attribute and was initialized.
* `PRINT namelistname` is accepted and interpreted as
`WRITE(*,NML=namelistname)`, a near-universal extension.
+* A character length specifier in a component or entity declaration
+ is accepted before an array specification (`ch*3(2)`) as well
+ as afterwards.
### Extensions supported when enabled by options
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 22b7f9acd1af52..1f9add6a9a9a4b 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1024,10 +1024,18 @@ struct Initialization {
// R739 component-decl ->
// component-name [( component-array-spec )]
-// [lbracket coarray-spec rbracket] [* char-length]
-// [component-initialization]
+// [lbracket coarray-spec rbracket] [* char-length]
+// [component-initialization] |
+// component-name *char-length [( component-array-spec )]
+// [lbracket coarray-spec rbracket] [component-initialization]
struct ComponentDecl {
TUPLE_CLASS_BOILERPLATE(ComponentDecl);
+ ComponentDecl(Name &&name, CharLength &&length,
+ std::optional<ComponentArraySpec> &&aSpec,
+ std::optional<CoarraySpec> &&coaSpec,
+ std::optional<Initialization> &&init)
+ : t{std::move(name), std::move(aSpec), std::move(coaSpec),
+ std::move(length), std::move(init)} {}
std::tuple<Name, std::optional<ComponentArraySpec>,
std::optional<CoarraySpec>, std::optional<CharLength>,
std::optional<Initialization>>
@@ -1381,9 +1389,16 @@ struct AttrSpec {
// R803 entity-decl ->
// object-name [( array-spec )] [lbracket coarray-spec rbracket]
// [* char-length] [initialization] |
-// function-name [* char-length]
+// function-name [* char-length] |
+// (ext.) object-name *char-length [( array-spec )]
+// [lbracket coarray-spec rbracket] [initialization]
struct EntityDecl {
TUPLE_CLASS_BOILERPLATE(EntityDecl);
+ EntityDecl(ObjectName &&name, CharLength &&length,
+ std::optional<ArraySpec> &&aSpec, std::optional<CoarraySpec> &&coaSpec,
+ std::optional<Initialization> &&init)
+ : t{std::move(name), std::move(aSpec), std::move(coaSpec),
+ std::move(length), std::move(init)} {}
std::tuple<ObjectName, std::optional<ArraySpec>, std::optional<CoarraySpec>,
std::optional<CharLength>, std::optional<Initialization>>
t;
diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp
index 0bdc4c4e033c76..a3d2c363108073 100644
--- a/flang/lib/Parser/Fortran-parsers.cpp
+++ b/flang/lib/Parser/Fortran-parsers.cpp
@@ -460,7 +460,7 @@ TYPE_PARSER(construct<ComponentAttrSpec>(accessSpec) ||
construct<ComponentAttrSpec>(allocatable) ||
construct<ComponentAttrSpec>("CODIMENSION" >> coarraySpec) ||
construct<ComponentAttrSpec>(contiguous) ||
- construct<ComponentAttrSpec>("DIMENSION" >> Parser<ComponentArraySpec>{}) ||
+ construct<ComponentAttrSpec>("DIMENSION" >> componentArraySpec) ||
construct<ComponentAttrSpec>(pointer) ||
extension<LanguageFeature::CUDA>(
construct<ComponentAttrSpec>(Parser<common::CUDADataAttr>{})) ||
@@ -471,17 +471,23 @@ TYPE_PARSER(construct<ComponentAttrSpec>(accessSpec) ||
// R739 component-decl ->
// component-name [( component-array-spec )]
-// [lbracket coarray-spec rbracket] [* char-length]
-// [component-initialization]
+// [lbracket coarray-spec rbracket] [* char-length]
+// [component-initialization] |
+// (ext.) component-name *char-length [(component-array-spec)]
+// [lbracket coarray-spec rbracket] [* char-length]
+// [component-initialization]
TYPE_CONTEXT_PARSER("component declaration"_en_US,
- construct<ComponentDecl>(name, maybe(Parser<ComponentArraySpec>{}),
- maybe(coarraySpec), maybe("*" >> charLength), maybe(initialization)))
+ construct<ComponentDecl>(name, "*" >> charLength, maybe(componentArraySpec),
+ maybe(coarraySpec), maybe(initialization)) ||
+ construct<ComponentDecl>(name, maybe(componentArraySpec),
+ maybe(coarraySpec), maybe("*" >> charLength),
+ maybe(initialization)))
// The source field of the Name will be replaced with a distinct generated name.
TYPE_CONTEXT_PARSER("%FILL item"_en_US,
extension<LanguageFeature::DECStructures>(
"nonstandard usage: %FILL"_port_en_US,
construct<FillDecl>(space >> sourced("%FILL" >> construct<Name>()),
- maybe(Parser<ComponentArraySpec>{}), maybe("*" >> charLength))))
+ maybe(componentArraySpec), maybe("*" >> charLength))))
TYPE_PARSER(construct<ComponentOrFill>(Parser<ComponentDecl>{}) ||
construct<ComponentOrFill>(Parser<FillDecl>{}))
@@ -658,9 +664,13 @@ TYPE_PARSER(recovery("END ENUM"_tok, constructEndStmtErrorRecovery) >>
// R801 type-declaration-stmt ->
// declaration-type-spec [[, attr-spec]... ::] entity-decl-list
-constexpr auto entityDeclWithoutEqInit{construct<EntityDecl>(name,
- maybe(arraySpec), maybe(coarraySpec), maybe("*" >> charLength),
- !"="_tok >> maybe(initialization))}; // old-style REAL A/0/ still works
+constexpr auto entityDeclWithoutEqInit{
+ construct<EntityDecl>(name, "*" >> charLength, maybe(arraySpec),
+ maybe(coarraySpec), !"="_tok >> maybe(initialization)) ||
+ construct<EntityDecl>(name, maybe(arraySpec), maybe(coarraySpec),
+ maybe("*" >> charLength),
+ !"="_tok >>
+ maybe(initialization) /* old-style REAL A/0/ still works */)};
TYPE_PARSER(
construct<TypeDeclarationStmt>(declarationTypeSpec,
defaulted("," >> nonemptyList(Parser<AttrSpec>{})) / "::",
@@ -720,9 +730,13 @@ constexpr auto objectName{name};
// R803 entity-decl ->
// object-name [( array-spec )] [lbracket coarray-spec rbracket]
// [* char-length] [initialization] |
-// function-name [* char-length]
-TYPE_PARSER(construct<EntityDecl>(objectName, maybe(arraySpec),
- maybe(coarraySpec), maybe("*" >> charLength), maybe(initialization)))
+// function-name [* char-length] |
+// (ext.) object-name *char-length [(array-spec)]
+// [lbracket coarray-spec rbracket] [initialization]
+TYPE_PARSER(construct<EntityDecl>(objectName, "*" >> charLength,
+ maybe(arraySpec), maybe(coarraySpec), maybe(initialization)) ||
+ construct<EntityDecl>(objectName, maybe(arraySpec), maybe(coarraySpec),
+ maybe("*" >> charLength), maybe(initialization)))
// R806 null-init -> function-reference ... which must resolve to NULL()
TYPE_PARSER(lookAhead(name / "( )") >> construct<NullInit>(expr))
diff --git a/flang/lib/Parser/type-parsers.h b/flang/lib/Parser/type-parsers.h
index f800398a22de9a..d7e0cd06c3f444 100644
--- a/flang/lib/Parser/type-parsers.h
+++ b/flang/lib/Parser/type-parsers.h
@@ -72,6 +72,7 @@ constexpr Parser<LanguageBindingSpec> languageBindingSpec; // R808, R1528
constexpr Parser<EntityDecl> entityDecl; // R803
constexpr Parser<CoarraySpec> coarraySpec; // R809
constexpr Parser<ArraySpec> arraySpec; // R815
+constexpr Parser<ComponentArraySpec> componentArraySpec;
constexpr Parser<ExplicitShapeSpec> explicitShapeSpec; // R816
constexpr Parser<DeferredShapeSpecList> deferredShapeSpecList; // R820
constexpr Parser<AssumedImpliedSpec> assumedImpliedSpec; // R821
diff --git a/flang/test/Parser/decl-char-length.f90 b/flang/test/Parser/decl-char-length.f90
new file mode 100644
index 00000000000000..c6b39560cb62d2
--- /dev/null
+++ b/flang/test/Parser/decl-char-length.f90
@@ -0,0 +1,17 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+! Test parsing of alternative order of char-length in an
+! entity-decl or component-decl.
+program p
+ type t
+ !CHECK: CHARACTER c1(2_4)*3/"abc", "def"/
+ character c1*3(2)/'abc','def'/
+ end type
+ integer, parameter :: n=3
+ !CHECK: CHARACTER v1(2_4)*(3_4)/"ghi", "jkl"/
+ character v1*(n)(2)/'ghi','jkl'/
+ !CHECK: CHARACTER :: v2(1_4)*2 = "mn"
+ character::v2*2(1)='mn'
+end
+
+
+
``````````
</details>
https://github.com/llvm/llvm-project/pull/117399
More information about the flang-commits
mailing list