llvm-project/flang/test/Semantics/conditional-expr.f90

! RUN: %python %S/test_errors.py %s %flang_fc1
! Test semantic analysis of conditional expressions (Fortran 2023)

! Valid cases with basic types
subroutine valid_basic_types(flag)
  logical :: flag
  integer :: i1, i2, i3
  real :: r1, r2, r3
  complex :: c1, c2, c3
  logical :: l1, l2, l3
  character(len=5) :: ch1, ch2, ch3

  ! INTEGER conditionals
  i3 = (flag ? i1 : i2)

  ! REAL conditionals
  r3 = (flag ? r1 : r2)

  ! COMPLEX conditionals
  c3 = (flag ? c1 : c2)

  ! LOGICAL conditionals
  l3 = (flag ? l1 : l2)

  ! CHARACTER conditionals
  ch3 = (flag ? ch1 : ch2)
end subroutine

! Valid cases with same kind
subroutine valid_same_kind(flag)
  logical :: flag
  integer(kind=4) :: i4a, i4b, i4c
  integer(kind=8) :: i8a, i8b, i8c
  real(kind=4) :: r4a, r4b, r4c
  real(kind=8) :: r8a, r8b, r8c

  ! Same kind - valid
  i4c = (flag ? i4a : i4b)
  i8c = (flag ? i8a : i8b)
  r4c = (flag ? r4a : r4b)
  r8c = (flag ? r8a : r8b)
end subroutine

! Valid cases with literals
subroutine valid_literals(flag)
  logical :: flag
  integer :: i
  real :: r
  character(len=10) :: ch

  i = (flag ? 10 : 20)
  r = (flag ? 1.0 : 2.0)
  ch = (flag ? "HELLO" : "WORLD")
end subroutine

! Valid cases with nested conditionals
subroutine valid_nested(flag1, flag2, x, y, z, w)
  logical :: flag1, flag2
  integer :: x, y, z, w, result

  ! Nested in value position
  result = (flag1 ? (flag2 ? x : y) : z)

  ! Nested in condition (condition is logical)
  result = ((x > y ? flag1 : flag2) ? w : z)

  ! Multi-branch
  result = (x > 10 ? 100 : x > 5 ? 50 : 0)
end subroutine

! Valid cases with arrays
subroutine valid_arrays(flag)
  logical :: flag
  integer :: arr1(10), arr2(10), arr3(10)
  real :: mat1(3,3), mat2(3,3), mat3(3,3)

  ! Whole array conditional
  arr3 = (flag ? arr1 : arr2)

  ! Multidimensional arrays
  mat3 = (flag ? mat1 : mat2)

  ! Array sections
  arr3(1:5) = (flag ? arr1(1:5) : arr2(1:5))
end subroutine

! Valid cases with derived types
subroutine valid_derived_types(flag)
  type :: point
    real :: x, y
  end type

  logical :: flag
  type(point) :: p1, p2, p3

  p3 = (flag ? p1 : p2)
end subroutine

! Valid cases with character lengths
subroutine valid_character_lengths(flag)
  logical :: flag
  character(len=5) :: short1, short2, short3
  character(len=10) :: medium
  character(len=20) :: long

  ! Same length
  short3 = (flag ? short1 : short2)

  ! Different lengths - padding/truncation applies
  medium = (flag ? short1 : medium)
  long = (flag ? short1 : "A LONGER STRING")
end subroutine

! Valid: deferred-length character scalars
subroutine valid_deferred_length_character(flag)
  logical :: flag
  character(len=:), allocatable :: str1, str2, result

  str1 = "SHORT"
  str2 = "A MUCH LONGER STRING"
  ! Result length is determined by selected branch
  result = (flag ? str1 : str2)
end subroutine

! Valid: assumed-length character arguments
subroutine valid_assumed_length_character(flag, str1, str2)
  logical :: flag
  character(len=*) :: str1, str2
  character(len=100) :: result

  result = (flag ? str1 : str2)
end subroutine

! Error: condition must be logical
subroutine error_non_logical_condition()
  integer :: i, x, y
  real :: r
  character :: ch

  !ERROR: Must have LOGICAL type, but is INTEGER(4)
  i = (i ? x : y)

  !ERROR: Must have LOGICAL type, but is REAL(4)
  i = (r ? x : y)

  !ERROR: Must have LOGICAL type, but is CHARACTER(KIND=1,LEN=1_8)
  i = (ch ? x : y)
end subroutine

