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

… function

resolves: Oldes/Rebol-issues#2621

src/core/t-string.c

@@ -347,15 +347,6 @@ static REBSER *make_binary(REBVAL *arg, REBOOL make)
  return ((int)LO_CASE(*(REBYTE*)v2)) - ((int)LO_CASE(*(REBYTE*)v1));
 }
 
-// WARNING! Not re-entrant. !!! Must find a way to push it on stack?
-static struct {
- REBFLG cased;
- REBFLG reverse;
- REBCNT offset;
- REBVAL *compare;
- REBFLG wide;
-} sort_flags = {0};
-
 /***********************************************************************
 **
 */ static int Compare_Call(const void *p1, const void *p2)
@@ -366,44 +357,45 @@ static struct {
  REBVAL *v2;
  REBVAL *val;
  REBVAL *tmp;
+ REBVAL *func;
+ REBU64 flags;
+
+ func = DS_GET(DSP - 1);
+ flags = VAL_UNT64(DS_TOP);
 
- // O: is there better way how to temporary use 2 values?
  DS_SKIP; v1 = DS_TOP;
  DS_SKIP; v2 = DS_TOP;
 
- if (sort_flags.wide) {
+ if (GET_FLAG(flags, SORT_FLAG_WIDE)) {
  SET_CHAR(v1, (int)(*(REBUNI*)p2));
  SET_CHAR(v2, (int)(*(REBUNI*)p1));
  } else {
  SET_CHAR(v1, (int)(*(REBYTE*)p2));
  SET_CHAR(v2, (int)(*(REBYTE*)p1));
  }
 
- if (sort_flags.reverse) {
+ if (GET_FLAG(flags, SORT_FLAG_REVERSE)) {
  tmp = v1;
  v1 = v2;
  v2 = tmp;
  }
 
- val = Apply_Func(0, sort_flags.compare, v1, v2, 0);
+ val = Apply_Func(0, func, v1, v2, 0);
 
  // v1 and v2 no more needed...
- DS_POP;
- DS_POP;
+ DS_DROP;
+ DS_DROP;
 
  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;
 }
@@ -436,18 +428,20 @@ static struct {
  if (skip > 1) len /= skip, size *= skip;
 
  if (ANY_FUNC(compv)) {
- // Check argument types of comparator function.
+ // Check argument types of the comparator function.
  args = VAL_FUNC_ARGS(compv);
  if (BLK_LEN(args) > 1 && !TYPE_CHECK(BLK_SKIP(args, 1), REB_CHAR))
  Trap3(RE_EXPECT_ARG, Of_Type(compv), BLK_SKIP(args, 1), Get_Type_Word(REB_CHAR));
  if (BLK_LEN(args) > 2 && !TYPE_CHECK(BLK_SKIP(args, 2), REB_CHAR))
  Trap3(RE_EXPECT_ARG, Of_Type(compv), BLK_SKIP(args, 2), Get_Type_Word(REB_CHAR));
- sort_flags.cased = ccase;
- sort_flags.reverse = rev;
- sort_flags.compare = 0;
- sort_flags.offset = 0;
- sort_flags.compare = compv;
- sort_flags.wide = 1 < SERIES_WIDE(VAL_SERIES(string));
+
+ REBU64 flags = 0;
+ 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
+ DS_PUSH(compv);
+ DS_PUSH_INTEGER(flags);
  sfunc = Compare_Call;
 
  } else if (ccase) {

src/tests/units/series-test.r3

@@ -1705,6 +1705,18 @@ Rebol [
  --assert #{050403020100} == sort/compare #{000102030405} :comp
  --assert "šřba" == sort/compare "ašbř" :comp
 
+--test-- "SORT/compare string! (nested)"
+ ;@@ https://github.com/Oldes/Rebol-issues/issues/2621
+ s1: sort/compare "abcd" func[a b][s2: sort/compare/reverse "1234" func[a b][a < b] a < b]
+ --assert s1 == "abcd"
+ --assert s2 == "4321"
+ s1: sort/compare "abcdabcd" func[a b][s2: sort/compare "áéíáéíáéí" func[a b][a < b] a < b]
+ --assert s1 == "aabbccdd"
+ --assert s2 == "áááéééííí"
+ s1: sort/compare "abcdabcd" func[a b][s2: sort/compare "áéíáéíáéí" :greater? a < b]
+ --assert s1 == "aabbccdd"
+ --assert s2 == "íííéééááá"
+
 --test-- "SORT/skip/compare"
  ;@@ https://github.com/Oldes/Rebol-issues/issues/1152
  --assert ["A" "a"] = sort/compare ["A" "a"] func [a b] [a < b]