From 11dd0e17964958c95ef28c8c817992d454968936 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 5 Jun 2021 19:15:08 +0200 Subject: [PATCH 1/3] issue_sorting: cannot reproduce an issue --- src/tests/sorting/test_sorting.f90 | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/tests/sorting/test_sorting.f90 b/src/tests/sorting/test_sorting.f90 index 3ce0aae52..1e24a61f2 100644 --- a/src/tests/sorting/test_sorting.f90 +++ b/src/tests/sorting/test_sorting.f90 @@ -14,7 +14,7 @@ program test_sorting integer(int32), parameter :: char_size = 26**4 integer(int32), parameter :: string_size = 26**3 integer(int32), parameter :: block_size = test_size/6 - integer, parameter :: repeat = 8 + integer, parameter :: repeat = 1 integer(int32) :: & blocks(0:test_size-1), & @@ -202,6 +202,17 @@ subroutine test_int_ord_sorts( ltest ) call test_int_ord_sort( rand10, "Random 10", ldummy ) ltest = (ltest .and. ldummy) + + block + integer(int64) :: i + integer, allocatable :: d1(:) + 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 block + + end subroutine test_int_ord_sorts From 376cf385e8382b81f4a080fecc81829622553de7 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 5 Jun 2021 19:43:10 +0200 Subject: [PATCH 2/3] issue_sorting: fixed issue --- src/stdlib_sorting_ord_sort.fypp | 6 ++++-- src/stdlib_sorting_sort_index.fypp | 6 ++++-- src/tests/sorting/test_sorting.f90 | 33 ++++++++++++++++++++++-------- 3 files changed, 32 insertions(+), 13 deletions(-) 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 1e24a61f2..3294bb55f 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,15 +204,11 @@ subroutine test_int_ord_sorts( ltest ) call test_int_ord_sort( rand10, "Random 10", ldummy ) ltest = (ltest .and. ldummy) - - block - integer(int64) :: i - integer, allocatable :: d1(:) + !triggered an issue in insertion_sort d1 = [10, 2, -3, -4, 6, -6, 7, -8, 9, 0, 1, 20] - call ord_sort( d1) + call ord_sort( d1 ) call verify_sort( d1, ldummy, i ) ltest = (ltest .and. ldummy) - end block end subroutine test_int_ord_sorts @@ -429,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. @@ -452,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 ) @@ -634,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. @@ -657,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 ) From 3a4ba03b7536d8a2c48882f067a2f8794004a041 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sun, 6 Jun 2021 11:52:07 +0200 Subject: [PATCH 3/3] Update src/tests/sorting/test_sorting.f90 --- src/tests/sorting/test_sorting.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tests/sorting/test_sorting.f90 b/src/tests/sorting/test_sorting.f90 index 3294bb55f..0e71a5946 100644 --- a/src/tests/sorting/test_sorting.f90 +++ b/src/tests/sorting/test_sorting.f90 @@ -14,7 +14,7 @@ program test_sorting integer(int32), parameter :: char_size = 26**4 integer(int32), parameter :: string_size = 26**3 integer(int32), parameter :: block_size = test_size/6 - integer, parameter :: repeat = 1 + integer, parameter :: repeat = 8 integer(int32) :: & blocks(0:test_size-1), &