Fortran: Add missing TKR initialization [PR100094]

gcc/fortran/ChangeLog:

	PR fortran/100094
	* trans-array.c (gfc_trans_deferred_array): Add code to initialize
	pointers and allocatables with correct TKR parameters.

gcc/testsuite/ChangeLog:

	PR fortran/100094
	* gfortran.dg/PR100094.f90: New test.

gcc/fortran/trans-array.c

@@ -10874,6 +10874,20 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
 	}
     }
 
+  /* Set initial TKR for pointers and allocatables */
+  if (GFC_DESCRIPTOR_TYPE_P (type)
+      && (sym->attr.pointer || sym->attr.allocatable))
+    {
+      tree etype;
+
+      gcc_assert (sym->as && sym->as->rank>=0);
+      tmp = gfc_conv_descriptor_dtype (descriptor);
+      etype = gfc_get_element_type (type);
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+  			     TREE_TYPE (tmp), tmp,
+  			     gfc_get_dtype_rank_type (sym->as->rank, etype));
+      gfc_add_expr_to_block (&init, tmp);
+    }
   gfc_restore_backend_locus (&loc);
   gfc_init_block (&cleanup);
 

gcc/testsuite/gfortran.dg/PR100094.f90

@@ -0,0 +1,37 @@
+! { dg-do run }
+!
+! Test the fix for PR100094
+!
+
+program foo_p
+
+  implicit none
+
+  integer, parameter :: n = 11
+  
+  integer, pointer :: pout(:)
+  integer,  target :: a(n)
+  integer          :: i
+  
+  a = [(i, i=1,n)]
+  call foo(pout)
+  if(.not.associated(pout)) stop 1
+  if(.not.associated(pout, a)) stop 2
+  if(any(pout/=a)) stop 3
+  stop
+
+contains
+
+  subroutine foo(that)
+    integer, pointer, intent(out) :: that(..)
+
+    select rank(that)
+    rank(1)
+      that => a
+    rank default
+      stop 4
+    end select
+    return
+  end subroutine foo
+
+end program foo_p