diff options
| author | Tobias Burnus <burnus@net-b.de> | 2012-06-18 20:31:54 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2012-06-18 20:31:54 +0200 |
| commit | 478ad83d94c54c0e8e939336fcfbbfb85529a6d9 (patch) | |
| tree | 3fd75f61b5e57a6a5cac11296c0f7173d323cd01 /gcc/testsuite | |
| parent | c1fb34c3ae740ed96d771e3f2b009e3bf3278242 (diff) | |
| download | gcc-478ad83d94c54c0e8e939336fcfbbfb85529a6d9.zip gcc-478ad83d94c54c0e8e939336fcfbbfb85529a6d9.tar.gz gcc-478ad83d94c54c0e8e939336fcfbbfb85529a6d9.tar.bz2 | |
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
Diffstat (limited to 'gcc/testsuite')
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/elemental_optional_args_6.f90 | 56 |
2 files changed, 61 insertions, 0 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e8c27ec..6dc143e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,10 @@ 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> + PR fortran/53526 * gfortran.dg/coarray_lib_move_alloc_1.f90: New. * gfortran.dg/coarray/move_alloc_1.f90 diff --git a/gcc/testsuite/gfortran.dg/elemental_optional_args_6.f90 b/gcc/testsuite/gfortran.dg/elemental_optional_args_6.f90 new file mode 100644 index 0000000..ad1c252 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/elemental_optional_args_6.f90 @@ -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 |