[gcc r10-8697] Fortran : ICE on invalid code PR95398

[Mark Eggleston]

https://gcc.gnu.org/g:84b14e9cd4e05c926a75e8e97ee57dbd3350e752

commit r10-8697-g84b14e9cd4e05c926a75e8e97ee57dbd3350e752
Author: Mark Eggleston <markeggleston@gcc.gnu.org>
Date:   Mon Jun 1 08:15:31 2020 +0100

    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  <kargl@gcc.gnu.org>
    
    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  <markeggleston@gcc.gnu.org>
    
    gcc/testsuite
    
            PR fortran/95398
            * gfortran.dg/pr95398.f90: New test.
    
    (cherry picked from commit 3d137b75febd1a4ad70bcc64e0f79198f5571b86)

Diff:
---
 gcc/fortran/resolve.c                 |  4 ++-
 gcc/testsuite/gfortran.dg/pr95398.f90 | 53 +++++++++++++++++++++++++++++++++++
 2 files changed, 56 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 3166cc3afc4..533738b0b38 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9235,7 +9235,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 }
+