FEAT: PICKZ and POKEZ functions for 0-based indexing

resolves: Oldes/Rebol-issues#613
Oldes · Oct 6, 2021 · 7d3a040 · 7d3a040
1 parent c5c3b45
commit 7d3a040
Show file tree

Hide file tree

Showing 2 changed files with 149 additions and 11 deletions.
diff --git a/src/core/f-series.c b/src/core/f-series.c
@@ -338,3 +338,34 @@
 
 	return SERIES_TAIL(series);
 }
+
+/***********************************************************************
+**
+*/	REBNATIVE(pickz)
+/*
+//	pickz: native [
+//		{Returns the value at the specified position. (0-based wrapper over PICK action)}
+//		aggregate [series! bitset! tuple!]
+//		index [integer!] "Zero based"
+]
+***********************************************************************/
+{
+	if(VAL_INT64(D_ARG(2))>=0) VAL_INT64(D_ARG(2)) += 1;
+	Do_Act(D_RET, VAL_TYPE(D_ARG(1)), A_PICK);
+}
+
+/***********************************************************************
+**
+*/	REBNATIVE(pokez)
+/*
+//	pokez: native [
+//		{Replaces an element at a given position. (0-based wrapper over POKE action)}
+//		series [series! bitset! tuple!] "(modified)"
+//		index  [integer!]  "Zero based"
+//		value  [any-type!] "The new value (returned)"
+]
+***********************************************************************/
+{
+	if (VAL_INT64(D_ARG(2)) >= 0) VAL_INT64(D_ARG(2)) += 1;
+	Do_Act(D_RET, VAL_TYPE(D_ARG(1)), A_POKE);
+}
diff --git a/src/tests/units/series-test.r3 b/src/tests/units/series-test.r3
@@ -293,17 +293,6 @@ Rebol [
 		--assert #{6163} = replace #{616263} #{6263} #{63}
 ===end-group===
 
-===start-group=== "POKE"
-	--test-- "poke unset value"
-	;@@ https://github.com/Oldes/Rebol-issues/issues/1815
-		--assert all [
-			b: [1 2 3] 
-			not error? try [poke b 2 #[unset!]]
-			unset? pick b 2
-			unset? b/2
-		]
-===end-group===
-
 ===start-group=== "PATH"
 	--test-- "get on path"
 	;@@ https://github.com/Oldes/Rebol-issues/issues/248
@@ -680,6 +669,124 @@ Rebol [
 
 ===end-group===
 
+===start-group=== "PICKZ"
+	;@@ https://github.com/Oldes/Rebol-issues/issues/613
+	--test-- "PICKZ of block!"
+	b: [1 2 3]
+	--assert all [
+		none? pickz b -1
+		1   = pickz b 0
+		2   = pickz b 1
+		3   = pickz b 2
+		none? pickz b 3
+	]
+	b: skip b 2
+	--assert all [
+		none? pickz b -3
+		1   = pickz b -2
+		2   = pickz b -1
+		3   = pickz b 0
+		none? pickz b 1
+		none? pickz b 2
+	]
+	--assert all [
+		none? pickz tail b 0
+		3   = pickz tail b -1
+	]
+
+	--test-- "PICKZ of string!"
+	s: "123"
+	--assert all [
+		none? pickz s -1
+		#"1"= pickz s 0
+		#"2"= pickz s 1
+		#"3"= pickz s 2
+		none? pickz s 3
+	]
+	s: skip s 2
+	--assert all [
+		#"1"= pickz s -2
+		#"2"= pickz s -1
+		#"3"= pickz s 0
+		none? pickz s 1
+		none? pickz s 2	
+	]
+	--assert all [
+		none? pickz tail s 0
+		#"3"= pickz tail s -1
+	]
+
+===end-group===
+
+===start-group=== "POKE"
+	--test-- "poke into block"
+		b: [1 2 3]
+		--assert all [
+			error? try [poke b 0 0]
+			0 =         poke b 1 0
+			error? try [poke b 4 0]
+			b = [0 2 3]
+		]
+	--test-- "poke into string"
+		s: "abc"
+		--assert all [
+			error? try [poke s -1 #"x"]
+			error? try [poke s  0 #"x"]
+			#"x" =      poke s  1 #"x"
+			error? try [poke s  4 #"x"]
+			s = "xbc"
+		]
+	--test-- "poke into binary"
+		s: to binary! "abc"
+		--assert all [
+			error? try [poke s -1 #"x"]
+			error? try [poke s  0 #"x"]
+			#"x" =      poke s  1 #"x"
+			error? try [poke s  4 #"x"]
+			"xbc" = to string! s
+		]
+	--test-- "poke unset value"
+	;@@ https://github.com/Oldes/Rebol-issues/issues/1815
+		--assert all [
+			b: [1 2 3] 
+			not error? try [poke b 2 #[unset!]]
+			unset? pick b 2
+			unset? b/2
+		]
+===end-group===
+
+===start-group=== "POKEZ"
+	;@@ https://github.com/Oldes/Rebol-issues/issues/613
+	--test-- "pokez into block"
+		b: [1 2 3]
+		--assert all [
+			error? try [pokez b -1 0]
+			0 =         pokez b  0 0
+			0 =         pokez b  1 0
+			error? try [pokez b  4 0]
+			b = [0 0 3]
+		]
+	--test-- "pokez into string"
+		s: "abc"
+		--assert all [
+			error? try [pokez s -1 #"x"]
+			#"x" =      pokez s  0 #"x"
+			#"x" =      pokez s  1 #"x"
+			error? try [pokez s  4 #"x"]
+			s = "xxc"
+		]
+	--test-- "pokez into binary"
+		s: to binary! "abc"
+		--assert all [
+			error? try [pokez s -1 #"x"]
+			#"x" =      pokez s  0 #"x"
+			#"x" =      pokez s  1 #"x"
+			error? try [pokez s  4 #"x"]
+			"xxc" = to string! s
+		]
+
+===end-group===
+
 
 ===start-group=== "PUT"
 	--test-- "PUT into BLOCK"