From 5fc355253a7ee250a6321b1e7ef86c1db85ed60d Mon Sep 17 00:00:00 2001
From: Yuao Ma <c8ef@outlook.com>
Date: Mon, 15 Sep 2025 22:05:39 +0800
Subject: [PATCH] fortran: allow character in conditional expression

This patch allows the use of character types in conditional expressions.

gcc/fortran/ChangeLog:

	* resolve.cc (resolve_conditional): Allow character in cond-expr.
	* trans-expr.cc (gfc_conv_conditional_expr): Fill se->string_length.

gcc/testsuite/ChangeLog:

	* gfortran.dg/conditional_1.f90: Test character type.
	* gfortran.dg/conditional_4.f90: Test diagnostic message.
---
 gcc/fortran/resolve.cc                      | 11 +++++++----
 gcc/fortran/trans-expr.cc                   |  5 +++++
 gcc/testsuite/gfortran.dg/conditional_1.f90 |  5 +++++
 gcc/testsuite/gfortran.dg/conditional_4.f90 |  6 +++++-
 4 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index b83961fe6f1..a6f36dcd6f1 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -5036,14 +5036,17 @@ resolve_conditional (gfc_expr *expr)
 
   /* TODO: support more data types for conditional expressions  */
   if (true_expr->ts.type != BT_INTEGER && true_expr->ts.type != BT_LOGICAL
-      && true_expr->ts.type != BT_REAL && true_expr->ts.type != BT_COMPLEX)
+      && true_expr->ts.type != BT_REAL && true_expr->ts.type != BT_COMPLEX
+      && true_expr->ts.type != BT_CHARACTER)
     {
-      gfc_error ("Sorry, only integer, logical, real and complex types "
-		 "are currently supported for conditional expressions at %L",
-		 &expr->where);
+      gfc_error (
+	"Sorry, only integer, logical, real, complex and character types are "
+	"currently supported for conditional expressions at %L",
+	&expr->where);
       return false;
     }
 
+  /* TODO: support array for conditional expressions  */
   if (true_expr->rank > 0)
     {
       gfc_error ("Sorry, array is currently unsupported for conditional "
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 271d2633dfb..2b491b824c5 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -4418,6 +4418,11 @@ gfc_conv_conditional_expr (gfc_se *se, gfc_expr *expr)
 
   se->expr = fold_build3_loc (input_location, COND_EXPR, type, condition,
 			      true_val, false_val);
+  if (expr->ts.type == BT_CHARACTER)
+    se->string_length
+      = fold_build3_loc (input_location, COND_EXPR, gfc_charlen_type_node,
+			 condition, true_se.string_length,
+			 false_se.string_length);
 }
 
 /* If a string's length is one, we convert it to a single character.  */
diff --git a/gcc/testsuite/gfortran.dg/conditional_1.f90 b/gcc/testsuite/gfortran.dg/conditional_1.f90
index ca7d21db1a7..e5397be5604 100644
--- a/gcc/testsuite/gfortran.dg/conditional_1.f90
+++ b/gcc/testsuite/gfortran.dg/conditional_1.f90
@@ -6,6 +6,7 @@ program conditional_simple
   logical :: l = .true.
   real(4) :: r1 = 1.e-4, r2 = 1.e-5
   complex :: z = (3.0, 4.0)
+  character(kind=1, len=5) :: c1 = "hello", c2 = "world"
 
   i = (i > 0 ? 1 : -1)
   if (i /= 1) stop 1
@@ -29,4 +30,8 @@ program conditional_simple
   i = 0
   z = (i /= 0 ? z : (-3.0, -4.0))
   if (z /= (-3.0, -4.0)) stop 6
+
+  i = 0
+  c1 = (i /= 0 ? c1 : c2)
+  if (c1 /= "world") stop 7
 end program conditional_simple
diff --git a/gcc/testsuite/gfortran.dg/conditional_4.f90 b/gcc/testsuite/gfortran.dg/conditional_4.f90
index 38033b9ec1d..5ecf9e0633a 100644
--- a/gcc/testsuite/gfortran.dg/conditional_4.f90
+++ b/gcc/testsuite/gfortran.dg/conditional_4.f90
@@ -10,12 +10,16 @@ program conditional_resolve
   integer, dimension(1, 1) :: a_2d
   logical :: l1(2)
   integer :: i1(2)
+  type :: Point
+    real :: x = 0.0
+  end type Point
+  type(Point) :: p1, p2
 
   i = (l1 ? 1 : -1) ! { dg-error "Condition in conditional expression must be a scalar logical" }
   i = (i ? 1 : -1) ! { dg-error "Condition in conditional expression must be a scalar logical" }
   i = (i /= 0 ? 1 : "oh no") ! { dg-error "must have the same declared type" }
   i = (i /= 0 ? k1 : k4) ! { dg-error "must have the same kind parameter" }
   i = (i /= 0 ? a_1d : a_2d) ! { dg-error "must have the same rank" }
-  k1 = (i /= 0 ? k1 : k1) ! { dg-error "Sorry, only integer, logical, real and complex types are currently supported for conditional expressions" }
+  p1 = (i /= 0 ? p1 : p2) ! { dg-error "Sorry, only integer, logical, real, complex and character types are currently supported for conditional expressions" }
   i1 = (i /= 0 ? i1 : i1 + 1) ! { dg-error "Sorry, array is currently unsupported for conditional expressions" }
 end program conditional_resolve
-- 
2.43.0