bool dynamic[GFC_MAX_DIMENSIONS];
mpz_t *cshape;
mpz_t i;
+ bool nonoptional_arr;
loopspec = loop->specloop;
{
loopspec[n] = NULL;
dynamic[n] = false;
+
+ /* If there are both optional and nonoptional array arguments, scalarize
+ over the nonoptional; otherwise, it does not matter as then all
+ (optional) arrays have to be present per F2008, 125.2.12p3(6). */
+
+ nonoptional_arr = false;
+
+ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
+ if (ss->info->type != GFC_SS_SCALAR && ss->info->type != GFC_SS_TEMP
+ && ss->info->type != GFC_SS_REFERENCE && !ss->info->can_be_null_ref)
+ nonoptional_arr = true;
+
/* We use one SS term, and use that to determine the bounds of the
loop for this dimension. We try to pick the simplest term. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
ss_type = ss->info->type;
if (ss_type == GFC_SS_SCALAR
|| ss_type == GFC_SS_TEMP
- || ss_type == GFC_SS_REFERENCE)
+ || ss_type == GFC_SS_REFERENCE
+ || (ss->info->can_be_null_ref && nonoptional_arr))
continue;
info = &ss->info->data.array;
--- /dev/null
+! { dg-do run }
+!
+! PR fortran/53692
+!
+! Check that the nonabsent arrary is used for scalarization:
+! Either the NONOPTIONAL one or, if there are none, any array.
+!
+! Based on a program by Daniel C Chen
+!
+Program main
+ implicit none
+ integer :: arr1(2), arr2(2)
+ arr1 = [ 1, 2 ]
+ arr2 = [ 1, 2 ]
+ call sub1 (arg2=arr2)
+
+ call two ()
+contains
+ subroutine sub1 (arg1, arg2)
+ integer, optional :: arg1(:)
+ integer :: arg2(:)
+! print *, fun1 (arg1, arg2)
+ if (size (fun1 (arg1, arg2)) /= 2) call abort() ! { dg-warning "is an array and OPTIONAL" }
+ if (any (fun1 (arg1, arg2) /= [1,2])) call abort() ! { dg-warning "is an array and OPTIONAL" }
+ end subroutine
+
+ elemental function fun1 (arg1, arg2)
+ integer,intent(in), optional :: arg1
+ integer,intent(in) :: arg2
+ integer :: fun1
+ fun1 = arg2
+ end function
+end program
+
+subroutine two ()
+ implicit none
+ integer :: arr1(2), arr2(2)
+ arr1 = [ 1, 2 ]
+ arr2 = [ 1, 2 ]
+ call sub2 (arr1, arg2=arr2)
+contains
+ subroutine sub2 (arg1, arg2)
+ integer, optional :: arg1(:)
+ integer, optional :: arg2(:)
+! print *, fun2 (arg1, arg2)
+ if (size (fun2 (arg1, arg2)) /= 2) call abort() ! { dg-warning "is an array and OPTIONAL" }
+ if (any (fun2 (arg1, arg2) /= [1,2])) call abort() ! { dg-warning "is an array and OPTIONAL" }
+ end subroutine
+
+ elemental function fun2 (arg1,arg2)
+ integer,intent(in), optional :: arg1
+ integer,intent(in), optional :: arg2
+ integer :: fun2
+ fun2 = arg2
+ end function
+end subroutine two