| Message ID | CAGkQGiLeuJJ5h_6Sn8UDwS_A_jjjz2OO_e5KQofLAB9UpwU0Vg@mail.gmail.com |
|---|---|
| State | New |
| Headers | show |
| Series | [fortran] PR93924/5 - [OOP] ICE with procedure pointer | expand |
On 27.01.21 12:52, Paul Richard Thomas via Fortran wrote: > It would be nice to have the patch for PR98573 (posted 23rd Jan) > OK'd before the end of the week. I've just sent some comments (albeit: Thomas has okayed it). > This patch fixes PRs 93924/5. It is another 'obvious' patch, whose > consequences are very limited. LGTM – thanks for the patch, Tobias > > Fortran: Fix ICE due to elemental procedure pointers [PR93924/5]. > > 2021-01-27 Paul Thomas <pault@gcc.gnu.org> > > gcc/fortran > PR fortran/93924 > PR fortran/93925 > * trans-expr.c (gfc_conv_procedure_call): Suppress the call to > gfc_conv_intrinsic_to_class for unlimited polymorphic procedure > pointers. > (gfc_trans_assignment_1): Similarly suppress class assignment > for class valued procedure pointers. > > gcc/testsuite/ > PR fortran/93924 > PR fortran/93925 > * gfortran.dg/proc_ptr_52.f90 : New test. ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 7150e48bc93..b0c8d577ca5 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5772,7 +5772,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, CLASS_DATA (fsym)->attr.class_pointer || CLASS_DATA (fsym)->attr.allocatable); } - else if (UNLIMITED_POLY (fsym) && e->ts.type != BT_CLASS) + else if (UNLIMITED_POLY (fsym) && e->ts.type != BT_CLASS + && gfc_expr_attr (e).flavor != FL_PROCEDURE) { /* The intrinsic type needs to be converted to a temporary CLASS object for the unlimited polymorphic formal. */ @@ -11068,7 +11069,8 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, || gfc_is_class_array_ref (expr1, NULL) || gfc_is_class_scalar_expr (expr1) || gfc_is_class_array_ref (expr2, NULL) - || gfc_is_class_scalar_expr (expr2)); + || gfc_is_class_scalar_expr (expr2)) + && lhs_attr.flavor != FL_PROCEDURE; realloc_flag = flag_realloc_lhs && gfc_is_reallocatable_lhs (expr1)