CLASS array patch latest

[Paul Richard Thomas]

Dear All,

Whilst still behind schedule on the class array patch, it is getting
to be more and more complete.  I have attached the latest version,
which successfully deals with the code below, except for the move
alloc.

Remaining to be done are:
(i) Two regressions - class_19.f03 (trivial, as before) and
typebound_assignment_3.f03 (works for class arrays but not derived
type arrays - I cannot see what is going wrong yet);
(ii) move_alloc needs to be implemented with class arrays;
(iii) Some constraints need adding;
(iv) Proper testcases are needed.

It's not far away now.

Cheer

Paul

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
-------------- next part --------------
A non-text attachment was scrubbed...
Name: check1311a.diff
Type: text/x-diff
Size: 43111 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/fortran/attachments/20111113/8adcd009/attachment.bin>