! { dg-do compile } ! ! Test the fix for PR83196 comment #4 (there by mistake) ! ! Contributed by Arjen Markus !____________________________________________________________ ! 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