[flang] Disallow BOZ literal constants as output list items

According to C7109, "A boz-literal-constant shall appear only as a
data-stmt-constant in a DATA statement, or where explicitly allowed in
16.9 as an actual argument of an intrinsic procedure."  This change
enforces that constraint for output list items.

I also added a general interface to determine if an expression is a BOZ
literal constant and changed all of the places I could find where it
could be used.

I also added a test.

This change stemmed from the following issue --
  https://gitlab-master.nvidia.com/fortran/f18-stage/issues/108

Differential Revision: https://reviews.llvm.org/D106893

flang/include/flang/Evaluate/tools.h

@@ -460,6 +460,10 @@ template <typename TO> Expr<TO> ConvertToType(BOZLiteralConstant &&x) {
   }
 }
 
+template <typename T> bool IsBOZLiteral(const Expr<T> &expr) {
+  return std::holds_alternative<BOZLiteralConstant>(expr.u);
+}
+
 // Conversions to dynamic types
 std::optional<Expr<SomeType>> ConvertToType(
     const DynamicType &, Expr<SomeType> &&);

flang/lib/Evaluate/intrinsics.cpp

@@ -1247,7 +1247,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
     if (!type) {
       CHECK(arg->Rank() == 0);
       const Expr<SomeType> &expr{DEREF(arg->UnwrapExpr())};
-      if (std::holds_alternative<BOZLiteralConstant>(expr.u)) {
+      if (IsBOZLiteral(expr)) {
         if (d.typePattern.kindCode == KindCode::typeless ||
             d.rank == Rank::elementalOrBOZ) {
           continue;

flang/lib/Semantics/check-call.cpp

@@ -46,7 +46,7 @@ static void CheckImplicitInterfaceArg(
     }
   }
   if (const auto *expr{arg.UnwrapExpr()}) {
-    if (std::holds_alternative<evaluate::BOZLiteralConstant>(expr->u)) {
+    if (IsBOZLiteral(*expr)) {
       messages.Say("BOZ argument requires an explicit interface"_err_en_US);
     }
     if (auto named{evaluate::ExtractNamedEntity(*expr)}) {
@@ -632,8 +632,7 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
                 CheckExplicitDataArg(object, dummyName, *expr, *type,
                     isElemental, context, scope, intrinsic);
               } else if (object.type.type().IsTypelessIntrinsicArgument() &&
-                  std::holds_alternative<evaluate::BOZLiteralConstant>(
-                      expr->u)) {
+                  IsBOZLiteral(*expr)) {
                 // ok
               } else if (object.type.type().IsTypelessIntrinsicArgument() &&
                   evaluate::IsNullPointer(*expr)) {

flang/lib/Semantics/check-io.cpp

@@ -8,6 +8,7 @@
 
 #include "check-io.h"
 #include "flang/Common/format.h"
+#include "flang/Evaluate/tools.h"
 #include "flang/Parser/tools.h"
 #include "flang/Semantics/expression.h"
 #include "flang/Semantics/tools.h"
@@ -550,6 +551,10 @@ void IoChecker::Enter(const parser::OutputItem &item) {
   flags_.set(Flag::DataList);
   if (const auto *x{std::get_if<parser::Expr>(&item.u)}) {
     if (const auto *expr{GetExpr(*x)}) {
+      if (evaluate::IsBOZLiteral(*expr)) {
+        context_.Say(parser::FindSourceLocation(*x), // C7109
+            "Output item must not be a BOZ literal constant"_err_en_US);
+      }
       const Symbol *last{GetLastSymbol(*expr)};
       if (last && IsProcedurePointer(*last)) {
         context_.Say(parser::FindSourceLocation(*x),

flang/lib/Semantics/data-to-inits.cpp

@@ -17,6 +17,7 @@
 #include "data-to-inits.h"
 #include "pointer-assignment.h"
 #include "flang/Evaluate/fold-designator.h"
+#include "flang/Evaluate/tools.h"
 #include "flang/Semantics/tools.h"
 
 namespace Fortran::semantics {
@@ -338,7 +339,7 @@ bool DataInitializationCompiler::InitElement(
           DescribeElement());
     } else if (auto converted{ConvertElement(*expr, *designatorType)}) {
       // value non-pointer initialization
-      if (std::holds_alternative<evaluate::BOZLiteralConstant>(expr->u) &&
+      if (IsBOZLiteral(*expr) &&
           designatorType->category() != TypeCategory::Integer) { // 8.6.7(11)
         exprAnalyzer_.Say(
             "BOZ literal should appear in a DATA statement only as a value for an integer object, but '%s' is '%s'"_en_US,

flang/lib/Semantics/expression.cpp

@@ -157,7 +157,7 @@ private:
   bool OkLogicalIntegerAssignment(TypeCategory lhs, TypeCategory rhs);
   int GetRank(std::size_t) const;
   bool IsBOZLiteral(std::size_t i) const {
-    return std::holds_alternative<BOZLiteralConstant>(GetExpr(i).u);
+    return evaluate::IsBOZLiteral(GetExpr(i));
   }
   void SayNoMatch(const std::string &, bool isAssignment = false);
   std::string TypeAsFortran(std::size_t);

flang/test/Semantics/boz-literal-constants.f90

@@ -80,4 +80,7 @@ subroutine bozchecks
 
   !ERROR: BOZ argument requires an explicit interface
   call implictSub(Z'12345')
+
+  !ERROR: Output item must not be a BOZ literal constant
+  print "(Z18)", Z"76543210"
 end subroutine