diff options
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/interface.c | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/PR94110.f90 | 88 |
2 files changed, 92 insertions, 1 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 7985fc7..020cdd7 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -3303,7 +3303,10 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, return false; } - if (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE + if (f->sym->as + && (f->sym->as->type == AS_ASSUMED_SHAPE + || f->sym->as->type == AS_DEFERRED + || (f->sym->as->type == AS_ASSUMED_RANK && f->sym->attr.pointer)) && a->expr->expr_type == EXPR_VARIABLE && a->expr->symtree->n.sym->as && a->expr->symtree->n.sym->as->type == AS_ASSUMED_SIZE diff --git a/gcc/testsuite/gfortran.dg/PR94110.f90 b/gcc/testsuite/gfortran.dg/PR94110.f90 new file mode 100644 index 0000000..9ec70ec --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR94110.f90 @@ -0,0 +1,88 @@ +! { 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 + |