gcc/testsuite/gfortran.dg/elemental_optional_args_6.f90

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