diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -79,7 +79,7 @@ // 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 &actual, +static void CheckCharacterActual(evaluate::Expr &actual, const characteristics::TypeAndShape &dummyType, characteristics::TypeAndShape &actualType, evaluate::FoldingContext &context, parser::ContextualMessages &messages) { @@ -93,12 +93,14 @@ 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 } } } @@ -152,7 +154,7 @@ // 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); } diff --git a/flang/test/Lower/set-length.f90 b/flang/test/Lower/set-length.f90 deleted file mode 100644 --- a/flang/test/Lower/set-length.f90 +++ /dev/null @@ -1,28 +0,0 @@ -! 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>>, i64) -> !fir.ref> -! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.ref>) -> !fir.ref> -! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_2]] : (i64) -> index -! CHECK: %[[VAL_9:.*]] = fir.emboxchar %[[VAL_7]], %[[VAL_8]] : (!fir.ref>, 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 diff --git a/flang/test/Semantics/call03.f90 b/flang/test/Semantics/call03.f90 --- a/flang/test/Semantics/call03.f90 +++ b/flang/test/Semantics/call03.f90 @@ -151,8 +151,7 @@ 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)