diff --git a/src/stdlib_sorting_ord_sort.fypp b/src/stdlib_sorting_ord_sort.fypp index 2de070298..668e2bc12 100644 --- a/src/stdlib_sorting_ord_sort.fypp +++ b/src/stdlib_sorting_ord_sort.fypp @@ -158,7 +158,8 @@ contains do j=1, size(array, kind=int_size)-1 key = array(j) i = j - 1 - do while( i >= 0 .and. array(i) ${signt}$ key ) + do while( i >= 0 ) + if ( array(i) ${signoppt}$= key ) exit array(i+1) = array(i) i = i - 1 end do @@ -518,7 +519,8 @@ contains do j=1, size(array, kind=int_size)-1 key = array(j) i = j - 1 - do while( i >= 0 .and. array(i) ${signt}$ key ) + do while( i >= 0 ) + if ( array(i) ${signoppt}$= key ) exit array(i+1) = array(i) i = i - 1 end do diff --git a/src/stdlib_sorting_sort_index.fypp b/src/stdlib_sorting_sort_index.fypp index 96aff4cd2..9b9f16ca4 100644 --- a/src/stdlib_sorting_sort_index.fypp +++ b/src/stdlib_sorting_sort_index.fypp @@ -177,7 +177,8 @@ contains key = array(j) key_index = index(j) i = j - 1 - do while( i >= 0 .and. array(i) > key ) + do while( i >= 0 ) + if ( array(i) <= key ) exit array(i+1) = array(i) index(i+1) = index(i) i = i - 1 @@ -585,7 +586,8 @@ contains key = array(j) key_index = index(j) i = j - 1 - do while( i >= 0 .and. array(i) > key ) + do while( i >= 0 ) + if ( array(i) <= key ) exit array(i+1) = array(i) index(i+1) = index(i) i = i - 1 diff --git a/src/tests/sorting/test_sorting.f90 b/src/tests/sorting/test_sorting.f90 index 3ce0aae52..0e71a5946 100644 --- a/src/tests/sorting/test_sorting.f90 +++ b/src/tests/sorting/test_sorting.f90 @@ -179,7 +179,9 @@ program test_sorting subroutine test_int_ord_sorts( ltest ) logical, intent(out) :: ltest - logical :: ldummy + integer(int64) :: i + integer, allocatable :: d1(:) + logical :: ldummy ltest = .true. @@ -202,6 +204,13 @@ subroutine test_int_ord_sorts( ltest ) call test_int_ord_sort( rand10, "Random 10", ldummy ) ltest = (ltest .and. ldummy) + !triggered an issue in insertion_sort + d1 = [10, 2, -3, -4, 6, -6, 7, -8, 9, 0, 1, 20] + call ord_sort( d1 ) + call verify_sort( d1, ldummy, i ) + ltest = (ltest .and. ldummy) + + end subroutine test_int_ord_sorts @@ -418,7 +427,9 @@ end subroutine test_string_ord_sort subroutine test_int_sorts( ltest ) logical, intent(out) :: ltest - logical :: ldummy + integer(int64) :: i + integer, allocatable :: d1(:) + logical :: ldummy ltest = .true. @@ -441,6 +452,12 @@ subroutine test_int_sorts( ltest ) call test_int_sort( rand10, "Random 10", ldummy ) ltest = (ltest .and. ldummy) + !triggered an issue in insertion + d1 = [10, 2, -3, -4, 6, -6, 7, -8, 9, 0, 1, 20] + call sort( d1 ) + call verify_sort( d1, ldummy, i ) + ltest = (ltest .and. ldummy) + end subroutine test_int_sorts subroutine test_int_sort( a, a_name, ltest ) @@ -623,7 +640,10 @@ end subroutine test_string_sort subroutine test_int_sort_indexes( ltest ) logical, intent(out) :: ltest - logical :: ldummy + integer(int64) :: i + integer(int32), allocatable :: d1(:) + integer(int64), allocatable :: index(:) + logical :: ldummy ltest = .true. @@ -646,6 +666,12 @@ subroutine test_int_sort_indexes( ltest ) call test_int_sort_index( rand10, "Random 10", ldummy ) ltest = (ltest .and. ldummy) + d1 = [10, 2, -3, -4, 6, -6, 7, -8, 9, 0, 1, 20] + allocate( index(size(d1)) ) + call sort_index( d1, index ) + call verify_sort( d1, ldummy, i ) + ltest = (ltest .and. ldummy) + end subroutine test_int_sort_indexes subroutine test_int_sort_index( a, a_name, ltest )