[flang] Add executable tests for conditional expressions (F2023)

Fortran/cray/f2023/10/01/CMakeLists.txt

@@ -0,0 +1,18 @@
+# Exclude tests that require unimplemented feature (conditional expression as
+# actual argument)
+file(GLOB _sources *.f90)
+list(REMOVE_ITEM _sources
+  ${CMAKE_CURRENT_SOURCE_DIR}/condexpr_array_lval_01.f90
+  ${CMAKE_CURRENT_SOURCE_DIR}/condexpr_array_lval_02.f90
+  ${CMAKE_CURRENT_SOURCE_DIR}/condexpr_nil_01.f90
+  ${CMAKE_CURRENT_SOURCE_DIR}/condexpr_nil_02.f90
+  ${CMAKE_CURRENT_SOURCE_DIR}/condexpr_nil_03.f90
+  ${CMAKE_CURRENT_SOURCE_DIR}/condexpr_nil_04.f90
+  ${CMAKE_CURRENT_SOURCE_DIR}/condexpr_nil_05.f90
+  ${CMAKE_CURRENT_SOURCE_DIR}/condexpr_scalar_lval_01.f90
+)
+set(Source ${_sources})
+
+llvm_singlesource()
+
+file(COPY lit.local.cfg DESTINATION "${CMAKE_CURRENT_BINARY_DIR}")

Fortran/cray/f2023/10/01/condexpr_array_lval_01.f90

@@ -0,0 +1,23 @@
+! Test for conditional arguments (Fortran 2023)
+
+module M_condexpr_array_lval_01
+contains
+  subroutine S(X)
+    real    :: X(3)
+    X = 10. * X
+  end subroutine S
+end module M_condexpr_array_lval_01
+
+program main
+  use M_condexpr_array_lval_01
+  real :: A(5), B(5), X(3), Y(3)
+  do i = 1, 5
+     X = [ 17.0, 19.0, 21.0 ]
+     Y = [ 37.0, 39.0, 41.0 ]
+     call S( (mod(i,2) .eq. 0 ? X : Y) )
+     A(i) = X(1) + X(3)
+     B(i) = Y(2) - Y(1)
+  enddo
+  print *, 'A: ', A
+  print *, 'B: ', B
+end program main

Fortran/cray/f2023/10/01/condexpr_array_lval_01.reference_output

@@ -0,0 +1,3 @@
+ A:  38.,  380.,  38.,  380.,  38.
+ B:  20.,  2.,  20.,  2.,  20.
+exit 0

Fortran/cray/f2023/10/01/condexpr_array_lval_02.f90

@@ -0,0 +1,34 @@
+! Test for conditional arguments (Fortran 2023)
+
+module M_condexpr_array_lval_02
+contains
+  subroutine final_sub( S_OUTPUT, S_INPUT  )
+    real, intent(out) :: S_OUTPUT(5)
+    real, intent(in)  :: S_INPUT(5)
+
+    S_OUTPUT = S_INPUT
+  end subroutine final_sub
+
+  subroutine intermediate_sub(cond, ANSWER, TRUE_INPUT, FALSE_INPUT)
+    logical, intent(in)             :: cond
+    real, contiguous, intent(out)   :: ANSWER(:)
+    real, contiguous, intent(in)    :: TRUE_INPUT(:)
+    real, contiguous, intent(in)    :: FALSE_INPUT(:)
+    call final_sub( ANSWER,  (cond ? TRUE_INPUT : FALSE_INPUT))
+  end subroutine intermediate_sub
+end module M_condexpr_array_lval_02
+
+program main
+  use M_condexpr_array_lval_02
+  REAL :: MAIN_A(5)
+  REAL :: MAIN_T(5)
+  REAL :: MAIN_F(5)
+  logical, parameter :: c(5) = [ .false., .true., .true., .false., .true. ]
+
+  do i = 1, 5
+      MAIN_T = [ 1.0, 2.0, 3.0, 4.0, 5.0 ]
+      MAIN_F = MAIN_T + 10.0 !-- [ 11.0, 12.0, 13.0, 14.0, 15.0 ]
+      call intermediate_sub(c(i), MAIN_A, MAIN_T, MAIN_F)
+      print '(I2,": ",5F8.2)', i, MAIN_A
+  enddo
+end program main

Fortran/cray/f2023/10/01/condexpr_array_lval_02.reference_output

@@ -0,0 +1,6 @@
+ 1:    11.00   12.00   13.00   14.00   15.00
+ 2:     1.00    2.00    3.00    4.00    5.00
+ 3:     1.00    2.00    3.00    4.00    5.00
+ 4:    11.00   12.00   13.00   14.00   15.00
+ 5:     1.00    2.00    3.00    4.00    5.00
+exit 0

