re PR fortran/53692 (OPTIONAL: Scalarizing over the wrong array)
2012-06-18 Tobias Burnus <burnus@net-b.de> PR fortran/53692 * trans-array.c (set_loop_bounds): Don't scalarize via absent optional arrays. * resolve.c (resolve_elemental_actual): Don't stop resolving after printing a warning. 2012-06-18 Tobias Burnus <burnus@net-b.de> PR fortran/53692 * gfortran.dg/elemental_optional_args_6.f90: New. From-SVN: r188749
This commit is contained in:
parent
c1fb34c3ae
commit
478ad83d94
|
@ -1,3 +1,11 @@
|
||||||
|
2012-06-18 Tobias Burnus <burnus@net-b.de>
|
||||||
|
|
||||||
|
PR fortran/53692
|
||||||
|
* trans-array.c (set_loop_bounds): Don't scalarize via absent
|
||||||
|
optional arrays.
|
||||||
|
* resolve.c (resolve_elemental_actual): Don't stop resolving after printing
|
||||||
|
a warning.
|
||||||
|
|
||||||
2012-06-18 Tobias Burnus <burnus@net-b.de>
|
2012-06-18 Tobias Burnus <burnus@net-b.de>
|
||||||
|
|
||||||
PR fortran/53526
|
PR fortran/53526
|
||||||
|
|
|
@ -1957,7 +1957,6 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c)
|
||||||
"ELEMENTAL procedure unless there is a non-optional "
|
"ELEMENTAL procedure unless there is a non-optional "
|
||||||
"argument with the same rank (12.4.1.5)",
|
"argument with the same rank (12.4.1.5)",
|
||||||
arg->expr->symtree->n.sym->name, &arg->expr->where);
|
arg->expr->symtree->n.sym->name, &arg->expr->where);
|
||||||
return FAILURE;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -4337,6 +4337,7 @@ set_loop_bounds (gfc_loopinfo *loop)
|
||||||
bool dynamic[GFC_MAX_DIMENSIONS];
|
bool dynamic[GFC_MAX_DIMENSIONS];
|
||||||
mpz_t *cshape;
|
mpz_t *cshape;
|
||||||
mpz_t i;
|
mpz_t i;
|
||||||
|
bool nonoptional_arr;
|
||||||
|
|
||||||
loopspec = loop->specloop;
|
loopspec = loop->specloop;
|
||||||
|
|
||||||
|
@ -4345,6 +4346,18 @@ set_loop_bounds (gfc_loopinfo *loop)
|
||||||
{
|
{
|
||||||
loopspec[n] = NULL;
|
loopspec[n] = NULL;
|
||||||
dynamic[n] = false;
|
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
|
/* 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. */
|
loop for this dimension. We try to pick the simplest term. */
|
||||||
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
|
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
|
||||||
|
@ -4354,7 +4367,8 @@ set_loop_bounds (gfc_loopinfo *loop)
|
||||||
ss_type = ss->info->type;
|
ss_type = ss->info->type;
|
||||||
if (ss_type == GFC_SS_SCALAR
|
if (ss_type == GFC_SS_SCALAR
|
||||||
|| ss_type == GFC_SS_TEMP
|
|| ss_type == GFC_SS_TEMP
|
||||||
|| ss_type == GFC_SS_REFERENCE)
|
|| ss_type == GFC_SS_REFERENCE
|
||||||
|
|| (ss->info->can_be_null_ref && nonoptional_arr))
|
||||||
continue;
|
continue;
|
||||||
|
|
||||||
info = &ss->info->data.array;
|
info = &ss->info->data.array;
|
||||||
|
|
|
@ -1,3 +1,8 @@
|
||||||
|
2012-06-18 Tobias Burnus <burnus@net-b.de>
|
||||||
|
|
||||||
|
PR fortran/53692
|
||||||
|
* gfortran.dg/elemental_optional_args_6.f90: New.
|
||||||
|
|
||||||
2012-06-18 Tobias Burnus <burnus@net-b.de>
|
2012-06-18 Tobias Burnus <burnus@net-b.de>
|
||||||
|
|
||||||
PR fortran/53526
|
PR fortran/53526
|
||||||
|
|
|
@ -0,0 +1,56 @@
|
||||||
|
! { 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
|
Loading…
Reference in New Issue