| ! { dg-do compile } |
| ! |
| ! Test the fix for PR94110 |
| ! |
| |
| program asa_p |
| |
| implicit none |
| |
| integer, parameter :: n = 7 |
| |
| integer :: p(n) |
| integer :: s |
| |
| p = 1 |
| s = sumf_as(p) |
| if (s/=n) stop 1 |
| s = sumf_ar(p) |
| if (s/=n) stop 2 |
| stop |
| |
| contains |
| |
| function sumf_as(a) result(s) |
| integer, target, intent(in) :: a(*) |
| |
| integer :: s |
| |
| s = sum_as(a) ! { dg-error "Actual argument for .a. cannot be an assumed-size array" } |
| s = sum_p_ds(a) ! { dg-error "Actual argument for .a. cannot be an assumed-size array" } |
| s = sum_p_ar(a) ! { dg-error "Actual argument for .a. cannot be an assumed-size array" } |
| return |
| end function sumf_as |
| |
| function sumf_ar(a) result(s) |
| integer, target, intent(in) :: a(..) |
| |
| integer :: s |
| |
| select rank(a) |
| rank(*) |
| s = sum_as(a) ! { dg-error "Actual argument for .a. cannot be an assumed-size array" } |
| s = sum_p_ds(a) ! { dg-error "Actual argument for .a. cannot be an assumed-size array" } |
| s = sum_p_ar(a) ! { dg-error "Actual argument for .a. cannot be an assumed-size array" } |
| rank default |
| stop 3 |
| end select |
| return |
| end function sumf_ar |
| |
| function sum_as(a) result(s) |
| integer, intent(in) :: a(:) |
| |
| integer :: s |
| |
| s = sum(a) |
| return |
| end function sum_as |
| |
| function sum_p_ds(a) result(s) |
| integer, pointer, intent(in) :: a(:) |
| |
| integer :: s |
| |
| s = -1 |
| if(associated(a))& |
| s = sum(a) |
| return |
| end function sum_p_ds |
| |
| function sum_p_ar(a) result(s) |
| integer, pointer, intent(in) :: a(..) |
| |
| integer :: s |
| |
| s = -1 |
| select rank(a) |
| rank(1) |
| if(associated(a))& |
| s = sum(a) |
| rank default |
| stop 4 |
| end select |
| return |
| end function sum_p_ar |
| |
| end program asa_p |
| |