[flang-commits] [flang] 847c398 - [flang] Upgrade short actual character arguments to errors

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-04-15T20:05:04-07:00
New Revision: 847c39838e21afc1ff4c10258507bef3aafeed78

URL: https://github.com/llvm/llvm-project/commit/847c39838e21afc1ff4c10258507bef3aafeed78
DIFF: https://github.com/llvm/llvm-project/commit/847c39838e21afc1ff4c10258507bef3aafeed78.diff

LOG: [flang] Upgrade short actual character arguments to errors

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.

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

Added: 
    

Modified: 
    flang/lib/Semantics/check-call.cpp
    flang/test/Semantics/call03.f90

Removed: 
    flang/test/Lower/set-length.f90


################################################################################
diff  --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 9f4970c51521e..3410bf541b122 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -79,7 +79,7 @@ static void CheckImplicitInterfaceArg(
 
 // 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 @@ static void PadShortCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
           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 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
 
   // 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
index ece117053dc84..0000000000000
--- a/flang/test/Lower/set-length.f90
+++ /dev/null
@@ -1,28 +0,0 @@
-! Test evaluate::SetLength lowering (used to set a 
diff erent length on a
-! character storage around calls where the dummy and actual length 
diff er).
-! 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

diff  --git a/flang/test/Semantics/call03.f90 b/flang/test/Semantics/call03.f90
index db760335fe3fa..17d185bd9f8e4 100644
--- a/flang/test/Semantics/call03.f90
+++ b/flang/test/Semantics/call03.f90
@@ -151,8 +151,7 @@ subroutine test06 ! 15.5.2.4(4)
     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)