Hi All, I must apologise for reintroducing this regression again, after the second application of the fix for PR102689. I must admit that I had totally forgotten about it, even though it was the reason for withdrawing the patch the first time, and the failure was sporadic on my system, so I missed it on regression testing both times around.
I cannot see what is wrong with the element length coming from an explicit typespec in the allocate statement but suppressing its use fixed the problem. I don't especially like increasing the number of arguments in gfc_array_init_size/gfc_array_allocate but it does improve clarity. I have taken the opportunity to effect a temporary fix to the other regression that I caused, PR117901, with the change to class_transformational_1.f90. I prepared a proper patch for this but, in preparing a dedicated testcase, I uncovered other problems that it didn't fix :-( Regression tests OK on Fedora/x86_64 - OK to push? Paul
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 6ff2c238038..9a8477650f4 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -6104,7 +6104,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, stmtblock_t * descriptor_block, tree * overflow, tree expr3_elem_size, tree *nelems, gfc_expr *expr3, tree expr3_desc, bool e3_has_nodescriptor, gfc_expr *expr, - tree *element_size) + tree *element_size, bool explicit_ts) { tree type; tree tmp; @@ -6164,7 +6164,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, tmp = gfc_conv_descriptor_dtype (descriptor); gfc_add_modify (pblock, tmp, gfc_conv_descriptor_dtype (expr3_desc)); } - else if (expr->ts.type == BT_CLASS + else if (expr->ts.type == BT_CLASS && !explicit_ts && expr3 && expr3->ts.type != BT_CLASS && expr3_elem_size != NULL_TREE && expr3_desc == NULL_TREE) { @@ -6469,7 +6469,8 @@ bool gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, tree errlen, tree label_finish, tree expr3_elem_size, tree *nelems, gfc_expr *expr3, tree e3_arr_desc, - bool e3_has_nodescriptor, gfc_omp_namelist *omp_alloc) + bool e3_has_nodescriptor, gfc_omp_namelist *omp_alloc, + bool explicit_ts) { tree tmp; tree pointer; @@ -6601,7 +6602,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, &offset, lower, upper, &se->pre, &set_descriptor_block, &overflow, expr3_elem_size, nelems, expr3, e3_arr_desc, - e3_has_nodescriptor, expr, &element_size); + e3_has_nodescriptor, expr, &element_size, + explicit_ts); if (dimension) { diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index ab27f15cab2..becc8ca4a49 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -22,7 +22,7 @@ along with GCC; see the file COPYING3. If not see se, which should contain an expression for the array descriptor. */ bool gfc_array_allocate (gfc_se *, gfc_expr *, tree, tree, tree, tree, tree, tree *, gfc_expr *, tree, bool, - gfc_omp_namelist *); + gfc_omp_namelist *, bool); /* Allow the bounds of a loop to be set from a callee's array spec. */ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *, diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index b8fba1d91fe..80a9502a8a4 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -6992,7 +6992,8 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate) label_finish, tmp, &nelems, e3rhs ? e3rhs : code->expr3, e3_is == E3_DESC ? expr3 : NULL_TREE, - e3_has_nodescriptor, omp_alloc_item)) + e3_has_nodescriptor, omp_alloc_item, + code->ext.alloc.ts.type != BT_UNKNOWN)) { /* A scalar or derived type. First compute the size to allocate. diff --git a/gcc/testsuite/gfortran.dg/class_transformational_1.f90 b/gcc/testsuite/gfortran.dg/class_transformational_1.f90 index 77ec24a43c0..3e64f5d91e5 100644 --- a/gcc/testsuite/gfortran.dg/class_transformational_1.f90 +++ b/gcc/testsuite/gfortran.dg/class_transformational_1.f90 @@ -169,7 +169,7 @@ contains end subroutine unlimited_rebar (arg) - class(*) :: arg(:) + class(*), allocatable :: arg(:) ! Not having this allocatable => pr117901 call class_bar (arg) end
Change116261.Logs
Description: Binary data