FIX: incorrect block comparison behavior with nested sort in compare …

…function

resolves: Oldes/Rebol-issues#2622

src/boot/actions.reb

@@ -375,8 +375,8 @@ sort: action [
 	/case {Case sensitive sort}
 	/skip {Treat the series as records of fixed size}
 	size [integer!] {Size of each record}
-	/compare  {Comparator offset, block or function}
-	comparator [integer! block! any-function!]
+	/compare  {Comparator offset or function}
+	comparator [integer! any-function!]
 	/part {Limits the sorting to a given length or position}
 	range [number! series!]
 	/all {Compare all fields}

src/core/t-block.c

@@ -449,33 +449,21 @@ static void No_Nones_Or_Logic(REBVAL *arg) {
 	return;
 }
 
-// WARNING! Not re-entrant. !!!  Must find a way to push it on stack?
-static struct {
-	REBFLG cased;
-	REBFLG reverse;
-	REBCNT offset;
-	REBVAL *compare;
-} sort_flags = {0};
-
 /***********************************************************************
 **
 */	static int Compare_Val(const void *v1, const void *v2)
 /*
 ***********************************************************************/
 {
-	// !!!! BE SURE that 64 bit large difference comparisons work
+	REBVAL *val = DS_GET(DSP - 1);
+	REBU64 flags = VAL_UNT64(DS_TOP);
+	REBINT offset = 0;
+	if (IS_INTEGER(val)) offset = VAL_INT64(val) - 1;
 
-	if (sort_flags.reverse)
-		return Cmp_Value((REBVAL*)v2+sort_flags.offset, (REBVAL*)v1+sort_flags.offset, sort_flags.cased);
+	if (GET_FLAG(flags, SORT_FLAG_REVERSE))
+		return Cmp_Value((REBVAL*)v2+offset, (REBVAL*)v1+offset, GET_FLAG(flags, SORT_FLAG_CASE));
 	else
-		return Cmp_Value((REBVAL*)v1+sort_flags.offset, (REBVAL*)v2+sort_flags.offset, sort_flags.cased);
-
-/*
-	REBI64 n = VAL_INT64((REBVAL*)v1) - VAL_INT64((REBVAL*)v2);
-	if (n > 0) return 1;
-	if (n < 0) return -1;
-	return 0;
-*/
+		return Cmp_Value((REBVAL*)v1+offset, (REBVAL*)v2+offset, GET_FLAG(flags, SORT_FLAG_CASE));
 }
 
 
@@ -485,14 +473,19 @@ static struct {
 /*
 ***********************************************************************/
 {
-	REBVAL *v1 = (REBVAL*)p1;
-	REBVAL *v2 = (REBVAL*)p2;
+	REBVAL *v1 = (REBVAL*)p2;
+	REBVAL *v2 = (REBVAL*)p1;
 	REBVAL *val;
-
 	REBVAL *tmp;
 	REBSER *args;
+	REBVAL *func;
+	REBU64 flags;
+
+	func = DS_GET(DSP - 1);
+	if (!ANY_FUNC(func)) abort();
+	flags = VAL_UNT64(DS_TOP);
 
-	if (!sort_flags.reverse) {
+	if (GET_FLAG(flags, SORT_FLAG_REVERSE)) {
 		tmp = v1;
 		v1 = v2;
 		v2 = tmp;
@@ -502,27 +495,24 @@ static struct {
 	// TODO: The below results in an error message such as "op! does not allow
 	// unset! for its value1 argument". A better message would be more like
 	// "compare handler does not allow error! for its value1 argument."
-	args = VAL_FUNC_ARGS(sort_flags.compare);
+	args = VAL_FUNC_ARGS(func);
 	if (BLK_LEN(args) > 1 && !TYPE_CHECK(BLK_SKIP(args, 1), VAL_TYPE(v1)))
-		Trap3(RE_EXPECT_ARG, Of_Type(sort_flags.compare), BLK_SKIP(args, 1), Of_Type(v1));
+		Trap3(RE_EXPECT_ARG, Of_Type(func), BLK_SKIP(args, 1), Of_Type(v1));
 	if (BLK_LEN(args) > 2 && !TYPE_CHECK(BLK_SKIP(args, 2), VAL_TYPE(v2)))
-		Trap3(RE_EXPECT_ARG, Of_Type(sort_flags.compare), BLK_SKIP(args, 2), Of_Type(v2));
+		Trap3(RE_EXPECT_ARG, Of_Type(func), BLK_SKIP(args, 2), Of_Type(v2));
 
-	val = Apply_Func(0, sort_flags.compare, v1, v2, 0);
+	val = Apply_Func(0, func, v1, v2, 0);
 
 	if (IS_LOGIC(val)) {
 		if (IS_TRUE(val)) return 1;
-		return -1;
 	}
-	if (IS_INTEGER(val)) {
+	else if (IS_INTEGER(val)) {
 		if (VAL_INT64(val) < 0) return 1;
 		if (VAL_INT64(val) == 0) return 0;
-		return -1;
 	}
-	if (IS_DECIMAL(val)) {
+	else if (IS_DECIMAL(val)) {
 		if (VAL_DECIMAL(val) < 0) return 1;
 		if (VAL_DECIMAL(val) == 0) return 0;
-		return -1;
 	}
 	return -1;
 }
@@ -550,13 +540,12 @@ static struct {
 	REBCNT size = sizeof(REBVAL);
 //	int (*sfunc)(const void *v1, const void *v2);
 
-	sort_flags.cased = ccase;
-	sort_flags.reverse = rev;
-	sort_flags.compare = 0;
-	sort_flags.offset = 0;
+	REBU64 flags = 0;
+	if (ccase) SET_FLAG(flags, SORT_FLAG_CASE);
+	if (rev)   SET_FLAG(flags, SORT_FLAG_REVERSE);
 
-	if (IS_INTEGER(compv)) sort_flags.offset = Int32(compv)-1; 
-	if (ANY_FUNC(compv)) sort_flags.compare = compv; 
+	DS_PUSH(compv);
+	DS_PUSH_INTEGER(flags);
 
 	// Determine length of sort:
 	len = Partial1(block, part);
@@ -572,11 +561,14 @@ static struct {
 	// Use fast quicksort library function:
 	if (skip > 1) len /= skip, size *= skip;
 
-	if (sort_flags.compare)
+	if (ANY_FUNC(compv))
 		reb_qsort((void *)VAL_BLK_DATA(block), len, size, Compare_Call);
 	else
 		reb_qsort((void *)VAL_BLK_DATA(block), len, size, Compare_Val);
 
+	// Stored comparator and flags are not needed anymore
+	DS_DROP;
+	DS_DROP;
 }
 
 

src/core/t-string.c

@@ -439,7 +439,7 @@ static REBSER *make_binary(REBVAL *arg, REBOOL make)
 		if (rev) SET_FLAG(flags, SORT_FLAG_REVERSE);
 		if (1 < SERIES_WIDE(VAL_SERIES(string))) SET_FLAG(flags, SORT_FLAG_WIDE);
 
-		// Store flags and the comparator function on the stack
+		// Store the comparator function and flags on the stack
 		DS_PUSH(compv);
 		DS_PUSH_INTEGER(flags);
 		sfunc = Compare_Call;
@@ -452,6 +452,12 @@ static REBSER *make_binary(REBVAL *arg, REBOOL make)
 
 	//!!uni - needs to compare wide chars too
 	reb_qsort((void *)VAL_DATA(string), len, size * SERIES_WIDE(VAL_SERIES(string)), sfunc);
+
+	if (ANY_FUNC(compv)) {
+		// Stored comparator and flags are not needed anymore
+		DS_DROP;
+		DS_DROP;
+	}
 }
 
 

src/include/reb-defs.h

@@ -53,6 +53,7 @@ typedef int	cmp_t(const void *, const void *);
 void reb_qsort(void *a, size_t n, size_t es, cmp_t *cmp);
 #define SORT_FLAG_REVERSE 1
 #define SORT_FLAG_WIDE    2
+#define SORT_FLAG_CASE    3
 
 
 // Encoding_opts was originally in sys-core.h, but I moved it here so it can

src/tests/units/series-test.r3

@@ -1717,6 +1717,22 @@ Rebol [
 	--assert s1 == "aabbccdd"
 	--assert s2 == "íííéééááá"
 
+--test-- "SORT/compare block! (nested)"
+	;@@ https://github.com/Oldes/Rebol-issues/issues/2622
+	s1: sort/compare ["a" "b" "c" "d"] func[a b][s2: sort/compare/reverse [1 2 3 4] func[a b][a < b] a < b]
+	--assert s1 == ["a" "b" "c" "d"]
+	--assert s2 == [4 3 2 1]
+	s1: sort/compare/reverse ["a" "A" "B" "b"] func[a b][s2: sort/compare [1 2 3 4] :greater? a < b]
+	--assert s1 == ["B" "b" "a" "A"]
+	--assert s2 == [4 3 2 1]
+	s1: sort/compare [1 4 2 3] func[a b][s2: sort/case ["a" "B" "b" "a"] a < b]
+	--assert s1 == [1 2 3 4]
+	--assert s2 == ["B" "a" "a" "b"]
+	s1: sort/compare/reverse [1 4 2 3] func[a b][s2: sort ["a" "B" "b" "a"] a < b]
+	--assert s1 == [4 3 2 1]
+	--assert s2 == ["a" "a" "B" "b"]
+
+
 --test-- "SORT/skip/compare"
 	;@@ https://github.com/Oldes/Rebol-issues/issues/1152
 	--assert ["A" "a"] = sort/compare ["A" "a"] func [a b] [a < b]