[fortran] PR87359 [9 regression] pointer being freed was not allocated

Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 264724)
--- gcc/fortran/trans-array.c	(working copy)
*************** gfc_is_reallocatable_lhs (gfc_expr *expr
*** 9574,9584 ****
  
    sym = expr->symtree->n.sym;
  
!   if (sym->attr.associate_var)
      return false;
  
    /* An allocatable class variable with no reference.  */
    if (sym->ts.type == BT_CLASS
        && CLASS_DATA (sym)->attr.allocatable
        && expr->ref && expr->ref->type == REF_COMPONENT
        && strcmp (expr->ref->u.c.component->name, "_data") == 0
--- 9574,9585 ----
  
    sym = expr->symtree->n.sym;
  
!   if (sym->attr.associate_var && !expr->ref)
      return false;
  
    /* An allocatable class variable with no reference.  */
    if (sym->ts.type == BT_CLASS
+       && !sym->attr.associate_var
        && CLASS_DATA (sym)->attr.allocatable
        && expr->ref && expr->ref->type == REF_COMPONENT
        && strcmp (expr->ref->u.c.component->name, "_data") == 0
*************** gfc_is_reallocatable_lhs (gfc_expr *expr
*** 9587,9595 ****
  
    /* An allocatable variable.  */
    if (sym->attr.allocatable
! 	&& expr->ref
! 	&& expr->ref->type == REF_ARRAY
! 	&& expr->ref->u.ar.type == AR_FULL)
      return true;
  
    /* All that can be left are allocatable components.  */
--- 9588,9597 ----
  
    /* An allocatable variable.  */
    if (sym->attr.allocatable
!       && !sym->attr.associate_var
!       && expr->ref
!       && expr->ref->type == REF_ARRAY
!       && expr->ref->u.ar.type == AR_FULL)
      return true;
  
    /* All that can be left are allocatable components.  */
Index: gcc/testsuite/gfortran.dg/associate_40.f90
===================================================================
*** gcc/testsuite/gfortran.dg/associate_40.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/associate_40.f90	(working copy)
***************
*** 0 ****
--- 1,96 ----
+ ! { dg-do compile }
+ ! { dg-options "-fdump-tree-original" }
+ !
+ ! Test the fix for the second part of PR87359 in which the reallocation on
+ ! assignment for components of associate names was disallowed by r264358.
+ ! -fcheck-all exposed the mismatch in array shapes. The deallocations at
+ ! the end of the main program are there to make sure that valgrind does
+ ! not report an memory leaks.
+ !
+ ! Contributed by Juergen Reuter  <juergen.reuter@desy.de>
+ !
+ module phs_fks
+   implicit none
+   private
+   public :: phs_identifier_t
+   public :: phs_fks_t
+   type :: phs_identifier_t
+      integer, dimension(:), allocatable :: contributors
+   contains
+     procedure :: init => phs_identifier_init
+   end type phs_identifier_t
+ 
+   type :: phs_fks_t
+      type(phs_identifier_t), dimension(:), allocatable :: phs_identifiers
+   end type phs_fks_t
+ contains
+ 
+   subroutine phs_identifier_init &
+      (phs_id, contributors)
+      class(phs_identifier_t), intent(out) :: phs_id
+      integer, intent(in), dimension(:) :: contributors
+      allocate (phs_id%contributors (size (contributors)))
+      phs_id%contributors = contributors
+    end subroutine phs_identifier_init
+ 
+ end module phs_fks
+ 
+ !!!!!
+ 
+ module instances
+   use phs_fks
+   implicit none
+   private
+   public :: process_instance_t
+ 
+   type :: nlo_event_deps_t
+      type(phs_identifier_t), dimension(:), allocatable :: phs_identifiers
+   end type nlo_event_deps_t
+ 
+   type :: process_instance_t
+      type(phs_fks_t), pointer :: phs => null ()
+      type(nlo_event_deps_t) :: event_deps
+    contains
+      procedure :: init => process_instance_init
+      procedure :: setup_real_event_kinematics => pi_setup_real_event_kinematics
+   end type process_instance_t
+ 
+ contains
+ 
+   subroutine process_instance_init (instance)
+     class(process_instance_t), intent(out), target :: instance
+     integer :: i
+     integer :: i_born, i_real
+     allocate (instance%phs)
+   end subroutine process_instance_init
+ 
+   subroutine pi_setup_real_event_kinematics (process_instance)
+     class(process_instance_t), intent(inout) :: process_instance
+     integer :: i_real, i
+     associate (event_deps => process_instance%event_deps)
+        i_real = 2
+        associate (phs => process_instance%phs)
+           allocate (phs%phs_identifiers (3))
+           call phs%phs_identifiers(1)%init ([1])
+           call phs%phs_identifiers(2)%init ([1,2])
+           call phs%phs_identifiers(3)%init ([1,2,3])
+           process_instance%event_deps%phs_identifiers = phs%phs_identifiers  ! Error: mismatch in array shapes.
+        end associate
+     end associate
+   end subroutine pi_setup_real_event_kinematics
+ 
+ end module instances
+ 
+ !!!!!
+ 
+ program main
+   use instances, only: process_instance_t
+   implicit none
+   type(process_instance_t), allocatable, target :: process_instance
+   allocate (process_instance)
+   call process_instance%init ()
+   call process_instance%setup_real_event_kinematics ()
+   if (associated (process_instance%phs)) deallocate (process_instance%phs)
+   if (allocated (process_instance)) deallocate (process_instance)
+ end program main
+ ! { dg-final { scan-tree-dump-times "__builtin_realloc" 2 "original" } }