Skip to content

Commit fe44958

Browse files
committed
FEAT: implemented transcode/one for translating just one value
related to: Oldes/Rebol-issues#1329 related to: Oldes/Rebol-issues#1916
1 parent 769b5e5 commit fe44958

File tree

3 files changed

+101
-80
lines changed

3 files changed

+101
-80
lines changed

src/boot/natives.reb

+1
Original file line numberDiff line numberDiff line change
@@ -655,6 +655,7 @@ transcode: native [
655655
{Translates UTF-8 binary source to values. Returns one or several values in a block.}
656656
source [binary! string!] "UTF-8 input buffer; string argument will be UTF-8 encoded"
657657
/next "Translate next complete value (blocks as single value)"
658+
/one "Translate next complete value (returns the value only)"
658659
/only "Translate only a single value (blocks dissected)"
659660
/error "Do not cause errors - return error object as value in place"
660661
]

src/core/l-scan.c

+13-4
Original file line numberDiff line numberDiff line change
@@ -1891,7 +1891,11 @@ extern REBSER *Scan_Full_Block(SCAN_STATE *scan_state, REBYTE mode_char);
18911891
***********************************************************************/
18921892
{
18931893
SCAN_STATE scan_state;
1894-
REBVAL *src = D_ARG(1);
1894+
REBVAL *src = D_ARG(1);
1895+
REBOOL next = D_REF(2);
1896+
REBOOL one = D_REF(3);
1897+
REBOOL only = D_REF(4);
1898+
REBOOL error = D_REF(5);
18951899
REBSER *blk;
18961900
REBSER *ser;
18971901
REBYTE *bin;
@@ -1910,12 +1914,17 @@ extern REBSER *Scan_Full_Block(SCAN_STATE *scan_state, REBYTE mode_char);
19101914

19111915
Init_Scan_State(&scan_state, bin, len);
19121916

1913-
if (D_REF(2)) SET_FLAG(scan_state.opts, SCAN_NEXT);
1914-
if (D_REF(3)) SET_FLAG(scan_state.opts, SCAN_ONLY);
1915-
if (D_REF(4)) SET_FLAG(scan_state.opts, SCAN_RELAX);
1917+
if (next || one) SET_FLAG(scan_state.opts, SCAN_NEXT);
1918+
if (only) SET_FLAG(scan_state.opts, SCAN_ONLY);
1919+
if (error) SET_FLAG(scan_state.opts, SCAN_RELAX);
19161920

19171921
blk = Scan_Code(&scan_state, 0);
19181922
DS_RELOAD(ds); // in case stack moved
1923+
1924+
if (one) {
1925+
*D_RET = *BLK_SKIP(blk, 0);
1926+
return IS_END(D_RET) ? R_UNSET : R_RET;
1927+
}
19191928
Set_Block(D_RET, blk);
19201929

19211930
if (scan_state.opts) {

src/tests/units/lexer-test.r3

+87-76
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,12 @@ Rebol [
2222
--assert [[1 + 1] ""] = transcode/next "[1 + 1]"
2323
--assert [[1 + 1] #{}] = transcode/next to binary! "[1 + 1]"
2424

25+
--test-- "transcode/one"
26+
;@@ https://github.com/Oldes/Rebol-issues/issues/1329
27+
--assert unset? transcode/one ""
28+
--assert 1 = transcode/one "1 2"
29+
--assert [1 2] = transcode/one "[1 2]"
30+
2531
===end-group===
2632

2733
===start-group=== "Invalid construction"
@@ -417,99 +423,104 @@ Rebol [
417423
--assert error? try [load {#[file! "ab" 2 x]}]
418424
--test-- {object!}
419425
;@@ https://github.com/Oldes/Rebol-issues/issues/864
420-
--assert block? try [transcode "#[object! [a: 1 b: 2]]"]
421-
--assert block? try [transcode/only "#[object! [a: 1 b: 2]]"]
426+
--assert block? try [transcode "#[object! [a: 1 b: 2]]"]
427+
--assert block? try [transcode/only "#[object! [a: 1 b: 2]]"]
428+
--assert object? try [transcode/one "#[object! [a: 1 b: 2]]"]
422429
--test-- {function!}
423430
;@@ https://github.com/Oldes/Rebol-issues/issues/1114
424-
--assert function? first transcode {#[function! [[a [series!]][print a]]]}
431+
--assert function? transcode/one {#[function! [[a [series!]][print a]]]}
425432

426433
--test-- {datatype!}
427434
;@@ https://github.com/Oldes/Rebol-issues/issues/2508
428-
--assert datatype? first transcode/only {#[unset!]}
429-
--assert datatype? first transcode/only {#[none!]}
430-
--assert datatype? first transcode/only {#[logic!]}
431-
--assert datatype? first transcode/only {#[integer!]}
432-
--assert datatype? first transcode/only {#[decimal!]}
433-
--assert datatype? first transcode/only {#[percent!]}
434-
--assert datatype? first transcode/only {#[money!]}
435-
--assert datatype? first transcode/only {#[char!]}
436-
--assert datatype? first transcode/only {#[pair!]}
437-
--assert datatype? first transcode/only {#[tuple!]}
438-
--assert datatype? first transcode/only {#[time!]}
439-
--assert datatype? first transcode/only {#[date!]}
440-
--assert datatype? first transcode/only {#[binary!]}
441-
--assert datatype? first transcode/only {#[string!]}
442-
--assert datatype? first transcode/only {#[file!]}
443-
--assert datatype? first transcode/only {#[email!]}
444-
--assert datatype? first transcode/only {#[ref!]}
445-
--assert datatype? first transcode/only {#[url!]}
446-
--assert datatype? first transcode/only {#[tag!]}
447-
--assert datatype? first transcode/only {#[bitset!]}
448-
--assert datatype? first transcode/only {#[image!]}
449-
--assert datatype? first transcode/only {#[vector!]}
450-
--assert datatype? first transcode/only {#[block!]}
451-
--assert datatype? first transcode/only {#[paren!]}
452-
--assert datatype? first transcode/only {#[path!]}
453-
--assert datatype? first transcode/only {#[set-path!]}
454-
--assert datatype? first transcode/only {#[get-path!]}
455-
--assert datatype? first transcode/only {#[lit-path!]}
456-
--assert datatype? first transcode/only {#[map!]}
457-
--assert datatype? first transcode/only {#[datatype!]}
458-
--assert datatype? first transcode/only {#[typeset!]}
459-
--assert datatype? first transcode/only {#[word!]}
460-
--assert datatype? first transcode/only {#[set-word!]}
461-
--assert datatype? first transcode/only {#[get-word!]}
462-
--assert datatype? first transcode/only {#[lit-word!]}
463-
--assert datatype? first transcode/only {#[refinement!]}
464-
--assert datatype? first transcode/only {#[issue!]}
465-
--assert datatype? first transcode/only {#[native!]}
466-
--assert datatype? first transcode/only {#[action!]}
467-
--assert datatype? first transcode/only {#[rebcode!]}
468-
--assert datatype? first transcode/only {#[command!]}
469-
--assert datatype? first transcode/only {#[op!]}
470-
--assert datatype? first transcode/only {#[closure!]}
471-
--assert datatype? first transcode/only {#[function!]}
472-
--assert datatype? first transcode/only {#[frame!]}
473-
--assert datatype? first transcode/only {#[object!]}
474-
--assert datatype? first transcode/only {#[module!]}
475-
--assert datatype? first transcode/only {#[error!]}
476-
--assert datatype? first transcode/only {#[task!]}
477-
--assert datatype? first transcode/only {#[port!]}
478-
--assert datatype? first transcode/only {#[gob!]}
479-
--assert datatype? first transcode/only {#[event!]}
480-
--assert datatype? first transcode/only {#[handle!]}
481-
--assert datatype? first transcode/only {#[struct!]}
482-
--assert datatype? first transcode/only {#[library!]}
483-
--assert datatype? first transcode/only {#[utype!]}
435+
--assert datatype? transcode/one {#[unset!]}
436+
--assert datatype? transcode/one {#[none!]}
437+
--assert datatype? transcode/one {#[logic!]}
438+
--assert datatype? transcode/one {#[integer!]}
439+
--assert datatype? transcode/one {#[decimal!]}
440+
--assert datatype? transcode/one {#[percent!]}
441+
--assert datatype? transcode/one {#[money!]}
442+
--assert datatype? transcode/one {#[char!]}
443+
--assert datatype? transcode/one {#[pair!]}
444+
--assert datatype? transcode/one {#[tuple!]}
445+
--assert datatype? transcode/one {#[time!]}
446+
--assert datatype? transcode/one {#[date!]}
447+
--assert datatype? transcode/one {#[binary!]}
448+
--assert datatype? transcode/one {#[string!]}
449+
--assert datatype? transcode/one {#[file!]}
450+
--assert datatype? transcode/one {#[email!]}
451+
--assert datatype? transcode/one {#[ref!]}
452+
--assert datatype? transcode/one {#[url!]}
453+
--assert datatype? transcode/one {#[tag!]}
454+
--assert datatype? transcode/one {#[bitset!]}
455+
--assert datatype? transcode/one {#[image!]}
456+
--assert datatype? transcode/one {#[vector!]}
457+
--assert datatype? transcode/one {#[block!]}
458+
--assert datatype? transcode/one {#[paren!]}
459+
--assert datatype? transcode/one {#[path!]}
460+
--assert datatype? transcode/one {#[set-path!]}
461+
--assert datatype? transcode/one {#[get-path!]}
462+
--assert datatype? transcode/one {#[lit-path!]}
463+
--assert datatype? transcode/one {#[map!]}
464+
--assert datatype? transcode/one {#[datatype!]}
465+
--assert datatype? transcode/one {#[typeset!]}
466+
--assert datatype? transcode/one {#[word!]}
467+
--assert datatype? transcode/one {#[set-word!]}
468+
--assert datatype? transcode/one {#[get-word!]}
469+
--assert datatype? transcode/one {#[lit-word!]}
470+
--assert datatype? transcode/one {#[refinement!]}
471+
--assert datatype? transcode/one {#[issue!]}
472+
--assert datatype? transcode/one {#[native!]}
473+
--assert datatype? transcode/one {#[action!]}
474+
--assert datatype? transcode/one {#[rebcode!]}
475+
--assert datatype? transcode/one {#[command!]}
476+
--assert datatype? transcode/one {#[op!]}
477+
--assert datatype? transcode/one {#[closure!]}
478+
--assert datatype? transcode/one {#[function!]}
479+
--assert datatype? transcode/one {#[frame!]}
480+
--assert datatype? transcode/one {#[object!]}
481+
--assert datatype? transcode/one {#[module!]}
482+
--assert datatype? transcode/one {#[error!]}
483+
--assert datatype? transcode/one {#[task!]}
484+
--assert datatype? transcode/one {#[port!]}
485+
--assert datatype? transcode/one {#[gob!]}
486+
--assert datatype? transcode/one {#[event!]}
487+
--assert datatype? transcode/one {#[handle!]}
488+
--assert datatype? transcode/one {#[struct!]}
489+
--assert datatype? transcode/one {#[library!]}
490+
--assert datatype? transcode/one {#[utype!]}
484491
--test-- {direct values}
485-
--assert logic? first transcode/only {#[true]}
486-
--assert logic? first transcode/only {#[false]}
487-
--assert none? first transcode/only {#[none]}
488-
--assert unset? first transcode/only {#[unset]}
492+
--assert logic? transcode/one {#[true]}
493+
--assert logic? transcode/one {#[false]}
494+
--assert none? transcode/one {#[none]}
495+
--assert unset? transcode/one {#[unset]}
489496

490497
===end-group===
491498

492499
===start-group=== "BINARY"
493500
--test-- {binary! with spaces}
494-
--assert #{00} = first transcode/only " #{0 0}"
495-
--assert #{00} = first transcode/only "2#{0000 00 00}"
496-
--assert #{00} = first transcode/only "2#{0000^/0000}"
497-
--assert #{00} = first transcode/only "2#{0000^M0000}"
498-
--assert #{01} = first transcode/only "2#{0000^-0001}"
499-
--assert #{02} = first transcode/only "2#{0000^ 0010}"
500-
--assert #{0001} = first transcode/only "16#{00 01}"
501-
--assert #{0001} = first transcode/only "64#{AA E=}"
501+
--assert #{00} = transcode/one " #{0 0}"
502+
--assert #{00} = transcode/one "2#{0000 00 00}"
503+
--assert #{00} = transcode/one "2#{0000^/0000}"
504+
--assert #{00} = transcode/one "2#{0000^M0000}"
505+
--assert #{01} = transcode/one "2#{0000^-0001}"
506+
--assert #{02} = transcode/one "2#{0000^ 0010}"
507+
--assert #{0001} = transcode/one "16#{00 01}"
508+
--assert #{0001} = transcode/one "64#{AA E=}"
502509

503510
--test-- {binary! with comments inside}
504511
;@@ https://github.com/Oldes/Rebol-wishes/issues/23
505-
--assert #{00} = first transcode/only/error "#{;XXX^/00}"
506-
--assert #{00} = first transcode/only/error "#{00;XXX^/}"
507-
--assert #{0002} = first transcode/only/error "#{00;XXX^/02}"
508-
--assert #{0002} = first transcode/only/error "#{00;XXX^M02}" ;CR is also comment stopper
512+
--assert #{00} = transcode/one/error "#{;XXX^/00}"
513+
--assert #{00} = transcode/one/error "#{00;XXX^/}"
514+
--assert #{0002} = transcode/one/error "#{00;XXX^/02}"
515+
--assert #{0002} = transcode/one/error "#{00;XXX^M02}" ;CR is also comment stopper
516+
517+
--assert error? transcode/one/error "#{0}"
518+
509519
--test-- {binary! with other valid escapes}
510-
--assert #{0003} = first transcode/only/error "#{^(30)^(30)03}"
520+
--assert #{0003} = transcode/one/error "#{^(30)^(30)03}"
511521
--test-- {binary! with unicode char} ; is handled early
512522
--assert error? first transcode/only/error "#{0č}"
523+
--assert error? transcode/one/error "#{0č}"
513524
--test-- "Invalid binary"
514525
;@@ https://github.com/Oldes/Rebol-issues/issues/1431
515526
--assert all [error? e: try [load {000016#{FF}}] e/id = 'invalid e/arg1 = "integer"]

0 commit comments

Comments
 (0)