Project

General

Profile

self_vector.f90 Source File

Source Code

!>
!! Provides array-based, self-extending reference vectors of arbitrary type.
!!
module self_vector

    use self_vector_ref
    
    implicit none

    private

    type, extends(vector_ref), public :: vector
    contains
        final :: destroy
        procedure :: add_item
    end type
    interface vector
        module procedure new_empty
        module procedure new_from_array
    end interface vector

contains

    !
    ! type(vector)
    !

    ! constructors

    function new_empty(verbose, initial_size) result(this)
        logical, optional, intent(in) :: verbose
        integer, optional, intent(in) :: initial_size
        type(vector) :: this
        print *, 'vector%new_empty begin'
        this%vector_ref = vector_ref(verbose, initial_size)
        print *, 'vector%new_empty end'
    end function new_empty

    function new_from_array(items, verbose, initial_size) result(this)
        class(*), target, intent(in) :: items(:)
        logical, optional, intent(in) :: verbose
        integer, optional, intent(in) :: initial_size
        type(vector) :: this 
        print *, 'vector%new_from_array begin'
        this%vector_ref = vector_ref(items, verbose, initial_size)
        print *, 'vector%new_from_array end'
    end function new_from_array

    recursive subroutine destroy(this)
        type(vector),intent(inout) :: this
        type(vector_iterator) :: i
        class(*), pointer :: my_stuff
        print *, 'vector%destroy begin'
        i = this%iter()
        do while(i%next(my_stuff))
            if(associated(my_stuff)) then
                deallocate(my_stuff)
            end if
        end do
        print *, 'vector%destroy end'
    end subroutine destroy

    recursive subroutine add_item(this, new_stuff)
        class(vector),intent(inout) :: this
        class(*), target, intent(in) :: new_stuff
        class(*), pointer :: my_stuff
        if(this%get_verbose()) print *, 'vector%add_item begin'
        allocate(my_stuff, source=new_stuff)
        call this%vector_ref%add(my_stuff)
        if(this%get_verbose()) then
            print *, 'added to vector (', this%length(), '/', &
                     this%capacity(), ' elements)'
        end if
        if(this%get_verbose()) print *, 'vector%add_item end'
    end subroutine add_item

end module self_vector

© 2016
self was developed by
Documentation generated by FORD