! Error: type mismatch between branches
subroutine error_type_mismatch(flag)
  logical :: flag
  integer :: i1, i2
  real :: r
  character :: ch
  complex :: c

  !ERROR: All values in conditional expression must have the same type and kind; have INTEGER(4) and REAL(4)
  i1 = (flag ? i2 : r)

  !ERROR: All values in conditional expression must have the same type and kind; have INTEGER(4) and CHARACTER(KIND=1,LEN=1_8)
  i1 = (flag ? i2 : ch)

  !ERROR: All values in conditional expression must have the same type and kind; have REAL(4) and COMPLEX(4)
  r = (flag ? r : c)

  !ERROR: All values in conditional expression must have the same type and kind; have LOGICAL(4) and INTEGER(4)
  flag = (flag ? flag : i1)
end subroutine

! Error: kind mismatch (F2023 C1004)
subroutine error_kind_mismatch(flag)
  logical :: flag
  integer(kind=4) :: i4
  integer(kind=8) :: i8
  real(kind=4) :: r4
  real(kind=8) :: r8
  complex(kind=4) :: c4
  complex(kind=8) :: c8

  !ERROR: All values in conditional expression must have the same type and kind; have INTEGER(4) and INTEGER(8)
  i4 = (flag ? i4 : i8)

  !ERROR: All values in conditional expression must have the same type and kind; have REAL(4) and REAL(8)
  r4 = (flag ? r4 : r8)

  !ERROR: All values in conditional expression must have the same type and kind; have COMPLEX(4) and COMPLEX(8)
  c4 = (flag ? c4 : c8)
end subroutine

! Error: derived type mismatch
subroutine error_derived_type_mismatch(flag)
  type :: type1
    integer :: i
  end type

  type :: type2
    integer :: i
  end type

  logical :: flag
  type(type1) :: t1
  type(type2) :: t2

  !ERROR: All values in conditional expression must be the same derived type; have type1 and type2
  t1 = (flag ? t1 : t2)
end subroutine

! Error: derived type vs intrinsic type mismatch
subroutine error_derived_vs_intrinsic(flag)
  type :: my_type
    integer :: i
  end type

  logical :: flag
  type(my_type) :: t
  integer :: i
  real :: r

  !ERROR: All values in conditional expression must have the same type and kind; have my_type and INTEGER(4)
  t = (flag ? t : i)

  !ERROR: All values in conditional expression must have the same type and kind; have INTEGER(4) and my_type
  t = (flag ? i : t)

  !ERROR: All values in conditional expression must have the same type and kind; have my_type and REAL(4)
  t = (flag ? t : r)
end subroutine

! Error: array rank mismatch
subroutine error_array_rank_mismatch(flag)
  logical :: flag
  integer :: arr1(10), mat1(3,3), result(10)

  !ERROR: All values in conditional expression must have the same rank; have rank 1 and 2
  result = (flag ? arr1 : mat1)
end subroutine

! Error: scalar vs array mismatch
subroutine error_scalar_array_mismatch(flag)
  logical :: flag
  integer :: scalar, arr(10), result(10)

  !ERROR: All values in conditional expression must have the same rank; have rank 0 and 1
  result = (flag ? scalar : arr)
end subroutine

! Error: condition must be scalar
subroutine error_array_condition()
  logical :: flags(5)
  integer :: x(5), y(5), result(5)

  !ERROR: Must be a scalar value, but is a rank-1 array
  result = (flags ? x : y)
end subroutine

! Valid cases with intrinsic functions
subroutine valid_intrinsic_functions(x, y, flag)
  integer :: x, y
  logical :: flag
  integer :: result

  result = (flag ? abs(x) : abs(y))
  result = (flag ? max(x, y) : min(x, y))
end subroutine

! Valid: conditional in array constructor
subroutine valid_in_array_constructor(flag, x, y)
  logical :: flag
  integer :: x, y, arr(3)

  arr = [(flag ? x : y), (flag ? x + 1 : y + 1), (flag ? x + 2 : y + 2)]
end subroutine

! Valid: conditional in expression context
subroutine valid_in_expression(flag, x, y)
  logical :: flag
  integer :: x, y, z

  z = (flag ? x : y) + 10
  z = 2 * (flag ? x : y)

  if ((flag ? x : y) > 5) then
    z = 1
  end if
end subroutine

! Note: allocatable/pointer differences are handled by assignment semantics
! The conditional expression just requires matching types

