Hi All!
Proposed patch to:
PR100094 - Undefined pointers have incorrect rank when using optimization
Patch tested only on x86_64-pc-linux-gnu.
Pointers, and allocatables, must carry TKR information even when
undefined. The patch adds code to initialize both pointers and
allocatables element size, rank and type as soon as possible to do so.
Latter initialization will work for allocatables, but not for pointers
since one can not test meaningfully the association status of undefined
pointers.
Thank you very much.
Best regards,
José Rui
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.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index be5eb89350f..2bd69724366 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -10920,6 +10920,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);
diff --git a/gcc/testsuite/gfortran.dg/PR100094.f90 b/gcc/testsuite/gfortran.dg/PR100094.f90
new file mode 100644
index 00000000000..f2f7f1631dc
--- /dev/null
+++ b/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
