gcc/testsuite/gfortran.dg/deferred_character_29.f90

! { dg-do compile }
!
! Test the fix for PR83196 comment #4 (there by mistake)
!
! Contributed by Arjen Markus  <arjen.markus895@gmail.com>
!____________________________________________________________
! keyindex.f90 --
!     Class implementing a straightforward keyword/index list
!     The idea is to have a very simple implementation to
!     store keywords (strings) and return the position in the
!     list or vice versa.
!____________________________________________________________
module keyindices
    implicit none

    private

    integer, parameter                              :: default_keylength = 40

    type keyindex
        integer                                     :: keylength
        integer                                     :: lastindex = 0
        character(len=:), dimension(:), allocatable :: keyword
    contains
        procedure                                   :: init      => init_keyindex
        procedure                                   :: get_index => get_index_from_list
        procedure                                   :: get_key   => get_keyword_from_list
        procedure                                   :: has_key   => has_keyword_in_list
    end type keyindex

    public :: keyindex
contains

! init_keyindex --
!     Initialise the object
!
! Arguments:
!     this                     Keyindex object
!     initial_size             Initial size of the list (optimisation)
!     keylength                Maximum length of a keyword (optional)
!
subroutine init_keyindex( this, initial_size, keylength )
    class(keyindex), intent(inout) :: this
    integer, intent(in)           :: initial_size
    integer, intent(in), optional :: keylength

    integer                       :: keylength_

    if ( present(keylength) ) then
        keylength_ = keylength
    else
        keylength_ = default_keylength
    endif

    !
    ! Allocate the list of keywords
    !
    if ( allocated(this%keyword) ) then
        deallocate( this%keyword )
    endif


    allocate( character(len=keylength_):: this%keyword(initial_size) )

    this%lastindex = 0
    this%keylength = keylength_
end subroutine init_keyindex

! get_index_from_list --
!     Look up the keyword in the list and return its index
!
! Arguments:
!     this                     Keyindex object
!     keyword                  Keyword to be looked up
!
! Returns:
!     Index in the list
!
! Note:
!     If the keyword does not yet exist, add it to the list
!
integer function get_index_from_list( this, keyword )
    class(keyindex), intent(inout) :: this
    character(len=*), intent(in)  :: keyword

    integer                       :: i
    character(len=this%keylength), dimension(:), allocatable :: newlist

    if ( .not. allocated(this%keyword) ) then
        call this%init( 50 )
    endif

    get_index_from_list = 0

    do i = 1,this%lastindex
        if ( this%keyword(i) == keyword ) then
            get_index_from_list = i
            exit
        endif
    enddo

    !
    ! Do we need to add it?
    !
    if ( get_index_from_list == 0 ) then
        if ( size(this%keyword) <= this%lastindex ) then
            !
            ! Allocate a larger list
            !
            allocate( character(len=this%keylength):: newlist(2*size(this%keyword)) )

            newlist(1:size(this%keyword)) = this%keyword
            call move_alloc( newlist, this%keyword )
        endif

        get_index_from_list = this%lastindex + 1
        this%lastindex      = get_index_from_list
        this%keyword(get_index_from_list) = keyword
    endif
end function get_index_from_list

! get_keyword_from_list --
!     Look up the keyword in the list by the given index
!
! Arguments:
!     this                     Keyindex object
!     idx                      Index of the keyword
!
! Returns:
!     Keyword as stored in the list
!
! Note:
!     If the index does not exist, an empty string is returned
!
function get_keyword_from_list( this, idx )
    class(keyindex), intent(inout) :: this
    integer, intent(in)            :: idx

    character(len=this%keylength)  :: get_keyword_from_list

    get_keyword_from_list = ' '

    if ( idx >= 1 .and. idx <= this%lastindex ) then
        get_keyword_from_list = this%keyword(idx)
    endif
end function get_keyword_from_list

! has_keyword_in_list --
!     Look up whether the keyword is stored in the list or not
!
! Arguments:
!     this                     Keyindex object
!     keyword                  Keyword to be looked up
!
! Returns:
!     True if the keyword is in the list or false if not
!
logical function has_keyword_in_list( this, keyword )
    class(keyindex), intent(inout) :: this
    character(len=*), intent(in)  :: keyword

    integer                       :: i

    has_keyword_in_list = .false.

    do i = 1,this%lastindex
        if ( this%keyword(i) == keyword ) then
            has_keyword_in_list = .true.
            exit
        endif
    enddo
end function has_keyword_in_list

end module keyindices

    use keyindices
    type(keyindex) :: idx

    call idx%init (3, 8)

    if (idx%get_index ("one") .ne. 1) stop 1
    if (idx%get_index ("two") .ne. 2) stop 2
    if (idx%get_index ("three") .ne. 3) stop 3

! Check that new span is generated as list is extended.
    if (idx%get_index ("four") .ne. 4) stop 4
    if (idx%get_index ("five") .ne. 5) stop 5
    if (idx%get_index ("six") .ne. 6) stop 6

! Search by keyword
    if (.not.idx%has_key ("four")) stop 7
    if (idx%has_key ("seven")) stop 8

! Search by index
    if (idx%get_key (4) .ne. "four") stop 9
    if (idx%get_key (10) .ne. "") stop 10
end