! Valid: both branches allocatable
subroutine valid_both_allocatable(flag)
  logical :: flag
  integer, allocatable :: alloc1, alloc2, result

  allocate(result)
  result = (flag ? alloc1 : alloc2)
end subroutine

! Valid: both branches pointer
subroutine valid_both_pointer(flag)
  logical :: flag
  integer, pointer :: ptr1, ptr2, result

  result = (flag ? ptr1 : ptr2)
end subroutine

! Valid: elemental context
elemental integer function conditional_elemental(flag, x, y)
  logical, intent(in) :: flag
  integer, intent(in) :: x, y

  conditional_elemental = (flag ? x : y)
end function

! Valid: pure context
pure integer function conditional_pure(flag, x, y)
  logical, intent(in) :: flag
  integer, intent(in) :: x, y

  conditional_pure = (flag ? x : y)
end function

! Valid: recursive context
recursive integer function conditional_recursive(n, flag, x, y) result(res)
  integer, intent(in) :: n
  logical, intent(in) :: flag
  integer, intent(in) :: x, y

  if (n <= 0) then
    res = (flag ? x : y)
  else
    res = conditional_recursive(n - 1, flag, x, y)
  end if
end function

! Valid: nested multi-branch
subroutine valid_multi_branch(x)
  integer :: x, result

  ! Five-branch conditional
  result = (x > 20 ? 1 : x > 15 ? 2 : x > 10 ? 3 : x > 5 ? 4 : 5)
end subroutine

! Valid: polymorphic types
subroutine valid_polymorphic(flag)
  type :: base_t
    integer :: i
  end type

  logical :: flag
  class(base_t), allocatable :: poly1, poly2, result

  result = (flag ? poly1 : poly2)
end subroutine

! Error: unlimited polymorphic (CLASS(*)) not allowed
subroutine error_unlimited_polymorphic(flag)
  logical :: flag
  class(*), allocatable :: star1, star2, result

  !ERROR: Unlimited polymorphic types (CLASS(*)) not allowed in conditional expression
  result = (flag ? star1 : star2)
end subroutine

! Error: mismatched character kinds
subroutine error_character_kind_mismatch(flag)
  logical :: flag
  character(kind=1, len=5) :: ch1
  character(kind=4, len=5) :: ch4

  !ERROR: All values in conditional expression must have the same type and kind; have CHARACTER(KIND=1,LEN=5_8) and CHARACTER(KIND=4,LEN=5_8)
  ch1 = (flag ? ch1 : ch4)
end subroutine

! Valid: optional arguments
subroutine valid_optional_args(flag, opt_x, opt_y)
  logical :: flag
  integer, optional :: opt_x, opt_y
  integer :: result

  if (present(opt_x) .and. present(opt_y)) then
    result = (flag ? opt_x : opt_y)
  end if
end subroutine

! Valid: mix of expressions and designators
subroutine valid_mixed_expressions(flag, x, y)
  logical :: flag
  integer :: x, y, result

  result = (flag ? x + y : x - y)
  result = (flag ? 2 * x : y / 2)
end subroutine

! Constant-folding: when the condition is a constant, only the selected
! branch must be a constant expression (F2023 10.1.12).
subroutine constant_folding_cases()
  integer :: non_const = 99

  ! Valid: .true. selects 10; non_const is in the unselected else-branch.
  integer, parameter :: p_true_const  = (.true.  ? 10 : non_const)

  ! Valid: .false. selects 10; non_const is in the unselected then-branch.
  integer, parameter :: p_false_const = (.false. ? non_const : 10)

  ! Error: .false. selects non_const — not a constant expression.
  !ERROR: Must be a constant value
  integer, parameter :: p_false_nconst = (.false. ? 10 : non_const)

  ! Error: .true. selects non_const — not a constant expression.
  !ERROR: Must be a constant value
  integer, parameter :: p_true_nconst  = (.true.  ? non_const : 10)
end subroutine

! Module serialization: conditional expressions in a module must be correctly
! written to and read back from the .mod file.
module conditional_expr_mod
  implicit none
contains
  subroutine mod_mixed_expressions(flag, x, y, result)
    logical, intent(in) :: flag
    integer, intent(in) :: x, y
    integer, intent(out) :: result

    result = (flag ? x + y : x - y)
    result = (flag ? 2 * x : y / 2)
  end subroutine
end module

subroutine valid_use_from_module(flag, x, y)
  use conditional_expr_mod
  logical :: flag
  integer :: x, y, result

  call mod_mixed_expressions(flag, x, y, result)
end subroutine