[flang] Disallow BOZ literal constants as output list items

[PeteSteinfeld]

Summary

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

[klausler]

flang/lib/Semantics/expression.cpp

159

It would be great if you could use the same capitalization for both of these predicates.

[PeteSteinfeld]

flang/lib/Semantics/expression.cpp

159

Thanks, Peter. Will do.

flang/include/flang/Evaluate/tools.h

template <typename TO> Expr<TO> ConvertToType(BOZLiteralConstant &&x) {
   } else {
     static_assert(TO::category == TypeCategory::Real);
     using Word = typename Scalar<TO>::Word;
     return Expr<TO>{
         Constant<TO>{Scalar<TO>{Word::ConvertUnsigned(std::move(x)).value}}};
   }
 }
 
+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> &&);
 std::optional<Expr<SomeType>> ConvertToType(
     const DynamicType &, std::optional<Expr<SomeType>> &&);
 std::optional<Expr<SomeType>> ConvertToType(const Symbol &, Expr<SomeType> &&);
 std::optional<Expr<SomeType>> ConvertToType(
     const Symbol &, std::optional<Expr<SomeType>> &&);

flang/lib/Evaluate/intrinsics.cpp

if (arg->GetAssumedTypeDummy()) {
             d.keyword);
         return std::nullopt;
       }
     }
     std::optional<DynamicType> type{arg->GetType()};
     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;
         } else {
           const IntrinsicDummyArgument &nextParam{dummy[j + 1]};
           messages.Say(
               "Typeless (BOZ) not allowed for both '%s=' & '%s=' arguments"_err_en_US, // C7109
               d.keyword, nextParam.keyword);

flang/lib/Semantics/check-call.cpp

if (auto type{arg.GetType()}) {
     } else if (const DerivedTypeSpec * derived{GetDerivedTypeSpec(type)}) {
       if (!derived->parameters().empty()) {
         messages.Say(
             "Parameterized derived type argument requires an explicit interface"_err_en_US);
       }
     }
   }
   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)}) {
       const Symbol &symbol{named->GetLastSymbol()};
       if (symbol.Corank() > 0) {
         messages.Say(
             "Coarray argument requires an explicit interface"_err_en_US);
       }
std::visit(
             if (auto *expr{arg.UnwrapExpr()}) {
               if (auto type{characteristics::TypeAndShape::Characterize(
                       *expr, context)}) {
                 arg.set_dummyIntent(object.intent);
                 bool isElemental{object.type.Rank() == 0 && proc.IsElemental()};
                 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)) {
                 // ok, ASSOCIATED(NULL())
               } else if (object.attrs.test(
                              characteristics::DummyDataObject::Attr::Pointer) &&
                   evaluate::IsNullPointer(*expr)) {
                 // ok, FOO(NULL())

flang/lib/Semantics/check-io.cpp

 //===-- lib/Semantics/check-io.cpp ----------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #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"
 #include <unordered_map>
 
 namespace Fortran::semantics {
 
 // TODO: C1234, C1235 -- defined I/O constraints
void IoChecker::Enter(const parser::MsgVariable &var) {
   CheckForDefinableVariable(var, "IOMSG");
   SetSpecifier(IoSpecKind::Iomsg);
 }
 
 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),
             "Output item must not be a procedure pointer"_err_en_US); // C1233
       }
     }
   }
 }

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

 //   constant value or pointer target with class DataInitializationCompiler;
 // - Collects the elemental initializations for each symbol and converts them
 //   into a single init() expression with member function
 //   DataChecker::ConstructInitializer().
 
 #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 {
 
 // Steps through a list of values in a DATA statement set; implements
 // repetition.
 class ValueListIterator {
 public:
if (expr->Rank() > 0) {
       // Because initial-data-target is ambiguous with scalar-constant and
       // scalar-constant-subobject at parse time, enforcement of scalar-*
       // must be deferred to here.
       exprAnalyzer_.Say(
           "DATA statement value initializes '%s' with an array"_err_en_US,
           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,
             DescribeElement(), designatorType->AsFortran());
       } else if (converted->second) {
         exprAnalyzer_.context().Say(
             "DATA statement value initializes '%s' of type '%s' with CHARACTER"_en_US,
             DescribeElement(), designatorType->AsFortran());

flang/lib/Semantics/expression.cpp

private:
   std::optional<ActualArgument> AnalyzeExpr(const parser::Expr &);
   MaybeExpr AnalyzeExprOrWholeAssumedSizeArray(const parser::Expr &);
   bool AreConformable() const;
   const Symbol *FindBoundOp(parser::CharBlock, int passIndex);
   void AddAssignmentConversion(
       const DynamicType &lhsType, const DynamicType &rhsType);
   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);
-  }
+  bool IsBOZLiteral(std::size_t i) const { return IsBozLiteral(GetExpr(i)); }
   void SayNoMatch(const std::string &, bool isAssignment = false);
   std::string TypeAsFortran(std::size_t);
   bool AnyUntypedOrMissingOperand();
 
   ExpressionAnalyzer &context_;
   ActualArguments actuals_;
   parser::CharBlock source_;
   bool fatalErrors_{false};

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

subroutine bozchecks
   !ERROR: Typeless (BOZ) not allowed for both 'i=' & 'j=' arguments
   res = MERGE_BITS(B"1101",B"0011",B"1011")
   res = MERGE_BITS(B"1101",3,B"1011")
 
   res = REAL(B"1101")
 
   !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