Skip to content

Commit 27ab5a4

Browse files
OldesOldes
committed
FEAT: make context type handles comparable
resolves: Oldes/Rebol-issues#1868 related to: Oldes/Rebol-issues#1765
1 parent 6339017 commit 27ab5a4

File tree

8 files changed

+212
-4
lines changed

8 files changed

+212
-4
lines changed

‎make/rebol3.nest

+1
Original file line numberDiff line numberDiff line change
@@ -118,6 +118,7 @@ core-files: [
118118
%core/t-event.c
119119
%core/t-function.c
120120
%core/t-gob.c
121+
%core/t-handle.c
121122
%core/t-image.c
122123
%core/t-integer.c
123124
%core/t-logic.c

‎src/boot/types.reb

+2-1
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ REBOL [
33
Title: "Datatype definitions"
44
Rights: {
55
Copyright 2012 REBOL Technologies
6+
Copyright 2012-2021 Rebol Open Source Contributors
67
REBOL is a trademark of REBOL Technologies
78
}
89
License: {
@@ -98,7 +99,7 @@ REBOL [
9899

99100
gob self gob * * * * -
100101
event self event * * * * -
101-
handle self 0 - - - - -
102+
handle self handle - - - - -
102103
struct self struct * * * * -
103104
library invalid 0 - - - - -
104105
utype self utype - - - - -

‎src/core/c-handle.c

+5-3
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@
3434

3535
#include "sys-core.h"
3636

37-
#define MAX_HANDLE_TYPES 16
37+
#define MAX_HANDLE_TYPES 64
3838

3939

4040
/***********************************************************************
@@ -55,9 +55,11 @@
5555
//printf("Register_Handle: %s with size %u\n", SYMBOL_TO_NAME(sym), size);
5656

5757
idx = Find_Handle_Index(sym);
58-
if (idx != NOT_FOUND) Crash(RP_HANDLE_ALREADY_REGISTERED);
58+
if (idx != NOT_FOUND)
59+
return idx; //TODO: make sure, that the already registered handle is compatible!
5960
idx = VAL_TAIL(handles);
60-
if (idx >= MAX_HANDLE_TYPES) Crash(RP_MAX_HANDLES);
61+
if (idx >= MAX_HANDLE_TYPES)
62+
Crash(RP_MAX_HANDLES); //TODO: realloc PG_Handles instead!
6163

6264
REBVAL *val = Append_Value(VAL_SERIES(handles));
6365
Set_Word(val, sym, 0, 0);

‎src/core/f-series.c

+4
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
** REBOL [R3] Language Interpreter and Run-time Environment
44
**
55
** Copyright 2012 REBOL Technologies
6+
** Copyright 2012-2021 Rebol Open Source Contributors
67
** REBOL is a trademark of REBOL Technologies
78
**
89
** Licensed under the Apache License, Version 2.0 (the "License");
@@ -306,6 +307,9 @@
306307
case REB_STRUCT:
307308
return Cmp_Struct(s, t);
308309

310+
case REB_HANDLE:
311+
return Cmp_Handle(s, t);
312+
309313
case REB_NONE:
310314
case REB_UNSET:
311315
case REB_END:

‎src/core/s-crc.c

+5
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
** REBOL [R3] Language Interpreter and Run-time Environment
44
**
55
** Copyright 2012 REBOL Technologies
6+
** Copyright 2012-2021 Rebol Open Source Contributors
67
** REBOL is a trademark of REBOL Technologies
78
**
89
** Licensed under the Apache License, Version 2.0 (the "License");
@@ -264,6 +265,10 @@ static REBCNT *CRC32_Table = 0;
264265
ret = 0;
265266
break;
266267

268+
case REB_HANDLE:
269+
ret = (REBCNT)VAL_HANDLE_I32(val);
270+
break;
271+
267272
default:
268273
return 0; //ret = 3 * (hash_size/5);
269274
}

‎src/core/t-handle.c

+112
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,112 @@
1+
/***********************************************************************
2+
**
3+
** REBOL [R3] Language Interpreter and Run-time Environment
4+
**
5+
** Copyright 2012 REBOL Technologies
6+
** Copyright 2012-2021 Rebol Open Source Contributors
7+
** REBOL is a trademark of REBOL Technologies
8+
**
9+
** Licensed under the Apache License, Version 2.0 (the "License");
10+
** you may not use this file except in compliance with the License.
11+
** You may obtain a copy of the License at
12+
**
13+
** http://www.apache.org/licenses/LICENSE-2.0
14+
**
15+
** Unless required by applicable law or agreed to in writing, software
16+
** distributed under the License is distributed on an "AS IS" BASIS,
17+
** WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
18+
** See the License for the specific language governing permissions and
19+
** limitations under the License.
20+
**
21+
************************************************************************
22+
**
23+
** Module: t-handle.c
24+
** Summary: handle datatype
25+
** Section: datatypes
26+
** Author: Oldes
27+
** Notes:
28+
**
29+
***********************************************************************/
30+
31+
#include "sys-core.h"
32+
33+
/***********************************************************************
34+
**
35+
*/ REBINT Cmp_Handle(REBVAL *a, REBVAL *b)
36+
/*
37+
***********************************************************************/
38+
{
39+
REBYTE *sp;
40+
REBYTE *tp;
41+
if (IS_CONTEXT_HANDLE(a)) {
42+
if (IS_CONTEXT_HANDLE(b)) {
43+
if (VAL_HANDLE_SYM(a) != VAL_HANDLE_SYM(b)) {
44+
// comparing 2 context handles of different types
45+
sp = VAL_HANDLE_NAME(a);
46+
tp = VAL_HANDLE_NAME(b);
47+
return Compare_UTF8(sp, tp, (REBCNT)LEN_BYTES(tp)) + 2;
48+
}
49+
}
50+
else {
51+
// comparing context-handle with data-handle
52+
return -1;
53+
}
54+
}
55+
else if (IS_CONTEXT_HANDLE(b)) {
56+
// comparing data-handle with context-handle
57+
return 1;
58+
}
59+
// same ctx-handle types or both data handles
60+
return (VAL_HANDLE_I32(a) - VAL_HANDLE_I32(b));
61+
}
62+
63+
/***********************************************************************
64+
**
65+
*/ REBINT CT_Handle(REBVAL *a, REBVAL *b, REBINT mode)
66+
/*
67+
***********************************************************************/
68+
{
69+
REBINT diff;
70+
if (mode > 0) {
71+
return ((VAL_HANDLE_FLAGS(a) == VAL_HANDLE_FLAGS(b))
72+
&& (VAL_HANDLE_DATA(a) == VAL_HANDLE_DATA(b)));
73+
}
74+
else if (mode == 0) {
75+
return (IS_CONTEXT_HANDLE(a) && IS_CONTEXT_HANDLE(b)
76+
&& (VAL_HANDLE_SYM(a) == VAL_HANDLE_SYM(b)));
77+
}
78+
else {
79+
diff = Cmp_Handle(a, b);
80+
if (mode == -1) return (diff >= 0);
81+
return (diff > 0);
82+
}
83+
}
84+
85+
86+
/***********************************************************************
87+
**
88+
*/ REBFLG MT_Handle(REBVAL *out, REBVAL *data, REBCNT type)
89+
/*
90+
***********************************************************************/
91+
{
92+
return FALSE;
93+
}
94+
95+
96+
/***********************************************************************
97+
**
98+
*/ REBTYPE(Handle)
99+
/*
100+
**
101+
***********************************************************************/
102+
{
103+
REBVAL *val = D_ARG(1);
104+
105+
switch (action) {
106+
107+
default:
108+
Trap_Action(VAL_TYPE(val), action);
109+
}
110+
111+
return R_RET;
112+
}

‎src/tests/run-tests.r3

+1
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,7 @@ dt [ ;- delta time
3434
%units/evaluation-test.r3
3535
%units/event-test.r3
3636
%units/gob-test.r3
37+
%units/handle-test.r3
3738
%units/file-test.r3
3839
%units/format-test.r3
3940
%units/func-test.r3

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

+82
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,82 @@
1+
Rebol [
2+
Title: "Rebol3 handle test script"
3+
Author: "Oldes, Peter W A Wood"
4+
File: %handle-test.r3
5+
Tabs: 4
6+
Needs: [%../quick-test-module.r3]
7+
]
8+
9+
;@@ https://github.com/Oldes/Rebol-issues/issues/1868
10+
11+
~~~start-file~~~ "handle!"
12+
13+
===start-group=== "context handles"
14+
15+
; create some context handles for testing
16+
h1: rc4/key #{0000}
17+
h2: rc4/key #{0000}
18+
h3: aes/key #{00000000000000000000000000000000} none
19+
h4: aes/key #{00000000000000000000000000000000} none
20+
21+
--test-- "same? handles"
22+
; handles are same if they have same type and also same data
23+
--assert h1 == h1
24+
--assert h1 !== h2
25+
--assert same? h1 h1
26+
--assert same? h4 h4
27+
--assert not same? h1 h2
28+
--assert not same? h2 h1
29+
--assert not same? h1 h4
30+
--assert not same? h4 h1
31+
--assert not same? h3 h4
32+
--assert not same? h4 h3
33+
34+
--test-- "equal? handles"
35+
; handles are equal, if they have same type
36+
--assert h1 = h1
37+
--assert h1 = h2
38+
--assert equal? h1 h1
39+
--assert equal? h1 h2
40+
--assert equal? h2 h1
41+
--assert equal? h3 h3
42+
--assert equal? h3 h4
43+
--assert equal? h4 h3
44+
--assert not-equal? h1 h4
45+
--assert not-equal? h4 h1
46+
--assert not-equal? h2 h3
47+
--assert not-equal? h3 h2
48+
49+
--test-- "lesser? / greater? handles"
50+
--assert h3 < h1
51+
--assert h1 > h3
52+
--assert lesser? h3 h1
53+
--assert greater? h1 h3
54+
55+
--test-- "sort/find handles"
56+
blk: reduce [h1 h3 h2 h4]
57+
--assert 1 = index? find blk h1
58+
--assert 2 = index? find blk h3
59+
--assert 3 = index? find blk h2
60+
--assert 4 = index? find blk h4
61+
--assert {[#[handle! aes] #[handle! aes] #[handle! rc4] #[handle! rc4]]} = mold try [sort blk]
62+
--assert {[#[handle! rc4] #[handle! rc4] #[handle! aes] #[handle! aes]]} = mold try [sort/reverse blk]
63+
64+
--test-- "handle as a key in map"
65+
m: #()
66+
--assert not error? try [m/(h1): 1]
67+
--assert not error? try [repend m [h2 2 h3 3]]
68+
--assert 1 = try [pick m h1]
69+
--assert 2 = try [m/(h2)]
70+
--assert 3 = try [select m h3]
71+
72+
--test-- "set operations with handles"
73+
;@@ https://github.com/Oldes/Rebol-issues/issues/1765
74+
--assert "[#[handle! rc4] #[handle! aes]]" = mold unique reduce [h1 h1 h3]
75+
--assert "[#[handle! rc4] #[handle! rc4]]" = mold difference reduce [h1 h3] reduce [h3 h2]
76+
--assert "[#[handle! rc4] #[handle! aes]]" = mold union reduce [h1 h3] reduce [h3 h1]
77+
--assert "[#[handle! aes]]" = mold intersect reduce [h1 h3] reduce [h3 h2]
78+
--assert "[#[handle! rc4]]" = mold exclude reduce [h1 h3] reduce [h3 h2]
79+
80+
===end-group===
81+
82+
~~~end-file~~~

0 commit comments

Comments
 (0)