diff options
| -rw-r--r-- | gcc/fortran/resolve.c | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr95398.f90 | 53 |
2 files changed, 56 insertions, 1 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 6caddcf..e423271 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9259,7 +9259,9 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) ? CLASS_DATA (code->expr2)->ts.u.derived : code->expr2->ts.u.derived; } - if (code->expr2->rank && CLASS_DATA (code->expr1)->as) + if (code->expr2->rank + && code->expr1->ts.type == BT_CLASS + && CLASS_DATA (code->expr1)->as) CLASS_DATA (code->expr1)->as->rank = code->expr2->rank; /* F2008: C803 The selector expression must not be coindexed. */ diff --git a/gcc/testsuite/gfortran.dg/pr95398.f90 b/gcc/testsuite/gfortran.dg/pr95398.f90 new file mode 100644 index 0000000..81cc076 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr95398.f90 @@ -0,0 +1,53 @@ +! { dg-do compile } + +program test + implicit none + + type :: t1 + integer :: i + end type + + type, extends(t1) :: t2 + end type + + class(t1), allocatable :: array1(:,:) + class(t2), allocatable :: array2(:,:) + + allocate(array1(3,3)) + allocate(array2(3,3)) + + select type(b => foo(1)) + type is (t1) + b%i = 1 + type is (t2) + call sub_with_in_and_inout_param(b,b) + end select + + contains + + function foo(i) + integer :: U(2) + integer :: i + class(t1), POINTER :: foo(:) + ALLOCATE(foo(2)) + U = [ 1,2 ] + if (i>0) then + foo => array1(2,U) + else + foo => array2(2,U) + end if + end function + + subroutine sub_with_in_and_inout_param(y, z) + type(t2), INTENT(IN) :: y(:) + class(t2), INTENT(INOUT) :: z(:) + z%i = 10 + end subroutine + +end + +! { dg-error "cannot be used in a variable definition context .assignment." " " { target *-*-* } 21 } +! { dg-error "cannot be used in a variable definition context .actual argument to INTENT = OUT.INOUT." " " { target *-*-* } 23 } +! { dg-error "Pointer assignment target is neither TARGET nor POINTER" " " { target *-*-* } 35 } +! { dg-error "Pointer assignment target is neither TARGET nor POINTER" " " { target *-*-* } 37 } + |