[flang] Extension: accept "var*length(bounds)" #117399
Open
+65
−15
Conversation
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 llvm#117372.
llvmbot
added
flang
|
@llvm/pr-subscribers-flang-parser Author: Peter Klausler (klausler) ChangesA 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 #117372. Full diff: https://github.com/llvm/llvm-project/pull/117399.diff 5 Files Affected:
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
+
+
+
|
DanielCChen
approved these changes
Nov 25, 2024
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
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 #117372.