| Message ID | 94a7d760-138c-48e6-b6c8-0a4b91987b28@gmail.com |
|---|---|
| State | New |
| Headers | show |
| Series | [fortran] PR fortran/84006, PR fortran/100027 - ICE on storage_size with polymorphic argument | expand |
Hi José, first, I think you did not yet commit the approved patch for PR100018, did you? On 11.04.21 02:34, José Rui Faustino de Sousa via Fortran wrote: > Proposed patch to: > PR84006 - [8/9/10/11 Regression] ICE in storage_size() with CLASS entity > PR100027 - ICE on storage_size with polymorphic argument > > Patch tested only on x86_64-pc-linux-gnu. LGTM – however, I think it would be useful to also test polymorphic components – and to check whether the result comes out right, especially as you already have a dg-do run test. Hence, how about replacing that testcase by the extended attached testcase? Tobias > Add branch to if clause to handle polymorphic objects, not sure if I > got all possible variations... > > Thank you very much. > > Best regards, > José Rui > > Fortran: Fix ICE using storage_size intrinsic [PR84006, PR100027] > > gcc/fortran/ChangeLog: > > PR fortran/84006 > PR fortran/100027 > * trans-intrinsic.c (gfc_conv_intrinsic_storage_size): add if > clause branch to handle polymorphic objects. > > gcc/testsuite/ChangeLog: > > PR fortran/84006 > * gfortran.dg/PR84006.f90: New test. > > PR fortran/100027 > * gfortran.dg/PR100027.f90: New test. > ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 5e53d1162fa..6536c121f2b 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -8353,10 +8353,16 @@ gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr) if (arg->ts.type == BT_CLASS) { if (arg->rank > 0) - tmp = gfc_class_vtab_size_get ( - GFC_DECL_SAVED_DESCRIPTOR (arg->symtree->n.sym->backend_decl)); + { + if (TREE_CODE (argse.expr) == COMPONENT_REF) + tmp = TREE_OPERAND (argse.expr, 0); + else + tmp = GFC_DECL_SAVED_DESCRIPTOR ( + arg->symtree->n.sym->backend_decl); + } else - tmp = gfc_class_vtab_size_get (TREE_OPERAND (argse.expr, 0)); + tmp = TREE_OPERAND (argse.expr, 0); + tmp = gfc_class_vtab_size_get (tmp); tmp = fold_convert (result_type, tmp); goto done; } diff --git a/gcc/testsuite/gfortran.dg/PR100027.f90 b/gcc/testsuite/gfortran.dg/PR100027.f90 new file mode 100644 index 00000000000..dc565872cac --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100027.f90 @@ -0,0 +1,31 @@ +! { dg-do run } +! + +program foo_p + + implicit none + + integer, parameter :: n = 11 + + type :: foo_t + end type foo_t + + type, extends(foo_t) :: bar_t + end type bar_t + + class(*), pointer :: apu(:) + class(foo_t), pointer :: apf(:) + class(bar_t), pointer :: apb(:) + type(bar_t), target :: atb(n) + + integer :: m + + apu => atb + m = storage_size(apu) + apf => atb + m = storage_size(apf) + apb => atb + m = storage_size(apb) + +end program foo_p + diff --git a/gcc/testsuite/gfortran.dg/PR84006.f90 b/gcc/testsuite/gfortran.dg/PR84006.f90 new file mode 100644 index 00000000000..41e2161b6e5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR84006.f90 @@ -0,0 +1,12 @@ +! { dg-do run } +! + +program p + type t + integer i + end type + integer rslt + class(t), allocatable :: t_alloc(:) + allocate (t_alloc(10), source=t(1)) + rslt = storage_size(t_alloc) +end program p