From c7fd821baa5b7e508696478ebcd897c1910e47c8 Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <andre.kuhlenschmidt@gmail.com>
Date: Thu, 28 Aug 2025 14:29:26 -0700
Subject: [PATCH] [flang][folding] fix i(a)char folding regression (#155909)

Fixes a bug in folding "ichar" and "iachar" intrinsics introduced
[here](https://github.com/llvm/llvm-project/commit/c649d31c596e6ca4a19103abba6499ff904ed9cc#r164779170).

There was already a slight bug that the coded didn't fold when
portability warnings were enabled which has also been fixed and tested
for.
---
 flang/lib/Evaluate/fold-integer.cpp   | 11 ++++++-----
 flang/test/Semantics/intrinsics03.f90 |  9 +++++++++
 flang/test/Semantics/intrinsics04.f90 | 11 ++++++++++-
 3 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 00f92d3900c3..3628497531ef 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -1050,12 +1050,13 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
         context.messages().Say(
             "Character in intrinsic function %s must have length one"_err_en_US,
             name);
-      } else if (len.value() > 1) {
-        // Do not die, this was not checked before
-        context.Warn(common::UsageWarning::Portability,
-            "Character in intrinsic function %s should have length one"_port_en_US,
-            name);
       } else {
+        // Do not die, this was not checked before
+        if (len.value() > 1) {
+          context.Warn(common::UsageWarning::Portability,
+              "Character in intrinsic function %s should have length one"_port_en_US,
+              name);
+        }
         return common::visit(
             [&funcRef, &context, &FromInt64](const auto &str) -> Expr<T> {
               using Char = typename std::decay_t<decltype(str)>::Result;
diff --git a/flang/test/Semantics/intrinsics03.f90 b/flang/test/Semantics/intrinsics03.f90
index 03109bc300ca..a5b13b655cf4 100644
--- a/flang/test/Semantics/intrinsics03.f90
+++ b/flang/test/Semantics/intrinsics03.f90
@@ -123,3 +123,12 @@ program test
   call s4(index3)
   call s4(index4) ! ok
 end
+
+subroutine ichar_tests()
+  integer, parameter :: a1 = ichar('B')
+  !Without -Wportability, the warning isn't emitted and the parameter is constant.
+  integer, parameter :: a2 = ichar('B ')
+  !ERROR: Character in intrinsic function ichar must have length one
+  !ERROR: Must be a constant value
+  integer, parameter :: a3 = ichar('')
+end subroutine
diff --git a/flang/test/Semantics/intrinsics04.f90 b/flang/test/Semantics/intrinsics04.f90
index a7d646e5c016..abb8fe321a57 100644
--- a/flang/test/Semantics/intrinsics04.f90
+++ b/flang/test/Semantics/intrinsics04.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Wportability
 ! A potentially absent actual argument cannot require data type conversion.
 subroutine s(o,a,p)
   integer(2), intent(in), optional :: o
@@ -23,3 +23,12 @@ subroutine s(o,a,p)
   print *, min(1_2, 2_2, a) ! ok
   print *, min(1_2, 2_2, p) ! ok
 end
+
+subroutine ichar_tests()
+  integer, parameter :: a1 = ichar('B')
+  !WARNING: Character in intrinsic function ichar should have length one [-Wportability]
+  integer, parameter :: a2 = ichar('B ')
+  !ERROR: Character in intrinsic function ichar must have length one
+  !ERROR: Must be a constant value
+  integer, parameter :: a3 = ichar('')
+end subroutine