Fortran/cray/f2023/10/01/condexpr_array_rval_01.f90

@@ -0,0 +1,25 @@
+! Test for conditional expressions (Fortran 2023)
+
+module M_condexpr_array_rval_01
+contains
+  function fs(idx, sz) result(ans)
+    integer :: idx, sz
+    real    :: ans(sz)
+    ans = [ (2.0 * idx * i, i = 1, sz) ]
+  end function fs
+end module M_condexpr_array_rval_01
+
+subroutine S(result, c1, k, sz)
+  use M_condexpr_array_rval_01
+  logical :: c1
+  integer :: k, sz
+  real    :: result(sz)
+  result = ( c1 ? fs(k, sz) : [ 1.0, 2.0, 3.0 ] )
+end subroutine S
+
+program main
+  use M_condexpr_array_rval_01
+  real :: r(3)
+  call S(r, .false., 1, 3); print *, 'False: ', r
+  call S(r, .true.,  2, 3); print *, 'True:  ', r
+end program main

Fortran/cray/f2023/10/01/condexpr_array_rval_01.reference_output

@@ -0,0 +1,3 @@
+ False:  1. 2. 3.
+ True:   4. 8. 12.
+exit 0

Fortran/cray/f2023/10/01/condexpr_nil_01.f90

@@ -0,0 +1,60 @@
+! Test for conditional arguments (Fortran 2023)
+
+module M_condexpr_nil_01
+contains
+  subroutine SO(X, Y, Z)
+    real           :: X
+    real, optional :: Y, Z
+    if ( present(Y) ) then
+       X = X + Y
+       Y = 13.0
+    endif
+    X = X + ( present(Z) ? Z/2.0 : 1000.0 )
+    if ( present(Z) ) Z = 666.0
+  end subroutine SO
+end module M_condexpr_nil_01
+
+module TM_condexpr_nil_01
+contains
+    subroutine test(cc)
+      use M_condexpr_nil_01
+      logical :: cc(:)
+      real :: A, B, C
+      A =   1.0
+      B =  10.0
+      C = 100.0
+      call SO( A, B, C )
+      print '("1: ", 3F10.4)', A, B, C
+
+      A =   2.0
+      B =  20.0
+      C = 200.0
+      call SO( A, (cc(1) ? B : .nil.), (cc(2) ? .nil. : C) )
+      print '("2: ", 3F10.4)', A, B, C
+
+      A =   3.0
+      B =  30.0
+      C = 300.0
+      call SO( A, (cc(3) ? B : .nil.), (cc(4) ? .nil. : C) )
+      print '("3: ", 3F10.4)', A, B, C
+
+      A =   4.0
+      B =  40.0
+      C = 400.0
+      call SO( A, (cc(5) ? B : .nil.), (cc(6) ? .nil. : C) )
+      print '("4: ", 3F10.4)', A, B, C
+
+      A =   5.0
+      B =  50.0
+      C = 500.0
+      call SO( A, (cc(7) ? B : .nil.), (cc(8) ? .nil. : C) )
+      print '("5: ", 3F10.4)', A, B, C
+    end subroutine test
+end module TM_condexpr_nil_01
+
+program main
+  use TM_condexpr_nil_01
+  logical, parameter :: F = .false.
+  logical, parameter :: T = .true.
+  call test( [ F, F, F, T, T, F, T, T ] )
+end program main

Fortran/cray/f2023/10/01/condexpr_nil_01.reference_output

@@ -0,0 +1,6 @@
+ 1:    61.0000   13.0000  666.0000
+ 2:   102.0000   20.0000  666.0000
+ 3:  1003.0000   30.0000  300.0000
+ 4:   244.0000   13.0000  666.0000
+ 5:  1055.0000   13.0000  500.0000
+exit 0

Fortran/cray/f2023/10/01/condexpr_nil_02.f90

@@ -0,0 +1,30 @@
+! Test for conditional arguments (Fortran 2023)
+
+module M_condexpr_nil_02
+contains
+  subroutine test1(idx, A, B, C)
+    implicit none
+    integer :: idx
+    real    :: A(:), B(:), C(:)
+
+    call test2( (idx == 1 ? A : idx == 2 ? B : idx == 3 ? C : .nil.) )
+
+  contains
+    subroutine test2(W)
+      implicit none
+      real, optional :: W(:)
+      if ( present(W) ) W = 1.0
+    end subroutine test2
+  end subroutine test1
+end module M_condexpr_nil_02
+
+program main
+  use M_condexpr_nil_02
+  real :: X(5), Y(5), Z(5)
+
+  do i = 1, 4
+     X = 0.0; Y = 0.0; Z = 0.0
+     call test1( i, X, Y, Z )
+     print '(I2,": ",3F6.2)', i, X(1), Y(3), Z(5)
+  enddo
+end program main

