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!
11Program 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 ()
19contains
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 ! { dg-warning "is an array and OPTIONAL" }
25      if (any (fun1 (arg1, arg2) /= [1,2])) STOP 2 ! { dg-warning "is an array and OPTIONAL" }
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
34end program
35
36subroutine two ()
37  implicit none
38  integer :: arr1(2), arr2(2)
39  arr1 = [ 1, 2 ]
40  arr2 = [ 1, 2 ]
41  call sub2 (arr1, arg2=arr2)
42contains
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
57end subroutine two
58