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
