Skip to content

Commit

Permalink
FIX: block comparison with numeric and word values
Browse files Browse the repository at this point in the history 
resolves: Oldes/Rebol-issues#2501
resolves: Oldes/Rebol-issues#2594
  • Loading branch information
@Oldes
Oldes committed Apr 10, 2024
1 parent 36f5c75 commit ca8b40a
Show file tree
Hide file tree
Showing 4 changed files with 240 additions and 5 deletions.
19 changes: 14 additions & 5 deletions src/core/f-series.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -177,8 +177,7 @@

CHECK_STACK(&s);

while (!IS_END(s) && (VAL_TYPE(s) == VAL_TYPE(t) ||
(IS_NUMBER(s) && IS_NUMBER(t)))) {
while (!IS_END(s)) {
if ((diff = Cmp_Value(s, t, is_case)) != 0)
return diff;
s++, t++;
Expand All @@ -199,13 +198,18 @@
{
REBDEC d1, d2;

if (VAL_TYPE(t) != VAL_TYPE(s) && !(IS_NUMBER(s) && IS_NUMBER(t)))
if ((ANY_NUMBER(s) && ANY_NUMBER(t)) || (ANY_WORD(s) && ANY_WORD(t))) {
//https://github.com/Oldes/Rebol-issues/issues/2501
if (is_case && VAL_TYPE(t) != VAL_TYPE(s))
return VAL_TYPE(s) - VAL_TYPE(t);
} else if (VAL_TYPE(t) != VAL_TYPE(s)) {
return VAL_TYPE(s) - VAL_TYPE(t);
}

switch(VAL_TYPE(s)) {

case REB_INTEGER:
if (IS_DECIMAL(t)) {
if (IS_DECIMAL(t) || IS_PERCENT(t)) {
d1 = (REBDEC)VAL_INT64(s);
d2 = VAL_DECIMAL(t);
goto chkDecimal;
Expand All @@ -225,7 +229,8 @@
return THE_SIGN((REBINT)(ch1 - ch2));

case REB_DECIMAL:
case REB_MONEY:
case REB_PERCENT:
if (IS_MONEY(t)) goto chkMoney;
d1 = VAL_DECIMAL(s);
if (IS_INTEGER(t))
d2 = (REBDEC)VAL_INT64(t);
Expand All @@ -241,6 +246,10 @@
)
return -1;
return 1;

case REB_MONEY:
chkMoney:
return Cmp_Money(s, t);

case REB_PAIR:
return Cmp_Pair(s, t);
Expand Down
27 changes: 27 additions & 0 deletions src/core/t-money.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -52,6 +52,33 @@
return e != 0;;
}

/***********************************************************************
**
*/ REBINT Cmp_Money(REBVAL* a, REBVAL* b)
/*
** Given two money, compare them (accetps ANY_NUMBER).
**
***********************************************************************/
{
REBDCI d1, d2;
if (IS_MONEY(a))
d1 = VAL_DECI(a);
else if (IS_INTEGER(a))
d1 = int_to_deci(VAL_INT64(a));
else
d1 = decimal_to_deci(VAL_DECIMAL(a));

if (IS_MONEY(b))
d2 = VAL_DECI(b);
else if (IS_INTEGER(b))
d2 = int_to_deci(VAL_INT64(b));
else
d2 = decimal_to_deci(VAL_DECIMAL(b));

if (deci_is_equal(d1, d2))
return 0;
return deci_is_lesser_or_equal(d1, d2) ? -1 : 1;
}

/***********************************************************************
**
Expand Down
1 change: 1 addition & 0 deletions src/include/sys-value.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1317,6 +1317,7 @@ typedef struct Reb_All {
#define ANY_FUNC(v) (VAL_TYPE(v) >= REB_NATIVE && VAL_TYPE(v) <= REB_FUNCTION)
#define ANY_EVAL_BLOCK(v) (VAL_TYPE(v) >= REB_BLOCK && VAL_TYPE(v) <= REB_PAREN)
#define ANY_OBJECT(v) (VAL_TYPE(v) >= REB_OBJECT && VAL_TYPE(v) <= REB_PORT)
#define ANY_NUMBER(v) (VAL_TYPE(v) >= REB_INTEGER && VAL_TYPE(v) <= REB_MONEY)

#define ANY_BLOCK_TYPE(t) (t >= REB_BLOCK && t <= REB_LIT_PATH)
#define ANY_STR_TYPE(t) (t >= REB_STRING && t <= REB_TAG)
Expand Down
198 changes: 198 additions & 0 deletions src/tests/units/compare-test.r3
View file
Original file line number Diff line number Diff line change
Expand Up @@ -159,4 +159,202 @@ Rebol [
--assert all [error? e: try [0:0:0 < 1x1 ] e/id = 'invalid-compare]
===end-group===


===start-group=== "block!"
;@@ https://github.com/Oldes/Rebol-issues/issues/2501
;@@ https://github.com/Oldes/Rebol-issues/issues/2594
--test-- "equal? block! with strings"
--assert equal? ["a"] ["a"]
--assert equal? ["a"] ["A"]
--test-- "equal? block! with words"
--assert equal? [a] [a]
--assert equal? [a] [a:]
--assert equal? [a] [:a]
--assert equal? [a] ['a]
--assert equal? [a] [/a]
--test-- "equal? block! with numbers"
--assert equal? [1] [1]
--assert equal? [1] [1.0]
--assert equal? [1] [100%]
--assert equal? [1] [$1]
--assert equal? [1.0] [1.0]
--assert equal? [1.0] [1]
--assert equal? [1.0] [100%]
--assert equal? [1.0] [$1]
--assert equal? [1%] [1%]
--assert equal? [100%] [1]
--assert equal? [100%] [1.0]
--assert equal? [100%] [$1]
--assert equal? [$1] [$1]
--assert equal? [$1] [1]
--assert equal? [$1] [1.0]
--assert equal? [$1] [100%]
--test-- "equal? block! with blocks"
--assert equal? [[1]] [[1]]
--assert not equal? [[1]] [(1)]


--test-- "strict-equal? block! with strings"
--assert strict-equal? ["a"] ["a"]
--assert not strict-equal? ["a"] ["A"]
--test-- "strict-equal? block! with words"
--assert strict-equal? [a] [a]
--assert not strict-equal? [a] [a:]
--assert not strict-equal? [a] [:a]
--assert not strict-equal? [a] ['a]
--assert not strict-equal? [a] [/a]
--test-- "strict-equal? block! with numbers"
--assert strict-equal? [1] [1]
--assert not strict-equal? [1] [1.0]
--assert not strict-equal? [1] [100%]
--assert not strict-equal? [1] [$1]
--assert strict-equal? [1.0] [1.0]
--assert not strict-equal? [1.0] [1]
--assert not strict-equal? [1.0] [100%]
--assert not strict-equal? [1.0] [$1]
--assert strict-equal? [1%] [1%]
--assert not strict-equal? [100%] [1]
--assert not strict-equal? [100%] [1.0]
--assert not strict-equal? [100%] [$1]
--assert strict-equal? [$1] [$1]
--assert not strict-equal? [$1] [1]
--assert not strict-equal? [$1] [1.0]
--assert not strict-equal? [$1] [100%]
--test-- "strict-equal? block! with blocks"
--assert strict-equal? [[1]] [[1]]
--assert not strict-equal? [[1]] [(1)]

===end-group===

;- tests from Red Language...
===start-group=== "prefix equal same datatype"
--test-- "prefix-equal-same-datatype-1" --assert equal? 0 0
--test-- "prefix-equal-same-datatype-2" --assert equal? 1 1
--test-- "prefix-equal-same-datatype-3" --assert equal? 0#FFFFFFFFFFFFFFFF -1
--test-- "prefix-equal-same-datatype-4" --assert equal? [] []
--test-- "prefix-equal-same-datatype-5" --assert equal? [a] [a]
--test-- "prefix-equal-same-datatype-6" --assert equal? [A] [a]
--test-- "prefix-equal-same-datatype-7" --assert equal? ['a] [a]
--test-- "prefix-equal-same-datatype-8" --assert equal? [a:] [a]
--test-- "prefix-equal-same-datatype-9" --assert equal? [:a] [a]
--test-- "prefix-equal-same-datatype-10" --assert equal? [:a] [a:]
--test-- "prefix-equal-same-datatype-11" --assert equal? [abcde] [abcde]
--test-- "prefix-equal-same-datatype-12" --assert equal? [a b c d] [a b c d]
--test-- "prefix-equal-same-datatype-13" --assert equal? [b c d] next [a b c d]
--test-- "prefix-equal-same-datatype-14" --assert equal? [b c d] (next [a b c d])
--test-- "prefix-equal-same-datatype-15" --assert equal? "a" "a"
--test-- "prefix-equal-same-datatype-16" --assert equal? "a" "A"
--test-- "prefix-equal-same-datatype-17" --assert equal? "abcdeè" "abcdeè"
--test-- "prefix-equal-same-datatype-18" --assert equal? (next "abcdeè") next "abcdeè"
--test-- "prefix-equal-same-datatype-19" --assert equal? (first "abcdeè") first "abcdeè"
--test-- "prefix-equal-same-datatype-20" --assert equal? (last "abcdeè") last "abcdeè"
--test-- "prefix-equal-same-datatype-21" --assert equal? "abcde^(2710)é" "abcde^(2710)é"
--test-- "prefix-equal-same-datatype-22" --assert equal? [d] back tail [a b c d]
--test-- "prefix-equal-same-datatype-23" --assert equal? "2345" next "12345"
--test-- "prefix-equal-same-datatype-24" --assert equal? #"z" #"z"
--test-- "prefix-equal-same-datatype-25" --assert equal? #"z" #"Z" ;@@ in Red this is not equal!
--test-- "prefix-equal-same-datatype-25" --red-- --assert not equal? #"z" #"Z"
--test-- "prefix-equal-same-datatype-26" --assert not equal? #"e" #"è"
; --test-- "prefix-equal-same-datatype-27" --assert equal? #"^(010000)" #"^(010000)"
--test-- "prefix-equal-same-datatype-28" --assert equal? true true
--test-- "prefix-equal-same-datatype-29" --assert equal? false false
--test-- "prefix-equal-same-datatype-30" --assert not equal? false true
--test-- "prefix-equal-same-datatype-31" --assert not equal? true false
--test-- "prefix-equal-same-datatype-32" --assert equal? none none
--test-- "prefix-equal-same-datatype-33" --assert equal? 'a 'a
--test-- "prefix-equal-same-datatype-34" --assert equal? 'a 'A
--test-- "prefix-equal-same-datatype-35" --assert equal? (first [a]) first [a]
--test-- "prefix-equal-same-datatype-36" --assert equal? 'a first [A]
--test-- "prefix-equal-same-datatype-37" --assert equal? 'a first ['a]
--test-- "prefix-equal-same-datatype-38" --assert equal? 'a first [:a]
--test-- "prefix-equal-same-datatype-39" --assert equal? 'a first [a:]
--test-- "prefix-equal-same-datatype-40" --assert equal? (first [a:]) first [a:]
--test-- "prefix-equal-same-datatype-41" --assert equal? (first [:a]) first [:a]
--test-- "prefix-equal-same-datatype-42" --assert equal? [a b c d e] first [[a b c d e]]
--test-- "prefix-equal-same-datatype-43" ea-result: 1 = 1 --assert ea-result = true
--test-- "prefix-equal-same-datatype-44" ea-result: 1 = 0 --assert ea-result = false
--test-- "prefix-equal-same-datatype-45" ea-result: equal? 1 1 --assert ea-result = true
--test-- "prefix-equal-same-datatype-46" ea-result: equal? 1 0 --assert ea-result = false
===end-group===

===start-group=== "prefix strict-equal same datatype"
--test-- "prefix-strict-equal-same-datatype-1" --assert strict-equal? 0 0
--test-- "prefix-strict-equal-same-datatype-2" --assert strict-equal? 1 1
--test-- "prefix-strict-equal-same-datatype-3" --assert strict-equal? 0#FFFFFFFFFFFFFFFF -1
--test-- "prefix-strict-equal-same-datatype-4" --assert strict-equal? [] []
--test-- "prefix-strict-equal-same-datatype-5" --assert strict-equal? [a] [a]
--test-- "prefix-strict-equal-same-datatype-6" --assert not strict-equal? [A] [a]
--test-- "prefix-strict-equal-same-datatype-7" --assert not strict-equal? ['a] [a]
--test-- "prefix-strict-equal-same-datatype-8" --assert not strict-equal? [a:] [a]
--test-- "prefix-strict-equal-same-datatype-9" --assert not strict-equal? [:a] [a]
--test-- "prefix-strict-equal-same-datatype-10" --assert not strict-equal? [:a] [a:]
--test-- "prefix-strict-equal-same-datatype-11" --assert strict-equal? [abcde] [abcde]
--test-- "prefix-strict-equal-same-datatype-12" --assert strict-equal? [a b c d] [a b c d]
--test-- "prefix-strict-equal-same-datatype-13" --assert strict-equal? [b c d] next [a b c d]
--test-- "prefix-strict-equal-same-datatype-14" --assert strict-equal? [b c d] (next [a b c d])
--test-- "prefix-strict-equal-same-datatype-15" --assert strict-equal? "a" "a"
--test-- "prefix-strict-equal-same-datatype-16" --assert not strict-equal? "a" "A"
--test-- "prefix-strict-equal-same-datatype-17" --assert strict-equal? "abcdeè" "abcdeè"
--test-- "prefix-strict-equal-same-datatype-18" --assert strict-equal? (next "abcdeè") next "abcdeè"
--test-- "prefix-strict-equal-same-datatype-19" --assert strict-equal? (first "abcdeè") first "abcdeè"
--test-- "prefix-strict-equal-same-datatype-20" --assert strict-equal? (last "abcdeè") last "abcdeè"
--test-- "prefix-strict-equal-same-datatype-21" --assert strict-equal? "abcde^(2710)é" "abcde^(2710)é"
--test-- "prefix-strict-equal-same-datatype-22" --assert strict-equal? [d] back tail [a b c d]
--test-- "prefix-strict-equal-same-datatype-23" --assert strict-equal? "2345" next "12345"
--test-- "prefix-strict-equal-same-datatype-24" --assert strict-equal? #"z" #"z"
--test-- "prefix-strict-equal-same-datatype-25" --assert not strict-equal? #"z" #"Z"
--test-- "prefix-strict-equal-same-datatype-26" --assert not strict-equal? #"e" #"è"
; --test-- "prefix-strict-equal-same-datatype-27" --assert strict-equal? #"^(010000)" #"^(010000)"
--test-- "prefix-strict-equal-same-datatype-28" --assert strict-equal? true true
--test-- "prefix-strict-equal-same-datatype-29" --assert strict-equal? false false
--test-- "prefix-strict-equal-same-datatype-30" --assert not strict-equal? false true
--test-- "prefix-strict-equal-same-datatype-31" --assert not strict-equal? true false
--test-- "prefix-strict-equal-same-datatype-32" --assert strict-equal? none none
--test-- "prefix-strict-equal-same-datatype-33" --assert strict-equal? 'a 'a
--test-- "prefix-strict-equal-same-datatype-34" --assert not strict-equal? 'a 'A
--test-- "prefix-strict-equal-same-datatype-35" --assert strict-equal? (first [a]) first [a]
--test-- "prefix-strict-equal-same-datatype-36" --assert strict-equal? 'a first [a]
--test-- "prefix-strict-equal-same-datatype-37" --assert not strict-equal? 'a first ['a]
--test-- "prefix-strict-equal-same-datatype-38" --assert not strict-equal? 'a first [:a]
--test-- "prefix-strict-equal-same-datatype-39" --assert not strict-equal? 'a first [a:]
--test-- "prefix-strict-equal-same-datatype-40" --assert strict-equal? (first [a:]) first [a:]
--test-- "prefix-strict-equal-same-datatype-41" --assert strict-equal? (first [:a]) first [:a]
--test-- "prefix-strict-equal-same-datatype-42" --assert strict-equal? [a b c d e] first [[a b c d e]]
--test-- "prefix-strict-equal-same-datatype-43" ea-result: 1 == 1 --assert ea-result = true
--test-- "prefix-strict-equal-same-datatype-44" ea-result: 1 == 0 --assert ea-result = false
===end-group===

===start-group=== "prefix equal implcit cast"
--test-- "prefix-equal-implcit-cast-1" --assert equal? #"0" 48
--test-- "prefix-equal-implcit-cast-2" --assert equal? 48 #"0"
--test-- "prefix-equal-implcit-cast-3" --assert equal? #"^(2710)" 10000
; --test-- "prefix-equal-implcit-cast-4" --assert equal? #"^(010000)" 65536
--test-- "prefix-equal-implcit-cast-5" ea-result: #"1" = 49 --assert ea-result = true
===end-group===

===start-group=== "prefix-greater-same-datatype"
--test-- "prefix-greater-same-datatype-1" --assert not greater? 0 0
--test-- "prefix-greater-same-datatype-2" --assert greater? 1 0
--test-- "prefix-greater-same-datatype-3" --assert not greater? 1 1
--test-- "prefix-greater-same-datatype-4" --assert not greater? 0#FFFFFFFFFFFFFFFF -1
--test-- "prefix-greater-same-datatype-5" --assert greater? -1 0#FFFFFFFFFFFFFFFE
--test-- "prefix-greater-same-datatype-6" --assert not greater? -2 0#FFFFFFFFFFFFFFFF
--test-- "prefix-greater-same-datatype-7" --assert not greater? "a" "a"
--test-- "prefix-greater-same-datatype-8" --assert greater? "b" "a"
--test-- "prefix-greater-same-datatype-9" --assert greater? "è" "f"
--test-- "prefix-greater-same-datatype-10" --assert not greater? "A" "a"
--test-- "prefix-greater-same-datatype-11" --assert not greater? "a" "A"
--test-- "prefix-greater-same-datatype-12" --assert not greater? "abcdeè" "abcdeè"
--test-- "prefix-greater-same-datatype-13" --assert not greater? (next "abcdeè") next "abcdeè"
--test-- "prefix-greater-same-datatype-14" --assert not greater? (first "abcdeè") first "abcdeè"
--test-- "prefix-greater-same-datatype-15" --assert not greater? (last "abcdeè") last "abcdeè"
--test-- "prefix-greater-same-datatype-16" --assert not greater? "abcde^(2710)é" "abcde^(2710)é"
--test-- "prefix-greater-same-datatype-17" --assert not greater? "2345" next "12345"
--test-- "prefix-greater-same-datatype-18" --assert not greater? #"z" #"z"
--test-- "prefix-greater-same-datatype-19" --assert greater? #"z" #"Z"
--test-- "prefix-greater-same-datatype-20" --assert greater? #"è" #"e"
; --test-- "prefix-greater-same-datatype-21" --assert not greater? #"^(010000)" #"^(010000)"
===end-group===


~~~end-file~~~

0 comments on commit ca8b40a

Please sign in to comment.