From 3d137b75febd1a4ad70bcc64e0f79198f5571b86 Mon Sep 17 00:00:00 2001 From: Mark Eggleston Date: Mon, 1 Jun 2020 08:15:31 +0100 Subject: [PATCH] Fortran : ICE on invalid code PR95398 The CLASS_DATA macro is used to shorten the code accessing the derived components of an expressions type specification. If the type is not BT_CLASS the derived pointer is NULL resulting in an ICE. To avoid dereferencing a NULL pointer the type should be BT_CLASS. 2020-09-01 Steven G. Kargl gcc/fortran PR fortran/95398 * resolve.c (resolve_select_type): Add check for BT_CLASS type before using the CLASS_DATA macro which will have a NULL pointer to derive components if it isn't BT_CLASS. 2020-09-01 Mark Eggleston gcc/testsuite PR fortran/95398 * gfortran.dg/pr95398.f90: New test. --- gcc/fortran/resolve.c | 4 +- gcc/testsuite/gfortran.dg/pr95398.f90 | 53 +++++++++++++++++++++++++++ 2 files changed, 56 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/pr95398.f90 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 6caddcf4ef0..e4232717e42 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 00000000000..81cc076c15c --- /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 } + -- 2.30.2