[flang-commits] [flang] [flang] Adjust checks of ICHAR/IACHAR argument length (PR #72312)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/72312

The compiler will now emit an error for length == 0 and an off-by-default portability warning for length > 1.  Previously, the message was an unconditional warning for length /= 1.

>From acea23345464edc46573fd04a8ea31a5e149e1db Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Tue, 14 Nov 2023 13:28:59 -0800
Subject: [PATCH] [flang] Adjust checks of ICHAR/IACHAR argument length

The compiler will now emit an error for length == 0 and an
off-by-default portability warning for length > 1.  Previously,
the message was an unconditional warning for length /= 1.
---
 flang/lib/Evaluate/fold-integer.cpp | 10 ++++++++--
 flang/test/Semantics/ichar01.f90    | 13 +++++++++++++
 2 files changed, 21 insertions(+), 2 deletions(-)
 create mode 100644 flang/test/Semantics/ichar01.f90

diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index dedfc20a491cd88..489102f5277f1f0 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -676,10 +676,16 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
     auto *someChar{UnwrapExpr<Expr<SomeCharacter>>(args[0])};
     CHECK(someChar);
     if (auto len{ToInt64(someChar->LEN())}) {
-      if (len.value() != 1) {
+      if (len.value() < 1) {
+        context.messages().Say(
+            "Character in intrinsic function %s must have length one"_err_en_US,
+            name);
+      } else if (len.value() > 1 &&
+          context.languageFeatures().ShouldWarn(
+              common::UsageWarning::Portability)) {
         // Do not die, this was not checked before
         context.messages().Say(
-            "Character in intrinsic function %s must have length one"_warn_en_US,
+            "Character in intrinsic function %s should have length one"_port_en_US,
             name);
       } else {
         return common::visit(
diff --git a/flang/test/Semantics/ichar01.f90 b/flang/test/Semantics/ichar01.f90
new file mode 100644
index 000000000000000..5eb25a97e6d939e
--- /dev/null
+++ b/flang/test/Semantics/ichar01.f90
@@ -0,0 +1,13 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+!ERROR: Character in intrinsic function ichar must have length one
+print *, ichar('')
+!ERROR: Character in intrinsic function iachar must have length one
+print *, iachar('')
+print *, ichar('a')
+print *, iachar('a')
+!PORTABILITY: Character in intrinsic function ichar should have length one
+print *, ichar('ab')
+!PORTABILITY: Character in intrinsic function iachar should have length one
+print *, iachar('ab')
+end
+