[flang] Upgrade short actual character arguments to errors

[klausler]

Summary

f18 was emitting a warning about short character actual arguments to
subprograms and statement functions; every other compiler considers this
case to be an error.

[clementval]

LGTM

flang/lib/Semantics/check-call.cpp

if (IsBOZLiteral(*expr)) {
             "VOLATILE argument requires an explicit interface"_err_en_US);
       }
     }
   }
 }
 
 // When scalar CHARACTER actual arguments are known to be short,
 // we extend them on the right with spaces and a warning.
-static void PadShortCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
+static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
     const characteristics::TypeAndShape &dummyType,
     characteristics::TypeAndShape &actualType,
     evaluate::FoldingContext &context, parser::ContextualMessages &messages) {
   if (dummyType.type().category() == TypeCategory::Character &&
       actualType.type().category() == TypeCategory::Character &&
       dummyType.type().kind() == actualType.type().kind() &&
       GetRank(actualType.shape()) == 0) {
     if (dummyType.LEN() && actualType.LEN()) {
       auto dummyLength{ToInt64(Fold(context, common::Clone(*dummyType.LEN())))};
       auto actualLength{
           ToInt64(Fold(context, common::Clone(*actualType.LEN())))};
       if (dummyLength && actualLength && *actualLength < *dummyLength) {
         messages.Say(
-            "Actual length '%jd' is less than expected length '%jd'"_warn_en_US,
+            "Actual length '%jd' is less than expected length '%jd'"_err_en_US,
             *actualLength, *dummyLength);
+#if 0 // We used to just emit a warning, and padded the actual argument
         auto converted{ConvertToType(dummyType.type(), std::move(actual))};
         CHECK(converted);
         actual = std::move(*converted);
         actualType.set_LEN(SubscriptIntExpr{*dummyLength});
+#endif
       }
     }
   }
 }
 
 // Automatic conversion of different-kind INTEGER scalar actual
 // argument expressions (not variables) to INTEGER scalar dummies.
 // We return nonstandard INTEGER(8) results from intrinsic functions
static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
     const std::string &dummyName, evaluate::Expr<evaluate::SomeType> &actual,
     characteristics::TypeAndShape &actualType, bool isElemental,
     evaluate::FoldingContext &context, const Scope *scope,
     const evaluate::SpecificIntrinsic *intrinsic,
     bool allowIntegerConversions) {
 
   // Basic type & rank checking
   parser::ContextualMessages &messages{context.messages()};
-  PadShortCharacterActual(actual, dummy.type, actualType, context, messages);
+  CheckCharacterActual(actual, dummy.type, actualType, context, messages);
   if (allowIntegerConversions) {
     ConvertIntegerActual(actual, dummy.type, actualType, messages);
   }
   bool typesCompatible{dummy.type.type().IsTkCompatibleWith(actualType.type())};
   if (typesCompatible) {
     if (isElemental) {
     } else if (dummy.type.attrs().test(
                    characteristics::TypeAndShape::Attr::AssumedRank)) {

flang/test/Lower/set-length.f90

-! Test evaluate::SetLength lowering (used to set a different length on a
-! character storage around calls where the dummy and actual length differ).
-! RUN: bbc -emit-fir -o - %s | FileCheck %s
-
-
-subroutine takes_length_4(c)
-  character c(3)*4
-  !do i = 1,3
-  print *, c(i)
-  !enddo
-end
-
-! CHECK-LABEL: func @_QPfoo(
-subroutine foo(c)
-  character c(4)*3
-  ! evaluate::Expr is: CALL s(%SET_LENGTH(c(1_8),4_8)) after semantics.
-  call takes_length_4(c(1))
-! CHECK:         %[[VAL_2:.*]] = arith.constant 4 : i64
-! CHECK:         %[[VAL_6:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref<!fir.array<4x!fir.char<1,3>>>, i64) -> !fir.ref<!fir.char<1,3>>
-! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.ref<!fir.char<1,3>>) -> !fir.ref<!fir.char<1,?>>
-! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_2]] : (i64) -> index
-! CHECK:         %[[VAL_9:.*]] = fir.emboxchar %[[VAL_7]], %[[VAL_8]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
-! CHECK:         fir.call @_QPtakes_length_4(%[[VAL_9]]) : (!fir.boxchar<1>) -> ()
-end subroutine
-
-  character(3) :: c(4) = ["abc", "def", "ghi", "klm"]
-  call foo(c)
-end

flang/test/Semantics/call03.f90

subroutine test06 ! 15.5.2.4(4)
     !ERROR: Type parameter 'n' lacks a value and has no default
     type(pdt) :: vardefault
     type(pdt(3)) :: var3
     type(pdt(4)) :: var4
     type(pdtWithDefault) :: defaultVardefault
     type(pdtWithDefault(3)) :: defaultVar3
     type(pdtWithDefault(4)) :: defaultVar4
     character :: ch1
-    ! The actual argument is converted to a padded expression.
-    !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' must be definable
+    !ERROR: Actual length '1' is less than expected length '2'
     call ch2(ch1)
     call pdtdefault(vardefault)
     call pdtdefault(var3)
     call pdtdefault(var4) ! error
     call pdt3(vardefault) ! error
     !ERROR: Actual argument type 'pdt(n=3_4)' is not compatible with dummy argument type 'pdt(n=4_4)'
     call pdt3(var3) ! error
     call pdt3(var4)