Merge pull request #428 from jvdp1/issue_sorting

Issue with stdlib_sorting

Author: milancurcic

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

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

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 )