AVL tree: Difference between revisions
→{{header|Fortran}}
Line 2,822:
{{works with|Fortran|2008}}
{{works with|Fortran|2018}}
The following AVL tree implementation is for keys and data of any type,
<lang fortran>module avl_trees
Line 3,511:
! *exactly*.
if (0 < abs (real_cast (retval) - real (the_keys(j)))) error stop
end if
if (found) then
block
character(len = 1), parameter :: ch = '*'
!
! Try replacing the data with a character and then
! restoring the number.
!
call avl_insert (lt, the_keys(j), ch, tree)
call avl_retrieve (lt, the_keys(j), tree, found, retval)
if (.not. found) error stop
if (char_cast (retval) /= ch) error stop
call avl_insert (lt, the_keys(j), real (the_keys(j)), tree)
call avl_retrieve (lt, the_keys(j), tree, found, retval)
if (.not. found) error stop
if (0 < abs (real_cast (retval) - real (the_keys(j)))) error stop
end block
end if
end do
Line 3,523 ⟶ 3,540:
call fisher_yates_shuffle (the_keys, keys_count)
do i = 1, keys_count
call avl_delete (lt, the_keys(i), tree)
call avl_check (tree)
if (avl_size (tree) /= keys_count - i) error stop
! Try deleting a second time.
call avl_delete (lt, the_keys(i), tree)
call avl_check (tree)
Line 3,582 ⟶ 3,603:
end select
end function real_cast
function char_cast (u) result (v)
class(*), intent(in) :: u
character(len = 1) :: v
select type (u)
type is (character(*))
v = u
class default
! This case is not handled.
error stop
end select
end function char_cast
function lt (u, v) result (u_lt_v)
| |||