}
}
+ /* 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);
--- /dev/null
+! { 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