gcc/testsuite/gfortran.dg/elemental_optional_args_6.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/53692
   4 !
   5 ! Check that the nonabsent arrary is used for scalarization:
   6 ! Either the NONOPTIONAL one or, if there are none, any array.
   7 !
   8 ! Based on a program by Daniel C Chen
   9 !
  10 Program main
  11   implicit none
  12   integer :: arr1(2), arr2(2)
  13   arr1 = [ 1, 2 ]
  14   arr2 = [ 1, 2 ]
  15   call sub1 (arg2=arr2)
  16
  17   call two ()
  18 contains
  19    subroutine sub1 (arg1, arg2)
  20       integer, optional :: arg1(:)
  21       integer :: arg2(:)
  22 !      print *, fun1 (arg1, arg2)
  23       if (size (fun1 (arg1, arg2)) /= 2) call abort() ! { dg-warning "is an array and OPTIONAL" }
  24       if (any (fun1 (arg1, arg2) /= [1,2])) call abort() ! { dg-warning "is an array and OPTIONAL" }
  25    end subroutine
  26
  27    elemental function fun1 (arg1, arg2)
  28       integer,intent(in), optional :: arg1
  29       integer,intent(in)           :: arg2
  30       integer                      :: fun1
  31       fun1 = arg2
  32    end function
  33 end program
  34
  35 subroutine two ()
  36   implicit none
  37   integer :: arr1(2), arr2(2)
  38   arr1 = [ 1, 2 ]
  39   arr2 = [ 1, 2 ]
  40   call sub2 (arr1, arg2=arr2)
  41 contains
  42    subroutine sub2 (arg1, arg2)
  43       integer, optional :: arg1(:)
  44       integer, optional :: arg2(:)
  45 !      print *, fun2 (arg1, arg2)
  46       if (size (fun2 (arg1, arg2)) /= 2) call abort() ! { dg-warning "is an array and OPTIONAL" }
  47       if (any (fun2 (arg1, arg2) /= [1,2])) call abort() ! { dg-warning "is an array and OPTIONAL" }
  48    end subroutine
  49
  50    elemental function fun2 (arg1,arg2)
  51       integer,intent(in), optional :: arg1
  52       integer,intent(in), optional :: arg2
  53       integer                      :: fun2
  54       fun2 = arg2
  55    end function
  56 end subroutine two