[flang] Allow multiple associations on legacy POINTER declaration

fix that fix

Original-commit: flang-compiler/f18@f096b73842cc0d443517a1075b3a31dd9ed8fdca
Reviewed-on: https://github.com/flang-compiler/f18/pull/352
Tree-same-pre-rewrite: false

diff --git a/flang/lib/parser/dump-parse-tree.h b/flang/lib/parser/dump-parse-tree.h
index 76973e5..4d59a0a 100644 (file)
--- a/flang/lib/parser/dump-parse-tree.h
+++ b/flang/lib/parser/dump-parse-tree.h
@@ -96,6 +96,7 @@ public:
   NODE(parser, AttrSpec)
   NODE(parser, BOZLiteralConstant)
   NODE(parser, BackspaceStmt)
+  NODE(parser, BasedPointer)
   NODE(parser, BasedPointerStmt)
   NODE(parser, BindAttr)
   NODE(parser::BindAttr, Deferred)

diff --git a/flang/lib/parser/grammar.h b/flang/lib/parser/grammar.h
index f466ad0..6fd0b2f 100644 (file)
--- a/flang/lib/parser/grammar.h
+++ b/flang/lib/parser/grammar.h
@@ -3403,9 +3403,10 @@ TYPE_PARSER(
                           construct<CompilerDirective>("DIR$" >> many(name))) /
         endDirective)
 
-TYPE_PARSER(extension<LanguageFeature::CrayPointer>(
-    construct<BasedPointerStmt>("POINTER (" >> objectName / ",", objectName,
-        maybe(Parser<ArraySpec>{}) / ")")))
+TYPE_PARSER(extension<LanguageFeature::CrayPointer>(construct<BasedPointerStmt>(
+    "POINTER" >> nonemptyList("expected POINTER associations"_err_en_US,
+                     construct<BasedPointer>("(" >> objectName / ",",
+                         objectName, maybe(Parser<ArraySpec>{}) / ")")))))
 
 TYPE_PARSER(construct<StructureStmt>("STRUCTURE /" >> name / "/", pure(true),
                 optionalList(entityDecl)) ||

diff --git a/flang/lib/parser/parse-tree.h b/flang/lib/parser/parse-tree.h
index 421753f..2e69993 100644 (file)
--- a/flang/lib/parser/parse-tree.h
+++ b/flang/lib/parser/parse-tree.h
@@ -3166,10 +3166,11 @@ struct CompilerDirective {
 };
 
 // Legacy extensions
-struct BasedPointerStmt {
-  TUPLE_CLASS_BOILERPLATE(BasedPointerStmt);
+struct BasedPointer {
+  TUPLE_CLASS_BOILERPLATE(BasedPointer);
   std::tuple<ObjectName, ObjectName, std::optional<ArraySpec>> t;
 };
+WRAPPER_CLASS(BasedPointerStmt, std::list<BasedPointer>);
 
 struct Union;
 struct StructureDef;

diff --git a/flang/lib/parser/unparse.cc b/flang/lib/parser/unparse.cc
index 3f0f4d1..a173e5e 100644 (file)
--- a/flang/lib/parser/unparse.cc
+++ b/flang/lib/parser/unparse.cc
@@ -2390,11 +2390,11 @@ public:
     Put("\n");
     EndOpenMP();
   }
-  void Unparse(const BasedPointerStmt &x) {
-    Word("POINTER ("), Walk(std::get<0>(x.t)), Put(", ");
-    Walk(std::get<1>(x.t));
+  void Unparse(const BasedPointer &x) {
+    Put('('), Walk(std::get<0>(x.t)), Put(","), Walk(std::get<1>(x.t));
     Walk("(", std::get<std::optional<ArraySpec>>(x.t), ")"), Put(')');
   }
+  void Unparse(const BasedPointerStmt &x) { Walk("POINTER ", x.v, ","); }
   void Post(const StructureField &x) {
     if (const auto *def{std::get_if<Statement<DataComponentDefStmt>>(&x.u)}) {
       for (const auto &decl :