Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 272076)
--- gcc/fortran/trans-expr.c	(working copy)
*************** class_array_fcn:
*** 4881,4887 ****
      parmse->expr = gfc_build_addr_expr (NULL_TREE, parmse->expr);

    /* Basically make this into
!
       if (present)
         {
  	 if (contiguous)
--- 4881,4887 ----
      parmse->expr = gfc_build_addr_expr (NULL_TREE, parmse->expr);

    /* Basically make this into
!
       if (present)
         {
  	 if (contiguous)
*************** trans_caf_token_assign (gfc_se *lse, gfc
*** 8979,9001 ****
      }
  }

- /* Indentify class valued proc_pointer assignments.  */
-
- static bool
- pointer_assignment_is_proc_pointer (gfc_expr * expr1, gfc_expr * expr2)
- {
-   gfc_ref * ref;
-
-   ref = expr1->ref;
-   while (ref && ref->next)
-      ref = ref->next;
-
-   return ref && ref->type == REF_COMPONENT
-       && ref->u.c.component->attr.proc_pointer
-       && expr2->expr_type == EXPR_VARIABLE
-       && expr2->symtree->n.sym->attr.flavor == FL_PROCEDURE;
- }
-

  /* Do everything that is needed for a CLASS function expr2.  */

--- 8979,8984 ----
*************** gfc_trans_pointer_assignment (gfc_expr *
*** 9048,9054 ****
    tree desc;
    tree tmp;
    tree expr1_vptr = NULL_TREE;
!   bool scalar, non_proc_pointer_assign;
    gfc_ss *ss;

    gfc_start_block (&block);
--- 9031,9037 ----
    tree desc;
    tree tmp;
    tree expr1_vptr = NULL_TREE;
!   bool scalar, non_proc_ptr_assign;
    gfc_ss *ss;

    gfc_start_block (&block);
*************** gfc_trans_pointer_assignment (gfc_expr *
*** 9056,9062 ****
    gfc_init_se (&lse, NULL);

    /* Usually testing whether this is not a proc pointer assignment.  */
!   non_proc_pointer_assign = !pointer_assignment_is_proc_pointer (expr1, expr2);

    /* Check whether the expression is a scalar or not; we cannot use
       expr1->rank as it can be nonzero for proc pointers.  */
--- 9039,9047 ----
    gfc_init_se (&lse, NULL);

    /* Usually testing whether this is not a proc pointer assignment.  */
!   non_proc_ptr_assign = !(gfc_expr_attr (expr1).proc_pointer
! 			&& expr2->expr_type == EXPR_VARIABLE
! 			&& expr2->symtree->n.sym->attr.flavor == FL_PROCEDURE);

    /* Check whether the expression is a scalar or not; we cannot use
       expr1->rank as it can be nonzero for proc pointers.  */
*************** gfc_trans_pointer_assignment (gfc_expr *
*** 9066,9072 ****
      gfc_free_ss_chain (ss);

    if (expr1->ts.type == BT_DERIVED && expr2->ts.type == BT_CLASS
!       && expr2->expr_type != EXPR_FUNCTION && non_proc_pointer_assign)
      {
        gfc_add_data_component (expr2);
        /* The following is required as gfc_add_data_component doesn't
--- 9051,9057 ----
      gfc_free_ss_chain (ss);

    if (expr1->ts.type == BT_DERIVED && expr2->ts.type == BT_CLASS
!       && expr2->expr_type != EXPR_FUNCTION && non_proc_ptr_assign)
      {
        gfc_add_data_component (expr2);
        /* The following is required as gfc_add_data_component doesn't
*************** gfc_trans_pointer_assignment (gfc_expr *
*** 9086,9092 ****
        else
  	gfc_conv_expr (&rse, expr2);

!       if (non_proc_pointer_assign && expr1->ts.type == BT_CLASS)
  	{
  	  trans_class_vptr_len_assignment (&block, expr1, expr2, &rse, NULL,
  					   NULL);
--- 9071,9077 ----
        else
  	gfc_conv_expr (&rse, expr2);

!       if (non_proc_ptr_assign && expr1->ts.type == BT_CLASS)
  	{
  	  trans_class_vptr_len_assignment (&block, expr1, expr2, &rse, NULL,
  					   NULL);
Index: gcc/testsuite/gfortran.dg/proc_ptr_51.f90
===================================================================
*** gcc/testsuite/gfortran.dg/proc_ptr_51.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/proc_ptr_51.f90	(working copy)
***************
*** 0 ****
--- 1,38 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR90786.
+ !
+ ! Contributed by Andrew benson  <abensonca@gmail.com>
+ !
+ module f
+ procedure(c), pointer :: c_
+
+  type :: s
+    integer :: i = 42
+  end type s
+  class(s), pointer :: res, tgt
+
+ contains
+
+  function c()
+    implicit none
+    class(s), pointer ::  c
+    c => tgt
+    return
+  end function c
+
+  subroutine fs()
+    implicit none
+    c_ => c  ! This used to ICE
+    return
+  end subroutine fs
+
+ end module f
+
+   use f
+   allocate (tgt, source = s(99))
+   call fs()
+   res => c_()
+   if (res%i .ne. 99) stop 1
+   deallocate (tgt)
+ end
