Skip to content

Commit ca8b40a

Browse files
OldesOldes
committed
FIX: block comparison with numeric and word values
resolves: Oldes/Rebol-issues#2501 resolves: Oldes/Rebol-issues#2594
1 parent 36f5c75 commit ca8b40a

File tree

4 files changed

+240
-5
lines changed

4 files changed

+240
-5
lines changed

‎src/core/f-series.c

+14-5
Original file line numberDiff line numberDiff line change
@@ -177,8 +177,7 @@
177177

178178
CHECK_STACK(&s);
179179

180-
while (!IS_END(s) && (VAL_TYPE(s) == VAL_TYPE(t) ||
181-
(IS_NUMBER(s) && IS_NUMBER(t)))) {
180+
while (!IS_END(s)) {
182181
if ((diff = Cmp_Value(s, t, is_case)) != 0)
183182
return diff;
184183
s++, t++;
@@ -199,13 +198,18 @@
199198
{
200199
REBDEC d1, d2;
201200

202-
if (VAL_TYPE(t) != VAL_TYPE(s) && !(IS_NUMBER(s) && IS_NUMBER(t)))
201+
if ((ANY_NUMBER(s) && ANY_NUMBER(t)) || (ANY_WORD(s) && ANY_WORD(t))) {
202+
//https://github.com/Oldes/Rebol-issues/issues/2501
203+
if (is_case && VAL_TYPE(t) != VAL_TYPE(s))
204+
return VAL_TYPE(s) - VAL_TYPE(t);
205+
} else if (VAL_TYPE(t) != VAL_TYPE(s)) {
203206
return VAL_TYPE(s) - VAL_TYPE(t);
207+
}
204208

205209
switch(VAL_TYPE(s)) {
206210

207211
case REB_INTEGER:
208-
if (IS_DECIMAL(t)) {
212+
if (IS_DECIMAL(t) || IS_PERCENT(t)) {
209213
d1 = (REBDEC)VAL_INT64(s);
210214
d2 = VAL_DECIMAL(t);
211215
goto chkDecimal;
@@ -225,7 +229,8 @@
225229
return THE_SIGN((REBINT)(ch1 - ch2));
226230

227231
case REB_DECIMAL:
228-
case REB_MONEY:
232+
case REB_PERCENT:
233+
if (IS_MONEY(t)) goto chkMoney;
229234
d1 = VAL_DECIMAL(s);
230235
if (IS_INTEGER(t))
231236
d2 = (REBDEC)VAL_INT64(t);
@@ -241,6 +246,10 @@
241246
)
242247
return -1;
243248
return 1;
249+
250+
case REB_MONEY:
251+
chkMoney:
252+
return Cmp_Money(s, t);
244253

245254
case REB_PAIR:
246255
return Cmp_Pair(s, t);

‎src/core/t-money.c

+27
Original file line numberDiff line numberDiff line change
@@ -52,6 +52,33 @@
5252
return e != 0;;
5353
}
5454

55+
/***********************************************************************
56+
**
57+
*/ REBINT Cmp_Money(REBVAL* a, REBVAL* b)
58+
/*
59+
** Given two money, compare them (accetps ANY_NUMBER).
60+
**
61+
***********************************************************************/
62+
{
63+
REBDCI d1, d2;
64+
if (IS_MONEY(a))
65+
d1 = VAL_DECI(a);
66+
else if (IS_INTEGER(a))
67+
d1 = int_to_deci(VAL_INT64(a));
68+
else
69+
d1 = decimal_to_deci(VAL_DECIMAL(a));
70+
71+
if (IS_MONEY(b))
72+
d2 = VAL_DECI(b);
73+
else if (IS_INTEGER(b))
74+
d2 = int_to_deci(VAL_INT64(b));
75+
else
76+
d2 = decimal_to_deci(VAL_DECIMAL(b));
77+
78+
if (deci_is_equal(d1, d2))
79+
return 0;
80+
return deci_is_lesser_or_equal(d1, d2) ? -1 : 1;
81+
}
5582

5683
/***********************************************************************
5784
**

‎src/include/sys-value.h

+1
Original file line numberDiff line numberDiff line change
@@ -1317,6 +1317,7 @@ typedef struct Reb_All {
13171317
#define ANY_FUNC(v) (VAL_TYPE(v) >= REB_NATIVE && VAL_TYPE(v) <= REB_FUNCTION)
13181318
#define ANY_EVAL_BLOCK(v) (VAL_TYPE(v) >= REB_BLOCK && VAL_TYPE(v) <= REB_PAREN)
13191319
#define ANY_OBJECT(v) (VAL_TYPE(v) >= REB_OBJECT && VAL_TYPE(v) <= REB_PORT)
1320+
#define ANY_NUMBER(v) (VAL_TYPE(v) >= REB_INTEGER && VAL_TYPE(v) <= REB_MONEY)
13201321

13211322
#define ANY_BLOCK_TYPE(t) (t >= REB_BLOCK && t <= REB_LIT_PATH)
13221323
#define ANY_STR_TYPE(t) (t >= REB_STRING && t <= REB_TAG)

‎src/tests/units/compare-test.r3

+198
Original file line numberDiff line numberDiff line change
@@ -159,4 +159,202 @@ Rebol [
159159
--assert all [error? e: try [0:0:0 < 1x1 ] e/id = 'invalid-compare]
160160
===end-group===
161161

162+
163+
===start-group=== "block!"
164+
;@@ https://github.com/Oldes/Rebol-issues/issues/2501
165+
;@@ https://github.com/Oldes/Rebol-issues/issues/2594
166+
--test-- "equal? block! with strings"
167+
--assert equal? ["a"] ["a"]
168+
--assert equal? ["a"] ["A"]
169+
--test-- "equal? block! with words"
170+
--assert equal? [a] [a]
171+
--assert equal? [a] [a:]
172+
--assert equal? [a] [:a]
173+
--assert equal? [a] ['a]
174+
--assert equal? [a] [/a]
175+
--test-- "equal? block! with numbers"
176+
--assert equal? [1] [1]
177+
--assert equal? [1] [1.0]
178+
--assert equal? [1] [100%]
179+
--assert equal? [1] [$1]
180+
--assert equal? [1.0] [1.0]
181+
--assert equal? [1.0] [1]
182+
--assert equal? [1.0] [100%]
183+
--assert equal? [1.0] [$1]
184+
--assert equal? [1%] [1%]
185+
--assert equal? [100%] [1]
186+
--assert equal? [100%] [1.0]
187+
--assert equal? [100%] [$1]
188+
--assert equal? [$1] [$1]
189+
--assert equal? [$1] [1]
190+
--assert equal? [$1] [1.0]
191+
--assert equal? [$1] [100%]
192+
--test-- "equal? block! with blocks"
193+
--assert equal? [[1]] [[1]]
194+
--assert not equal? [[1]] [(1)]
195+
196+
197+
--test-- "strict-equal? block! with strings"
198+
--assert strict-equal? ["a"] ["a"]
199+
--assert not strict-equal? ["a"] ["A"]
200+
--test-- "strict-equal? block! with words"
201+
--assert strict-equal? [a] [a]
202+
--assert not strict-equal? [a] [a:]
203+
--assert not strict-equal? [a] [:a]
204+
--assert not strict-equal? [a] ['a]
205+
--assert not strict-equal? [a] [/a]
206+
--test-- "strict-equal? block! with numbers"
207+
--assert strict-equal? [1] [1]
208+
--assert not strict-equal? [1] [1.0]
209+
--assert not strict-equal? [1] [100%]
210+
--assert not strict-equal? [1] [$1]
211+
--assert strict-equal? [1.0] [1.0]
212+
--assert not strict-equal? [1.0] [1]
213+
--assert not strict-equal? [1.0] [100%]
214+
--assert not strict-equal? [1.0] [$1]
215+
--assert strict-equal? [1%] [1%]
216+
--assert not strict-equal? [100%] [1]
217+
--assert not strict-equal? [100%] [1.0]
218+
--assert not strict-equal? [100%] [$1]
219+
--assert strict-equal? [$1] [$1]
220+
--assert not strict-equal? [$1] [1]
221+
--assert not strict-equal? [$1] [1.0]
222+
--assert not strict-equal? [$1] [100%]
223+
--test-- "strict-equal? block! with blocks"
224+
--assert strict-equal? [[1]] [[1]]
225+
--assert not strict-equal? [[1]] [(1)]
226+
227+
===end-group===
228+
229+
;- tests from Red Language...
230+
===start-group=== "prefix equal same datatype"
231+
--test-- "prefix-equal-same-datatype-1" --assert equal? 0 0
232+
--test-- "prefix-equal-same-datatype-2" --assert equal? 1 1
233+
--test-- "prefix-equal-same-datatype-3" --assert equal? 0#FFFFFFFFFFFFFFFF -1
234+
--test-- "prefix-equal-same-datatype-4" --assert equal? [] []
235+
--test-- "prefix-equal-same-datatype-5" --assert equal? [a] [a]
236+
--test-- "prefix-equal-same-datatype-6" --assert equal? [A] [a]
237+
--test-- "prefix-equal-same-datatype-7" --assert equal? ['a] [a]
238+
--test-- "prefix-equal-same-datatype-8" --assert equal? [a:] [a]
239+
--test-- "prefix-equal-same-datatype-9" --assert equal? [:a] [a]
240+
--test-- "prefix-equal-same-datatype-10" --assert equal? [:a] [a:]
241+
--test-- "prefix-equal-same-datatype-11" --assert equal? [abcde] [abcde]
242+
--test-- "prefix-equal-same-datatype-12" --assert equal? [a b c d] [a b c d]
243+
--test-- "prefix-equal-same-datatype-13" --assert equal? [b c d] next [a b c d]
244+
--test-- "prefix-equal-same-datatype-14" --assert equal? [b c d] (next [a b c d])
245+
--test-- "prefix-equal-same-datatype-15" --assert equal? "a" "a"
246+
--test-- "prefix-equal-same-datatype-16" --assert equal? "a" "A"
247+
--test-- "prefix-equal-same-datatype-17" --assert equal? "abcdeè" "abcdeè"
248+
--test-- "prefix-equal-same-datatype-18" --assert equal? (next "abcdeè") next "abcdeè"
249+
--test-- "prefix-equal-same-datatype-19" --assert equal? (first "abcdeè") first "abcdeè"
250+
--test-- "prefix-equal-same-datatype-20" --assert equal? (last "abcdeè") last "abcdeè"
251+
--test-- "prefix-equal-same-datatype-21" --assert equal? "abcde^(2710)é" "abcde^(2710)é"
252+
--test-- "prefix-equal-same-datatype-22" --assert equal? [d] back tail [a b c d]
253+
--test-- "prefix-equal-same-datatype-23" --assert equal? "2345" next "12345"
254+
--test-- "prefix-equal-same-datatype-24" --assert equal? #"z" #"z"
255+
--test-- "prefix-equal-same-datatype-25" --assert equal? #"z" #"Z" ;@@ in Red this is not equal!
256+
--test-- "prefix-equal-same-datatype-25" --red-- --assert not equal? #"z" #"Z"
257+
--test-- "prefix-equal-same-datatype-26" --assert not equal? #"e" #"è"
258+
; --test-- "prefix-equal-same-datatype-27" --assert equal? #"^(010000)" #"^(010000)"
259+
--test-- "prefix-equal-same-datatype-28" --assert equal? true true
260+
--test-- "prefix-equal-same-datatype-29" --assert equal? false false
261+
--test-- "prefix-equal-same-datatype-30" --assert not equal? false true
262+
--test-- "prefix-equal-same-datatype-31" --assert not equal? true false
263+
--test-- "prefix-equal-same-datatype-32" --assert equal? none none
264+
--test-- "prefix-equal-same-datatype-33" --assert equal? 'a 'a
265+
--test-- "prefix-equal-same-datatype-34" --assert equal? 'a 'A
266+
--test-- "prefix-equal-same-datatype-35" --assert equal? (first [a]) first [a]
267+
--test-- "prefix-equal-same-datatype-36" --assert equal? 'a first [A]
268+
--test-- "prefix-equal-same-datatype-37" --assert equal? 'a first ['a]
269+
--test-- "prefix-equal-same-datatype-38" --assert equal? 'a first [:a]
270+
--test-- "prefix-equal-same-datatype-39" --assert equal? 'a first [a:]
271+
--test-- "prefix-equal-same-datatype-40" --assert equal? (first [a:]) first [a:]
272+
--test-- "prefix-equal-same-datatype-41" --assert equal? (first [:a]) first [:a]
273+
--test-- "prefix-equal-same-datatype-42" --assert equal? [a b c d e] first [[a b c d e]]
274+
--test-- "prefix-equal-same-datatype-43" ea-result: 1 = 1 --assert ea-result = true
275+
--test-- "prefix-equal-same-datatype-44" ea-result: 1 = 0 --assert ea-result = false
276+
--test-- "prefix-equal-same-datatype-45" ea-result: equal? 1 1 --assert ea-result = true
277+
--test-- "prefix-equal-same-datatype-46" ea-result: equal? 1 0 --assert ea-result = false
278+
===end-group===
279+
280+
===start-group=== "prefix strict-equal same datatype"
281+
--test-- "prefix-strict-equal-same-datatype-1" --assert strict-equal? 0 0
282+
--test-- "prefix-strict-equal-same-datatype-2" --assert strict-equal? 1 1
283+
--test-- "prefix-strict-equal-same-datatype-3" --assert strict-equal? 0#FFFFFFFFFFFFFFFF -1
284+
--test-- "prefix-strict-equal-same-datatype-4" --assert strict-equal? [] []
285+
--test-- "prefix-strict-equal-same-datatype-5" --assert strict-equal? [a] [a]
286+
--test-- "prefix-strict-equal-same-datatype-6" --assert not strict-equal? [A] [a]
287+
--test-- "prefix-strict-equal-same-datatype-7" --assert not strict-equal? ['a] [a]
288+
--test-- "prefix-strict-equal-same-datatype-8" --assert not strict-equal? [a:] [a]
289+
--test-- "prefix-strict-equal-same-datatype-9" --assert not strict-equal? [:a] [a]
290+
--test-- "prefix-strict-equal-same-datatype-10" --assert not strict-equal? [:a] [a:]
291+
--test-- "prefix-strict-equal-same-datatype-11" --assert strict-equal? [abcde] [abcde]
292+
--test-- "prefix-strict-equal-same-datatype-12" --assert strict-equal? [a b c d] [a b c d]
293+
--test-- "prefix-strict-equal-same-datatype-13" --assert strict-equal? [b c d] next [a b c d]
294+
--test-- "prefix-strict-equal-same-datatype-14" --assert strict-equal? [b c d] (next [a b c d])
295+
--test-- "prefix-strict-equal-same-datatype-15" --assert strict-equal? "a" "a"
296+
--test-- "prefix-strict-equal-same-datatype-16" --assert not strict-equal? "a" "A"
297+
--test-- "prefix-strict-equal-same-datatype-17" --assert strict-equal? "abcdeè" "abcdeè"
298+
--test-- "prefix-strict-equal-same-datatype-18" --assert strict-equal? (next "abcdeè") next "abcdeè"
299+
--test-- "prefix-strict-equal-same-datatype-19" --assert strict-equal? (first "abcdeè") first "abcdeè"
300+
--test-- "prefix-strict-equal-same-datatype-20" --assert strict-equal? (last "abcdeè") last "abcdeè"
301+
--test-- "prefix-strict-equal-same-datatype-21" --assert strict-equal? "abcde^(2710)é" "abcde^(2710)é"
302+
--test-- "prefix-strict-equal-same-datatype-22" --assert strict-equal? [d] back tail [a b c d]
303+
--test-- "prefix-strict-equal-same-datatype-23" --assert strict-equal? "2345" next "12345"
304+
--test-- "prefix-strict-equal-same-datatype-24" --assert strict-equal? #"z" #"z"
305+
--test-- "prefix-strict-equal-same-datatype-25" --assert not strict-equal? #"z" #"Z"
306+
--test-- "prefix-strict-equal-same-datatype-26" --assert not strict-equal? #"e" #"è"
307+
; --test-- "prefix-strict-equal-same-datatype-27" --assert strict-equal? #"^(010000)" #"^(010000)"
308+
--test-- "prefix-strict-equal-same-datatype-28" --assert strict-equal? true true
309+
--test-- "prefix-strict-equal-same-datatype-29" --assert strict-equal? false false
310+
--test-- "prefix-strict-equal-same-datatype-30" --assert not strict-equal? false true
311+
--test-- "prefix-strict-equal-same-datatype-31" --assert not strict-equal? true false
312+
--test-- "prefix-strict-equal-same-datatype-32" --assert strict-equal? none none
313+
--test-- "prefix-strict-equal-same-datatype-33" --assert strict-equal? 'a 'a
314+
--test-- "prefix-strict-equal-same-datatype-34" --assert not strict-equal? 'a 'A
315+
--test-- "prefix-strict-equal-same-datatype-35" --assert strict-equal? (first [a]) first [a]
316+
--test-- "prefix-strict-equal-same-datatype-36" --assert strict-equal? 'a first [a]
317+
--test-- "prefix-strict-equal-same-datatype-37" --assert not strict-equal? 'a first ['a]
318+
--test-- "prefix-strict-equal-same-datatype-38" --assert not strict-equal? 'a first [:a]
319+
--test-- "prefix-strict-equal-same-datatype-39" --assert not strict-equal? 'a first [a:]
320+
--test-- "prefix-strict-equal-same-datatype-40" --assert strict-equal? (first [a:]) first [a:]
321+
--test-- "prefix-strict-equal-same-datatype-41" --assert strict-equal? (first [:a]) first [:a]
322+
--test-- "prefix-strict-equal-same-datatype-42" --assert strict-equal? [a b c d e] first [[a b c d e]]
323+
--test-- "prefix-strict-equal-same-datatype-43" ea-result: 1 == 1 --assert ea-result = true
324+
--test-- "prefix-strict-equal-same-datatype-44" ea-result: 1 == 0 --assert ea-result = false
325+
===end-group===
326+
327+
===start-group=== "prefix equal implcit cast"
328+
--test-- "prefix-equal-implcit-cast-1" --assert equal? #"0" 48
329+
--test-- "prefix-equal-implcit-cast-2" --assert equal? 48 #"0"
330+
--test-- "prefix-equal-implcit-cast-3" --assert equal? #"^(2710)" 10000
331+
; --test-- "prefix-equal-implcit-cast-4" --assert equal? #"^(010000)" 65536
332+
--test-- "prefix-equal-implcit-cast-5" ea-result: #"1" = 49 --assert ea-result = true
333+
===end-group===
334+
335+
===start-group=== "prefix-greater-same-datatype"
336+
--test-- "prefix-greater-same-datatype-1" --assert not greater? 0 0
337+
--test-- "prefix-greater-same-datatype-2" --assert greater? 1 0
338+
--test-- "prefix-greater-same-datatype-3" --assert not greater? 1 1
339+
--test-- "prefix-greater-same-datatype-4" --assert not greater? 0#FFFFFFFFFFFFFFFF -1
340+
--test-- "prefix-greater-same-datatype-5" --assert greater? -1 0#FFFFFFFFFFFFFFFE
341+
--test-- "prefix-greater-same-datatype-6" --assert not greater? -2 0#FFFFFFFFFFFFFFFF
342+
--test-- "prefix-greater-same-datatype-7" --assert not greater? "a" "a"
343+
--test-- "prefix-greater-same-datatype-8" --assert greater? "b" "a"
344+
--test-- "prefix-greater-same-datatype-9" --assert greater? "è" "f"
345+
--test-- "prefix-greater-same-datatype-10" --assert not greater? "A" "a"
346+
--test-- "prefix-greater-same-datatype-11" --assert not greater? "a" "A"
347+
--test-- "prefix-greater-same-datatype-12" --assert not greater? "abcdeè" "abcdeè"
348+
--test-- "prefix-greater-same-datatype-13" --assert not greater? (next "abcdeè") next "abcdeè"
349+
--test-- "prefix-greater-same-datatype-14" --assert not greater? (first "abcdeè") first "abcdeè"
350+
--test-- "prefix-greater-same-datatype-15" --assert not greater? (last "abcdeè") last "abcdeè"
351+
--test-- "prefix-greater-same-datatype-16" --assert not greater? "abcde^(2710)é" "abcde^(2710)é"
352+
--test-- "prefix-greater-same-datatype-17" --assert not greater? "2345" next "12345"
353+
--test-- "prefix-greater-same-datatype-18" --assert not greater? #"z" #"z"
354+
--test-- "prefix-greater-same-datatype-19" --assert greater? #"z" #"Z"
355+
--test-- "prefix-greater-same-datatype-20" --assert greater? #"è" #"e"
356+
; --test-- "prefix-greater-same-datatype-21" --assert not greater? #"^(010000)" #"^(010000)"
357+
===end-group===
358+
359+
162360
~~~end-file~~~

0 commit comments

Comments
 (0)