Re: [Patch, fortran] PR fortran/84006, PR fortran/100027 - ICE on storage_size with polymorphic argument
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
! { dg-do run }
!
program foo_p
implicit none
integer, parameter :: n = 11
integer, parameter :: foo_size = storage_size(n)*4
integer, parameter :: bar_size = storage_size(n)*(4+8)
type :: foo_t
integer :: arr1(4)
end type foo_t
type, extends(foo_t) :: bar_t
integer :: arr2(8)
end type bar_t
type box_t
class(foo_t), allocatable :: x, y(:)
end type box_t
class(*), pointer :: apu(:)
class(foo_t), pointer :: apf(:)
class(bar_t), pointer :: apb(:)
type(foo_t), target :: atf(n)
type(bar_t), target :: atb(n)
type(box_t), target :: aa, bb
integer :: m
apu => atb
m = storage_size(apu)
if (m /= bar_size) stop
apu => atf
m = storage_size(apu)
if (m /= foo_size) stop
apf => atb
m = storage_size(apf)
if (m /= bar_size) stop
apf => atf
m = storage_size(apf)
if (m /= foo_size) stop
apb => atb
m = storage_size(apb)
if (m /= bar_size) stop
allocate(foo_t :: aa%x, aa%y(1))
allocate(bar_t :: bb%x, bb%y(1))
if (storage_size(aa%x) /= foo_size) stop
if (storage_size(aa%y) /= foo_size) stop
if (storage_size(bb%x) /= bar_size) stop
if (storage_size(bb%y) /= bar_size) stop
apu => bb%y
m = storage_size(apu)
if (m /= bar_size) stop
apu => aa%y
m = storage_size(apu)
if (m /= foo_size) stop
apf => bb%y
m = storage_size(apf)
if (m /= bar_size) stop
apf => aa%y
m = storage_size(apf)
if (m /= foo_size) stop
end program foo_p
[Patch, fortran] PR fortran/84006, PR fortran/100027 - ICE on storage_size with polymorphic argument
Hi All!
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.
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.
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 000..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 000..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
