FIX: issue red#4432 ([CRASH] involving Parse, Reduce & GC)

Those fixes are from PR red#4097.
qtxie · May 11, 2020 · d809d08 · d809d08
1 parent 9b50a8a
commit d809d08
Showing 1 changed file with 20 additions and 7 deletions.
diff --git a/runtime/datatypes/string.reds b/runtime/datatypes/string.reds
@@ -926,6 +926,7 @@ string: context [
 			h1	  [integer!]
 			h2	  [integer!]
 			diff? [logic!]
+			same? [logic!]
 	][
 		s1: GET_BUFFER(str1)
 		s2: GET_BUFFER(str2)
@@ -972,13 +973,17 @@ string: context [
 		if size <= 0 [exit]
 
 		size1: (as-integer s1/tail - s1/offset) + size
-		if s1/size < size1 [s1: expand-series s1 size1 * 2]
+		if s1/size < size1 [
+			same?: s1 = s2
+			s1: expand-series s1 size1 * 2
+			if same? [s2: s1]
+		]
 
 		if mode = MODE_INSERT [
 			move-memory									;-- make space
 				(as byte-ptr! s1/offset) + h1 + offset + size
 				(as byte-ptr! s1/offset) + h1 + offset
-				(as-integer s1/tail - s1/offset) - h1
+				(as-integer s1/tail - s1/offset) - h1 - offset
 		]
 
 		tail: as byte-ptr! s1/tail
@@ -988,6 +993,7 @@ string: context [
 			(as byte-ptr! s1/offset) + (offset << (log-b unit1)) + h1
 		]
 		either all [keep? diff?][
+			assert s1 <> s1
 			p2: (as byte-ptr! s2/offset) + h2
 			limit: p2 + (size2 << (log-b unit2))
 			while [p2 < limit][
@@ -1005,7 +1011,11 @@ string: context [
 				p2: p2 + unit2
 			]
 		][
-			copy-memory	p (as byte-ptr! s2/offset) + h2 size
+			either s1 = s2 [
+				move-memory p (as byte-ptr! s2/offset) + h2 size
+			][
+				copy-memory p (as byte-ptr! s2/offset) + h2 size
+			]
 			p: p + size
 		]
 		if mode = MODE_INSERT [p: tail + size] 
@@ -2727,12 +2737,12 @@ string: context [
 		/local
 			s			[series!]
 			added		[integer!]
+			len			[integer!]
 			type		[integer!]
 			char		[red-char!]
 			form-buf	[red-string!]
 			form-slot	[red-value!]
 	][
-		s: GET_BUFFER(str)
 		form-slot: stack/push*				;-- reserve space for FORMing incompatible values
 		form-slot/header: TYPE_UNSET
 		added: 0
@@ -2741,10 +2751,11 @@ string: context [
 			type: TYPE_OF(cell)
 			either type = TYPE_CHAR [
 				char: as red-char! cell
+				s: GET_BUFFER(str)
 				either part? [				;-- /part will insert extra elements
-					s: insert-char s str/head + added char/value
+					insert-char s str/head + added char/value
 				][
-					s: overwrite-char s str/head + added char/value
+					overwrite-char s str/head + added char/value
 				]
 				added: added + 1
 			][
@@ -2761,12 +2772,13 @@ string: context [
 					form-buf: rs-make-at form-slot 16
 					actions/form cell form-buf null 0
 				]
+				len: rs-length? form-buf			;-- form-buf can be changed by overwrite/concatenate
 				either part? [
 					concatenate str form-buf -1 added yes yes
 				][
 					overwrite str form-buf -1 added yes
 				]
-				added: added + rs-length? form-buf
+				added: added + len
 			]
 			cell: cell + 1
 		]
@@ -2819,6 +2831,7 @@ string: context [
 		len: _series/get-length ser1 no
 		if op = OP_UNION [len: len + _series/get-length ser2 no]
 		new: as red-series! rs-make-at stack/push* len
+		if zero? len [return new]			;-- early exit if nothing to do
 		s2: GET_BUFFER(new)
 		n: 2