[flang-commits] [PATCH] D123731: [flang] Upgrade short actual character arguments to errors

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: clementval.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a project: All.
klausler requested review of this revision.

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.


https://reviews.llvm.org/D123731

Files:
  flang/lib/Semantics/check-call.cpp
  flang/test/Lower/set-length.f90
  flang/test/Semantics/call03.f90


Index: flang/test/Semantics/call03.f90
===================================================================
--- flang/test/Semantics/call03.f90
+++ 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)
Index: flang/test/Lower/set-length.f90
===================================================================
--- 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<!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
Index: flang/lib/Semantics/check-call.cpp
===================================================================
--- flang/lib/Semantics/check-call.cpp
+++ 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<evaluate::SomeType> &actual,
+static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &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);
   }


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D123731.422633.patch
Type: text/x-patch
Size: 3704 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20220413/7bc342f1/attachment.bin>