FEAT: enhanced ajoin native function for merging values into a stri…

…ng types resolves: Oldes/Rebol-issues#2558 related to: Oldes/Rebol-issues#2100 related to: Oldes/Rebol-wishes#19
Oldes · Jul 15, 2023 · 82682e1 · 82682e1
1 parent 8115be7
commit 82682e1
Show file tree

Hide file tree

Showing 4 changed files with 124 additions and 11 deletions.
diff --git a/src/boot/natives.reb b/src/boot/natives.reb
@@ -20,8 +20,10 @@ REBOL [
 ;-- Control Natives - nat_control.c
 
 ajoin: native [
-	{Reduces and joins a block of values into a new string.}
+	{Reduces and joins a block of values into a new string. Ignores none and unset values.}
 	block [block!]
+	/with delimiter [any-type!]
+	/all "Do not ignore none and unset values"
 ]
 
 also: native [

diff --git a/src/core/n-strings.c b/src/core/n-strings.c
@@ -129,11 +129,20 @@ static struct digest {
 ***********************************************************************/
 {
 	REBSER *str;
+	REBCNT type = VAL_TYPE(VAL_BLK_DATA(D_ARG(1)));
+	REBVAL *delimiter = D_REF(2) ? D_ARG(3) : NULL;
 
-	str = Form_Reduce(VAL_SERIES(D_ARG(1)), VAL_INDEX(D_ARG(1)));
+	str = Form_Reduce(VAL_SERIES(D_ARG(1)), VAL_INDEX(D_ARG(1)), delimiter, D_REF(4));
 	if (!str) return R_TOS;
 
-	Set_String(DS_RETURN, str); // not D_RET (stack modified)
+	// Use result string-like type based on first value, except tag!
+	if (type < REB_STRING || type >= REB_TAG) type = REB_STRING;
+
+	//  Using DS_RETURN not D_RET (stack modified)
+	VAL_SET(DS_RETURN, type);
+	VAL_SERIES(DS_RETURN) = str;
+	VAL_INDEX(DS_RETURN) = 0;
+	VAL_SERIES_SIDE(DS_RETURN) = 0;
 
 	return R_RET;
 }

diff --git a/src/core/s-mold.c b/src/core/s-mold.c
@@ -1462,7 +1462,7 @@ STOID Mold_Error(REBVAL *value, REB_MOLD *mold, REBFLG molded)
 
 /***********************************************************************
 **
-*/	REBSER *Form_Reduce(REBSER *block, REBCNT index)
+*/	REBSER *Form_Reduce(REBSER *block, REBCNT index, REBVAL *delimiter, REBOOL all)
 /*
 **		Reduce a block and then form each value into a string. Return the
 **		string or NULL if an unwind triggered while reducing.
@@ -1472,13 +1472,31 @@ STOID Mold_Error(REBVAL *value, REB_MOLD *mold, REBFLG molded)
 	REBINT start = DSP + 1;
 	REBINT n;
 	REB_MOLD mo = {0};
-
-	while (index < BLK_LEN(block)) {
-		index = Do_Next(block, index, 0);
-		if (THROWN(DS_TOP)) {
-			*DS_VALUE(start) = *DS_TOP;
-			DSP = start;
-			return NULL;
+	if (delimiter) {
+		while (index < BLK_LEN(block)) {
+			index = Do_Next(block, index, 0);
+			if (VAL_TYPE(DS_TOP) <= REB_NONE && !all) {
+				DS_DROP;
+				continue;
+			}
+			if (THROWN(DS_TOP)) {
+				*DS_VALUE(start) = *DS_TOP;
+				DSP = start;
+				return NULL;
+			}
+			DS_PUSH(delimiter);
+		}
+		if (DSP >= start) DS_DROP;
+	}
+	else {
+		while (index < BLK_LEN(block)) {
+			index = Do_Next(block, index, 0);
+			if (VAL_TYPE(DS_TOP) <= REB_NONE && !all) DS_DROP;
+			else if (THROWN(DS_TOP)) {
+				*DS_VALUE(start) = *DS_TOP;
+				DSP = start;
+				return NULL;
+			}
 		}
 	}
 

diff --git a/src/tests/units/series-test.r3 b/src/tests/units/series-test.r3
@@ -8,6 +8,90 @@ Rebol [
 
 ~~~start-file~~~ "Series"
 
+===start-group=== "Merging series"
+--test-- "JOIN"
+	--assert "ab"     == join  'a  'b
+	--assert "ab"     == join  "a" "b"
+	--assert %ab      == join  %a  "b"
+	--assert "ab"     == join #"a" "b"
+	--assert <ab>     == join  <a> "b"
+	--assert "ab3"    == join  'a  ['b  3]
+	--assert "ab3"    == join  "a" ["b" 3]
+	--assert %ab3     == join  %a  ["b" 3]
+	--assert "ab3"    == join #"a" ["b" 3]
+	--assert <ab3>    == join  <a> ["b" 3]
+	--assert "anone"  == join  "a" none
+	--assert %anone   == join  %a  none
+	--assert "anone"  == join #"a" none
+	--assert error? try [join  "a" #[unset]]
+	--assert error? try [join  %a  #[unset]]
+	--assert error? try [join #"a" #[unset]]
+
+;@@ https://github.com/Oldes/Rebol-issues/issues/2558
+--test-- "AJOIN"
+	--assert "ab3"    == ajoin [ 'a  'b  3]
+	--assert "ab3"    == ajoin [ "a" "b" 3]
+	--assert %ab3     == ajoin [ %a  "b" 3]
+	--assert "ab3"    == ajoin [#"a" "b" 3]
+	--assert "<a>b3"  == ajoin [ <a> "b" 3] ;; by design not a tag!
+	--assert "a3"     == ajoin [ "a" #[none]  3]
+	--assert %a3      == ajoin [ %a  #[none]  3]
+	--assert "a3"     == ajoin [#"a" #[none]  3]
+	--assert "a3"     == ajoin [ "a" #[unset] 3]
+	--assert %a3      == ajoin [ %a  #[unset] 3]
+	--assert "a3"     == ajoin [#"a" #[unset] 3]
+	;; when first value is not a string, result is always string
+	--assert "a3"     == ajoin [#[none]  "a"  3]
+	--assert "a3"     == ajoin [#[none]  %a   3]
+	--assert "a3"     == ajoin [#[none] #"a"  3]
+	;; nested ajoin
+	--assert "1234"   == ajoin [1 2 ajoin [3 4]]
+
+--test-- "AJOIN/all"
+	--assert "ab3"     == ajoin/all [ 'a  'b   3]
+	--assert "ab3"     == ajoin/all [ "a" "b"  3]
+	--assert %ab3      == ajoin/all [ %a  "b"  3]
+	--assert "ab3"     == ajoin/all [#"a" "b"  3]
+	--assert "anone3"  == ajoin/all [ "a" #[none]  3]
+	--assert %anone3   == ajoin/all [ %a  #[none]  3]
+	--assert "anone3"  == ajoin/all [#"a" #[none]  3]
+	--assert "a3"      == ajoin/all [ "a" #[unset] 3]
+	--assert %a3       == ajoin/all [ %a  #[unset] 3]
+	--assert "a3"      == ajoin/all [#"a" #[unset] 3]
+	;; when first value is not a string, result is always string
+	--assert "nonea3"  == ajoin/all [#[none]  "a"  3]
+	--assert "nonea3"  == ajoin/all [#[none]  %a   3]
+	--assert "nonea3"  == ajoin/all [#[none] #"a"  3]
+
+--test-- "AJOIN/with"
+	--assert "a/b/3"   == ajoin/with [ 'a  'b       3] #"/"
+	--assert "a/b/3"   == ajoin/with [ "a" "b"      3] #"/"
+	--assert %a/b/3    == ajoin/with [ %a  "b"      3] #"/"
+	--assert "a/b/3"   == ajoin/with [#"a" "b"      3] #"/"
+	--assert "<a>/b/3" == ajoin/with [ <a> "b"      3] #"/" ;; by design not a tag!
+	--assert "a/3"     == ajoin/with [ "a" #[none]  3] #"/"
+	--assert %a/3      == ajoin/with [ %a  #[none]  3] #"/"
+	--assert "a/3"     == ajoin/with [#"a" #[none]  3] #"/"
+	--assert "a/3"     == ajoin/with [ "a" #[unset] 3] #"/"
+	--assert %a/3      == ajoin/with [ %a  #[unset] 3] #"/"
+	--assert "a/3"     == ajoin/with [#"a" #[unset] 3] #"/"
+
+--test-- "AJOIN/all/with"
+	--assert "a/b/3"    == ajoin/all/with [ 'a  'b       3] #"/"
+	--assert "a/b/3"    == ajoin/all/with [ "a" "b"      3] #"/"
+	--assert %a/b/3     == ajoin/all/with [ %a  "b"      3] #"/"
+	--assert "a/b/3"    == ajoin/all/with [#"a" "b"      3] #"/"
+	--assert "a/none/3" == ajoin/all/with [ "a" #[none]  3] #"/"
+	--assert %a/none/3  == ajoin/all/with [ %a  #[none]  3] #"/"
+	--assert "a/none/3" == ajoin/all/with [#"a" #[none]  3] #"/"
+	--assert "a//3"     == ajoin/all/with [ "a" #[unset] 3] #"/"
+	--assert %a//3      == ajoin/all/with [ %a  #[unset] 3] #"/"
+	--assert "a//3"     == ajoin/all/with [#"a" #[unset] 3] #"/"
+
+===end-group===
+
+
+
 ===start-group=== "FIND & SELECT"
 
 --test-- "SELECT or FIND NONE! anything == none - #473"