[flang] Rewrite I/O units in the parse tree when a variable is not character.

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

flang/lib/parser/dump-parse-tree.h

@@ -127,7 +127,6 @@ public:
   NODE(parser, CharLiteralConstantSubstring)
   NODE(parser, CharSelector)
   NODE(parser::CharSelector, LengthAndKind)
-  NODE(parser, CharVariable)
   NODE(parser, CloseStmt)
   NODE(parser::CloseStmt, CloseSpec)
   NODE(parser, CoarrayAssociation)

flang/lib/parser/grammar.h

@@ -1441,9 +1441,6 @@ TYPE_CONTEXT_PARSER("variable"_en_US,
 // Appears only as part of scalar-logical-variable.
 constexpr auto scalarLogicalVariable{scalar(logical(variable))};
 
-// R905 char-variable -> variable
-constexpr auto charVariable{construct<CharVariable>(variable)};
-
 // R906 default-char-variable -> variable
 // Appears only as part of scalar-default-char-variable.
 constexpr auto scalarDefaultCharVariable{scalar(defaultChar(variable))};
@@ -2422,9 +2419,10 @@ TYPE_CONTEXT_PARSER("UNLOCK statement"_en_US,
 
 // R1201 io-unit -> file-unit-number | * | internal-file-variable
 // R1203 internal-file-variable -> char-variable
+// R905 char-variable -> variable
 // "char-variable" is attempted first since it's not type constrained but
 // syntactically ambiguous with "file-unit-number", which is constrained.
-TYPE_PARSER(construct<IoUnit>(charVariable / !"="_tok) ||
+TYPE_PARSER(construct<IoUnit>(variable / !"="_tok) ||
     construct<IoUnit>(fileUnitNumber) || construct<IoUnit>(star))
 
 // R1202 file-unit-number -> scalar-int-expr

flang/lib/parser/parse-tree.h

@@ -1772,9 +1772,6 @@ struct Variable {
 // Appears only as part of scalar-logical-variable.
 using ScalarLogicalVariable = Scalar<Logical<Variable>>;
 
-// R905 char-variable -> variable
-WRAPPER_CLASS(CharVariable, Variable);
-
 // R906 default-char-variable -> variable
 // Appears only as part of scalar-default-char-variable.
 using ScalarDefaultCharVariable = Scalar<DefaultChar<Variable>>;
@@ -2495,9 +2492,14 @@ WRAPPER_CLASS(FileUnitNumber, ScalarIntExpr);
 
 // R1201 io-unit -> file-unit-number | * | internal-file-variable
 // R1203 internal-file-variable -> char-variable
+// R905 char-variable -> variable
+// When Variable appears as an IoUnit, it must be character of a default,
+// ASCII, or Unicode kind; this constraint is not automatically checked.
+// The parse is ambiguous and is repaired if necessary once the types of
+// symbols are known.
 struct IoUnit {
   UNION_CLASS_BOILERPLATE(IoUnit);
-  std::variant<CharVariable, FileUnitNumber, Star> u;
+  std::variant<Variable, FileUnitNumber, Star> u;
 };
 
 // R1206 file-name-expr -> scalar-default-char-expr

flang/lib/semantics/rewrite-parse-tree.cc

@@ -28,6 +28,8 @@ using namespace parser::literals;
 
 /// Convert mis-identified statement functions to array element assignments.
 /// Convert mis-identified format expressions to namelist group names.
+/// Convert mis-identified character variables in I/O units to integer
+/// unit number expressions.
 class RewriteMutator {
 public:
   RewriteMutator(parser::Messages &messages) : messages_{messages} {}
@@ -39,6 +41,7 @@ public:
   void Post(parser::Name &);
   void Post(parser::SpecificationPart &);
   bool Pre(parser::ExecutionPart &);
+  void Post(parser::IoUnit &);
   void Post(parser::ReadStmt &);
   void Post(parser::WriteStmt &);
 
@@ -105,6 +108,74 @@ bool RewriteMutator::Pre(parser::ExecutionPart &x) {
   return true;
 }
 
+static DeclTypeSpec *GetType(const parser::Name &x) {
+  if (x.symbol != nullptr) {
+    return x.symbol->GetType();
+  } else {
+    return nullptr;
+  }
+}
+static DeclTypeSpec *GetType(const parser::StructureComponent &x) {
+  return GetType(x.component);
+}
+static DeclTypeSpec *GetType(const parser::DataRef &x) {
+  return std::visit(
+      common::visitors{
+          [](const parser::Name &name) { return GetType(name); },
+          [](const common::Indirection<parser::StructureComponent> &sc) {
+            return GetType(sc.value());
+          },
+          [](const common::Indirection<parser::ArrayElement> &sc) {
+            return GetType(sc.value().base);
+          },
+          [](const common::Indirection<parser::CoindexedNamedObject> &ci) {
+            return GetType(ci.value().base);
+          },
+      },
+      x.u);
+}
+static DeclTypeSpec *GetType(const parser::Substring &x) {
+  return GetType(std::get<parser::DataRef>(x.t));
+}
+static DeclTypeSpec *GetType(const parser::Designator &x) {
+  return std::visit([](const auto &y) { return GetType(y); }, x.u);
+}
+static DeclTypeSpec *GetType(const parser::ProcComponentRef &x) {
+  return GetType(x.v.thing);
+}
+static DeclTypeSpec *GetType(const parser::ProcedureDesignator &x) {
+  return std::visit([](const auto &y) { return GetType(y); }, x.u);
+}
+static DeclTypeSpec *GetType(const parser::Call &x) {
+  return GetType(std::get<parser::ProcedureDesignator>(x.t));
+}
+static DeclTypeSpec *GetType(const parser::FunctionReference &x) {
+  return GetType(x.v);
+}
+static DeclTypeSpec *GetType(const parser::Variable &x) {
+  return std::visit(
+      [](const auto &indirection) { return GetType(indirection.value()); },
+      x.u);
+}
+
+void RewriteMutator::Post(parser::IoUnit &x) {
+  if (auto *var{std::get_if<parser::Variable>(&x.u)}) {
+    DeclTypeSpec *type{GetType(*var)};
+    if (type == nullptr || type->category() != DeclTypeSpec::Character) {
+      // If the Variable is not known to be character (any kind), transform
+      // the I/O unit in situ to a FileUnitNumber so that automatic expression
+      // constraint checking will be applied.
+      auto expr{std::visit(
+          [](auto &&indirection) {
+            return parser::Expr{std::move(indirection)};
+          },
+          std::move(var->u))};
+      x.u = parser::FileUnitNumber{
+          parser::ScalarIntExpr{parser::IntExpr{std::move(expr)}}};
+    }
+  }
+}
+
 // When a namelist group name appears (without NML=) in a READ or WRITE
 // statement in such a way that it can be misparsed as a format expression,
 // rewrite the I/O statement's parse tree node as if the namelist group