diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md index f85a3eb39ed19..4b4b516d0fb69 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 22b7f9acd1af5..1f9add6a9a9a4 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 &&aSpec, + std::optional &&coaSpec, + std::optional &&init) + : t{std::move(name), std::move(aSpec), std::move(coaSpec), + std::move(length), std::move(init)} {} std::tuple, std::optional, std::optional, std::optional> @@ -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 &&aSpec, std::optional &&coaSpec, + std::optional &&init) + : t{std::move(name), std::move(aSpec), std::move(coaSpec), + std::move(length), std::move(init)} {} std::tuple, std::optional, std::optional, std::optional> t; diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp index 0bdc4c4e033c7..a3d2c36310807 100644 --- a/flang/lib/Parser/Fortran-parsers.cpp +++ b/flang/lib/Parser/Fortran-parsers.cpp @@ -460,7 +460,7 @@ TYPE_PARSER(construct(accessSpec) || construct(allocatable) || construct("CODIMENSION" >> coarraySpec) || construct(contiguous) || - construct("DIMENSION" >> Parser{}) || + construct("DIMENSION" >> componentArraySpec) || construct(pointer) || extension( construct(Parser{})) || @@ -471,17 +471,23 @@ TYPE_PARSER(construct(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(name, maybe(Parser{}), - maybe(coarraySpec), maybe("*" >> charLength), maybe(initialization))) + construct(name, "*" >> charLength, maybe(componentArraySpec), + maybe(coarraySpec), maybe(initialization)) || + construct(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( "nonstandard usage: %FILL"_port_en_US, construct(space >> sourced("%FILL" >> construct()), - maybe(Parser{}), maybe("*" >> charLength)))) + maybe(componentArraySpec), maybe("*" >> charLength)))) TYPE_PARSER(construct(Parser{}) || construct(Parser{})) @@ -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(name, - maybe(arraySpec), maybe(coarraySpec), maybe("*" >> charLength), - !"="_tok >> maybe(initialization))}; // old-style REAL A/0/ still works +constexpr auto entityDeclWithoutEqInit{ + construct(name, "*" >> charLength, maybe(arraySpec), + maybe(coarraySpec), !"="_tok >> maybe(initialization)) || + construct(name, maybe(arraySpec), maybe(coarraySpec), + maybe("*" >> charLength), + !"="_tok >> + maybe(initialization) /* old-style REAL A/0/ still works */)}; TYPE_PARSER( construct(declarationTypeSpec, defaulted("," >> nonemptyList(Parser{})) / "::", @@ -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(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(objectName, "*" >> charLength, + maybe(arraySpec), maybe(coarraySpec), maybe(initialization)) || + construct(objectName, maybe(arraySpec), maybe(coarraySpec), + maybe("*" >> charLength), maybe(initialization))) // R806 null-init -> function-reference ... which must resolve to NULL() TYPE_PARSER(lookAhead(name / "( )") >> construct(expr)) diff --git a/flang/lib/Parser/type-parsers.h b/flang/lib/Parser/type-parsers.h index f800398a22de9..d7e0cd06c3f44 100644 --- a/flang/lib/Parser/type-parsers.h +++ b/flang/lib/Parser/type-parsers.h @@ -72,6 +72,7 @@ constexpr Parser languageBindingSpec; // R808, R1528 constexpr Parser entityDecl; // R803 constexpr Parser coarraySpec; // R809 constexpr Parser arraySpec; // R815 +constexpr Parser componentArraySpec; constexpr Parser explicitShapeSpec; // R816 constexpr Parser deferredShapeSpecList; // R820 constexpr Parser 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 0000000000000..c6b39560cb62d --- /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 + + +