[Patch, fortran] PR33986 - ICE on allocatable function result

["Paul Richard Thomas" <paul dot richard dot thomas at gmail dot com>]

:ADDPATCH fortran:

This is another self-explanatory patch, where allocatable function
results were just plain forgotten.

Boostrapped and regtested on x86_ia64 - OK for trunk?

Paul

-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy

Attachment: commit.msg
Description: Binary data

Index: /svn/trunk/gcc/testsuite/gfortran.dg/interface_assignment_3.f90
===================================================================
*** /svn/trunk/gcc/testsuite/gfortran.dg/interface_assignment_3.f90	(revision 0)
--- /svn/trunk/gcc/testsuite/gfortran.dg/interface_assignment_3.f90	(revision 0)
***************
*** 0 ****
--- 1,49 ----
+ ! { dg-do compile }
+ ! Checks the fix for PR34008, in which INTENT(INOUT) was disallowed
+ ! for the first argument of assign_m, whereas both INOUT and OUT
+ ! should be allowed.
+ !
+ ! Contributed by Harald Anlauf <anlauf@gmx.de> 
+ !
+ module mo_memory
+   implicit none
+   type t_mi
+      logical       :: alloc = .false.
+   end type t_mi
+   type t_m
+      type(t_mi)    :: i                         ! meta data
+      real, pointer :: ptr (:,:,:,:) => NULL ()
+   end type t_m
+ 
+   interface assignment (=)
+      module  procedure assign_m
+   end interface
+ contains
+   elemental subroutine assign_m (y, x)
+     !---------------------------------------
+     ! overwrite intrinsic assignment routine
+     !---------------------------------------
+     type (t_m), intent(inout) :: y
+     type (t_m), intent(in)    :: x
+     y% i = x% i
+     if (y% i% alloc) y% ptr = x% ptr
+   end subroutine assign_m
+ end module mo_memory
+ 
+ module gfcbug74
+   use mo_memory, only: t_m, assignment (=)
+   implicit none
+   type t_atm
+      type(t_m) :: m(42)
+   end type t_atm
+ contains
+   subroutine assign_atm_to_atm (y, x)
+     type (t_atm), intent(inout) :: y
+     type (t_atm), intent(in)    :: x
+     integer :: i
+ !   do i=1,42; y% m(i) = x% m(i); end do    ! Works
+     y% m = x% m                             ! ICE
+   end subroutine assign_atm_to_atm
+ end module gfcbug74
+ ! { dg-final { cleanup-modules "mo_memory gfcbug74" } }
+ 
Index: /svn/trunk/gcc/fortran/trans-stmt.c
===================================================================
*** /svn/trunk/gcc/fortran/trans-stmt.c	(revision 130157)
--- /svn/trunk/gcc/fortran/trans-stmt.c	(working copy)
*************** gfc_conv_elemental_dependencies (gfc_se 
*** 246,253 ****
        fsym = formal ? formal->sym : NULL;
        if (e->expr_type == EXPR_VARIABLE
  	    && e->rank && fsym
! 	    && fsym->attr.intent == INTENT_OUT
! 	    && gfc_check_fncall_dependency (e, INTENT_OUT, sym, arg0))
  	{
  	  /* Make a local loopinfo for the temporary creation, so that
  	     none of the other ss->info's have to be renormalized.  */
--- 246,254 ----
        fsym = formal ? formal->sym : NULL;
        if (e->expr_type == EXPR_VARIABLE
  	    && e->rank && fsym
! 	    && fsym->attr.intent != INTENT_IN
! 	    && gfc_check_fncall_dependency (e, fsym->attr.intent,
! 					    sym, arg0))
  	{
  	  /* Make a local loopinfo for the temporary creation, so that
  	     none of the other ss->info's have to be renormalized.  */
*************** gfc_trans_call (gfc_code * code, bool de
*** 380,393 ****
        gfc_copy_loopinfo_to_se (&loopse, &loop);
        loopse.ss = ss;
  
!       /* For operator assignment, we need to do dependency checking.  
! 	 We also check the intent of the parameters.  */
        if (dependency_check)
  	{
  	  gfc_symbol *sym;
  	  sym = code->resolved_sym;
- 	  gcc_assert (sym->formal->sym->attr.intent == INTENT_OUT);
- 	  gcc_assert (sym->formal->next->sym->attr.intent == INTENT_IN);
  	  gfc_conv_elemental_dependencies (&se, &loopse, sym,
  					   code->ext.actual);
  	}
--- 381,391 ----
        gfc_copy_loopinfo_to_se (&loopse, &loop);
        loopse.ss = ss;
  
!       /* For operator assignment, do dependency checking.  */
        if (dependency_check)
  	{
  	  gfc_symbol *sym;
  	  sym = code->resolved_sym;
  	  gfc_conv_elemental_dependencies (&se, &loopse, sym,
  					   code->ext.actual);
  	}