Fortran/cray/f2023/10/01/condexpr_nil_02.reference_output

@@ -0,0 +1,5 @@
+ 1:   1.00  0.00  0.00
+ 2:   0.00  1.00  0.00
+ 3:   0.00  0.00  1.00
+ 4:   0.00  0.00  0.00
+exit 0

Fortran/cray/f2023/10/01/condexpr_nil_03.f90

@@ -0,0 +1,56 @@
+! Test for conditional arguments (Fortran 2023)
+
+module M_condexpr_nil_03
+contains
+  subroutine test1(idx, A)
+    implicit none
+    integer           :: idx, i
+    integer, optional :: A(:)
+    integer           :: B(10)
+
+    B = [(10*i, i=1,10)]
+
+    call test2( A, B, (idx == 1 ? [(i, i=1,5)] : &
+                       idx == 2 ? B(1:10:2)    : &
+                       idx == 3 ? .nil.        : &
+                                  f(B(2))) )
+    if ( present(A) ) then
+       B = -B
+    endif
+    print '(I2,"  B: ",(I6))', B
+
+  contains
+    subroutine test2( X, Y, Z )
+      implicit none
+      integer, optional :: X(:), Z(5)
+      integer           :: Y(5)
+      if ( present(X) ) then
+         X = 3 * Y
+      endif
+      if ( present(Z) ) then
+         Y = Y + Z
+      endif
+    end subroutine test2
+  end subroutine test1
+
+  function f(ival) result(ans)
+    integer :: ival, ans(5)
+    do i = 1, 5
+       ans(i) = ival * i**2
+    enddo
+  end function f
+
+end module M_condexpr_nil_03
+
+program main
+  use M_condexpr_nil_03
+  implicit none
+  integer :: AA(5), i
+  do i = 1, 4
+     call test1(i)
+  enddo
+  do i = 1, 4
+     call test1(i, AA)
+     print '(I2," AA: ",5I6)', i, AA
+  enddo
+end program main

Fortran/cray/f2023/10/01/condexpr_nil_04.f90

@@ -0,0 +1,43 @@
+! Test for conditional arguments (Fortran 2023)
+
+module M_condexpr_nil_04
+contains
+  subroutine test1(idx, A)
+    implicit none
+    integer :: idx, i, A(10), B(10)
+
+    B = [(10*i, i=1,10)]
+
+    ! bad non-contiguous sections to contiguous actual.
+    ! requires copy/restore in conjuction with cond-argument.
+
+    call test2( (idx == 1 ? B(1:10:2) : B(2:10:2)) )
+
+    A = B
+
+  contains
+    subroutine test2( X )
+      implicit none
+      integer, optional :: X(5)
+      X = [(13*i, i = 1,5)]
+    end subroutine test2
+  end subroutine test1
+
+  function f(ival) result(ans)
+    integer :: ival, ans(5)
+    do i = 1, 5
+       ans(i) = ival * i**2
+    enddo
+  end function f
+
+end module M_condexpr_nil_04
+
+program main
+  use M_condexpr_nil_04
+  implicit none
+  integer :: AA(10), i
+  do i = 1, 2
+     call test1(i, AA)
+     print '(I2," AA: ",5I6)', i, AA
+  enddo
+end program main

Fortran/cray/f2023/10/01/condexpr_nil_05.f90

@@ -0,0 +1,47 @@
+! Test for conditional arguments (Fortran 2023)
+
+module M_condexpr_nil_05
+contains
+  subroutine test1(idx, A)
+    implicit none
+    integer :: idx, i, A(10), B(10)
+
+    B = [(10*i, i=1,10)]
+
+    call test2( A, (idx  == 1 ? (idx == 2 ? err() : 23) + f(B) : .nil. ) )
+
+  contains
+     subroutine test2(A, X)
+       integer           :: A(:)
+       integer, optional :: X(:)
+       if ( present(X) ) then
+          A = X
+       else
+          A = 99.0
+       endif
+     end subroutine test2
+
+     elemental function f(ival) result(ans)
+       integer, intent(IN) :: ival
+       integer             :: ans
+       ans = ival**2
+     end function f
+  end subroutine test1
+
+  function err() result(ans)
+    integer ans
+    ans = 0
+    print *, 'ERROR: err should not have been called.'
+  end function err
+
+end module M_condexpr_nil_05
+
+program main
+  use M_condexpr_nil_05
+  implicit none
+  integer :: AA(10), i
+  do i = 1, 2
+     call test1(i, AA)
+     print '(I2," AA: ",(I6))', i, AA
+  enddo
+end program main