http://gcc.gnu.org/bugzilla/show_bug.cgi?id=50981
--- Comment #25 from Dominique d'Humieres <dominiq at lps dot ens.fr>
2012-01-20 15:54:14 UTC ---
On x86_64-apple-darwin10, the patch in comments #22 breaks most of the tests I
have for extends_type_of (3 out of 5) and in the test suite (only
gfortran.dg/extends_type_of_2.f03 passes the two other tests
gfortran.dg/extends_type_of_(1.f03|3.f90) fails):
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
I have also another test without extends_type_of which fails:
[macbook] f90/bug% cat oop_14.f90
module realloc
implicit none
type :: base_type
integer :: i =2
contains
procedure :: assign
generic :: assignment(=) => assign ! define generic assignment
end type base_type
type, extends(base_type) :: extended_type
integer :: j =3
end type extended_type
contains
elemental subroutine assign (a, b)
class(base_type), intent(out) :: a
class(base_type), intent(in) :: b
a%i = b%i
end subroutine assign
subroutine reallocate (a)
class(base_type), dimension(:), allocatable, intent(inout) :: a
class(base_type), dimension(:), allocatable :: tmp
allocate (tmp (2 * size (a))) ! how to alloc b with same type as a ?
! This is one way how!
! select type (a)
! type is (base_type); allocate (base_type :: tmp (2 * size (a)))
! type is (extended_type); allocate (extended_type :: tmp (2 * size (a)))
! end select
call print_type ("tmp", tmp)
tmp(:size(a)) = a ! polymorphic l.h.s.
! call move_alloc (from=tmp, to=a) ! remains to be sorted out
end subroutine reallocate
subroutine print_type (name, a)
character(*), intent(in) :: name
class(base_type), dimension(:), intent(in) :: a
select type (a)
type is (base_type); print *, name // " is base_type", a
type is (extended_type); print *, name // " is extended_type", a
end select
end subroutine print_type
end module realloc
program main
use realloc
implicit none
class(base_type), dimension(:), allocatable :: a
! allocate (a(10), source = extended_type(1,2)) ! this works
allocate (extended_type::a(10))
call print_type ("a", a)
call reallocate (a)
call print_type ("a", a)
end program main
[macbook] f90/bug% gfc oop_14.f90
[macbook] f90/bug% a.out
a is extended_type 2 3 2 3 2
3 2 3 2 3 2
3 2 3 2 3 2 3
2 3
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
