TESTS: completed set of basic vector tests

Red [
	Title:   "Red series test script"
	Author:  "Peter W A Wood"
	File: 	 %vector-test.red
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2015 Peter W A Wood. All rights reserved."
	License: "BSD-3 - https://github.com/red/red/blob/origin/BSD-3-License.txt"
]

#include  %../../../quick-test/quick-test.red

~~~start-file~~~ "vector"

===start-group=== "make"

	vector-make-test: func [
		name [string!]
		type [datatype!]
		spec [block!]
		len [integer!]
		test-value [char! float! integer!]
		/local
			vm-v
	][
		--test-- name
		vm-v: make vector! spec
		--assert len = length? vm-v
		foreach v vm-v [
			test-value: test-value + 1
			--assert test-value = v
			--assert type = type? v
		]
		--assert none = vm-v/0
		--assert none = vm-v/(len + 1)
	]

	--test-- "vector-make-1"
		vm1-v: make vector! 10
		--assert 10 = length? vm1-v
		foreach v vm1-v [
			--assert v = 0
			--assert integer! = type? v
		]
		--assert none = vm1-v/0
		--assert none = vm1-v/11

	vector-make-test "vector-make-2" integer! [1 2 3 4 5] 5 0

	vector-make-test "vector-make-3" char! [#"b" #"c" #"d" #"e"] 4 #"a"

	vector-make-test "vector-make-4" float! [1.0 2.0 3.0 4.0 5.0] 5 0.0

	vector-make-test "vector-make-5" integer! [integer! 8 [1 2 3 4 5]] 5 0

	vector-make-test "vector-make-6" integer! [integer! 16 [1 2 3 4 5]] 5 0

	vector-make-test "vector-make-7" integer! [integer! 32 [1 2 3 4 5]] 5 0

	vector-make-test "vector-make-8" float! [float! 64 [1.0 2.0 3.0 4.0 5.0]] 5 0.0

	vector-make-test "vector-make-9" float! [float! 32 [1.0 2.0 3.0 4.0 5.0]] 5 0.0

===end-group===

===start-group=== "vector-truncate"

	--test-- "vector-trunc-1"
		vt1-v: make vector! [char! 8 [#"^(00)" #"^(01)" #"^(02)"]]
		append vt1-v #"^(0100)"
		--assert 4 = length? vt1-v
		--assert #"^(00)" = vt1-v/4
		--assert none = vt1-v/5

	--test-- "vector-trunc-2"
		vt2-v: make vector! [char! 16 [#"^(00)" #"^(01)" #"^(02)"]]
		append vt2-v #"^(100100)"
		--assert 4 = length? vt2-v
		--assert #"^(0100)" = vt2-v/4
		--assert none = vt2-v/5

	--test-- "vector-trunc-3"
		vt3-v: make vector! [integer! 8 [0 1 2]]
		append vt3-v 256
		--assert 4 = length? vt3-v
		--assert 0 = vt3-v/4
		--assert none = vt3-v/5

	--test-- "vector-trunc-4"
		vt4-v: make vector! [integer! 16 [0 1 2]]
		append vt4-v 65536
		--assert 4 = length? vt4-v
		--assert 0 = vt4-v/4
		--assert none = vt4-v/5

	--test-- "vector-trunc-6"
		vt5-v: make vector! [float! 32 [0.0 1.0 2.0]]
		append vt5-v 1.23456789012345678901234567
		--assert 1.2345679 = round/to vt5-v/4 0.0000001

===end-group===

===start-group=== "vector path notation"

	--test-- "vector-path-1"
		vp1-v: [0 1 2 3 4]
		--assert none = vp1-v/0
		--assert 0 = vp1-v/1
		--assert 1 = vp1-v/2
		--assert 2 = vp1-v/3
		--assert 3 = vp1-v/4
		--assert 4 = vp1-v/5
		--assert none = vp1-v/6
		--assert none = vp1-v/-1

===end-group===

===start-group=== "vector navigation"

	--test-- "vector-navigation-1"
		vn-v: make vector! [0 1 2 3 4]
		vn-v: next vn-v
		--assert vn-v/1 = 1
		--assert vn-v/4 = 4

	--test-- "vector-navigation-2"
		vn-v: make vector! [0 1 2 3 4]
		vn-v: next next vn-v
		--assert vn-v/1 = 2
		--assert vn-v/3 = 4

	--test-- "vector-navigation-3"
		vn-v: make vector! [0 1 2 3 4]
		vn-v: next next next vn-v
		--assert vn-v/1 = 3
		--assert vn-v/2 = 4

	--test-- "vector-navigation-4"
		vn-v: make vector! [0 1 2 3 4]
		vn-v: next next next next vn-v
		--assert vn-v/1 = 4

	--test-- "vector-navigation-5"
		vn-v: make vector! [0 1 2 3 4]
		vn-v: tail vn-v
		--assert vn-v/1 = none

	--test-- "vector-navigation-6"
		vn-v: make vector! [0 1 2 3 4]
		vn-v: back tail vn-v
		--assert vn-v/1 = 4

	--test-- "vector-navigation-7"
		vn-v: make vector! [0 1 2 3 4]
		vn-v: head tail vn-v
		--assert vn-v/1 = 0
		--assert vn-v/5 = 4

===end-group===

===start-group=== "vector comparison"

	--test-- "vector-comparison-1"
		--assert (make vector! [1 2 3 4]) = make vector! [1 2 3 4]

	--test-- "vector-comparison-2"
		--assert (make vector! [1 2 3 4]) <> make vector! [1 2 3 3]

	--test-- "vector-comparison-3"
		--assert (make vector! [1 2 3 4]) > make vector! [1 2 3 3]

	--test-- "vector-comparison-4"
		--assert (make vector! [1 2 3 3]) < make vector! [1 2 3 4]

	--test-- "vector-comparison-5"
		--assert (make vector! [1 2 3]) < make vector! [1 2 3 4]

	--test-- "vector-comparison-6"
		--assert equal? make vector! [1 2 3 4] make vector! [1 2 3 4]

	--test-- "vector-comparison-7"
		--assert not equal? make vector! [1 2 3 4]make vector! [1 2 3 3]

	--test-- "vector-comparison-8"
		--assert greater? make vector! [1 2 3 4] make vector! [1 2 3 3]

	--test-- "vector-comparison-9"
		--assert lesser? make vector! [1 2 3 3] make vector! [1 2 3 4]

	--test-- "vector-comparison-10"
		--assert lesser? make vector! [1 2 3] make vector! [1 2 3 4]

===end-group===

===start-group=== "vector ordinal"

	--test-- "vector-ordinal-1"
		--assert 1 = first make vector! [1 2 3 4]

	--test-- "vector-ordinal-2"
		--assert 2 = second make vector! [1 2 3 4]

	--test-- "vector-ordinal-3"
		--assert 3 = third make vector! [1 2 3 4]

	--test-- "vector-ordinal-4"
		--assert 4 = fourth make vector! [1 2 3 4]

	--test-- "vector-ordinal-5"
		--assert 5 = fifth make vector! [1 2 3 4 5]

	--test-- "vector-ordinal-6"
		--assert none = fifth make vector! [1 2 3 4]

	--test-- "vector-ordinal-7"
		--assert 4 = last make vector! [1 2 3 4]

	--test-- "vector-ordinal-8"
		--assert 2 = first next make vector! [1 2 3 4]

	--test-- "vector-ordinal-7"
		--assert 3 = second next make vector! [1 2 3 4]

===end-group===

===start-group=== "vector-clear"

		empty-vector: make vector! []

	--test-- "vector-clear-1"
		--assert empty-vector = clear make vector! [1 2 3 4]

	--test-- "vector-clear-2"
		vc2-v: make vector! [1 2 3 4]
		append vc2-v 5
		--assert empty-vector = clear vc2-v

===end-group===

===start-group=== "vector-copy"

	--test-- "vector-copy-1"
		vcp1-v1: make vector! [1 2 3 4]
		vcp1-v2: copy vcp1-v1
		vcp1-v1/1: 5
		vcp1-v1/2: 6
		vcp1-v1/3: 7
		vcp1-v1/4: 8
		--assert vcp1-v1 = make vector! [5 6 7 8]
		--assert vcp1-v2 = make vector! [1 2 3 4]

	--test-- "vector-copy-2"
		vcp2-v: make vector! [1 2 3 4 5 6 7 8 9]
			--assert (make vector! [1 2 3 4]) = copy/part vcp2-v 4

	--test-- "vector-copy-3"
		vcp3-v: make vector! [1 2 3 4 5 6 7 8 9]
			--assert (make vector! [3 4]) = copy/part next next vcp3-v 2

	--test-- "vector-copy-4"
		vcp4-v: make vector! [1 2 3 4 5 6 7 8 9]
			--assert (make vector! [8]) = copy/part back back tail vcp4-v 1

	--test-- "vector-copy-5"
		vcp5-v: make vector! [1 2]
			--assert (make vector! [1 2]) = copy/part vcp5-v 4

===end-group===

===start-group=== "vector poke"

	--test-- "vector-poke-1"
		vp1-v: make vector! [1 2]
		poke vp1-v 1 0
		--assert (make vector! [0 2]) = vp1-v

	--test-- "vector-poke-2"
		vp2-v: make vector! [1 2 3]
		poke vp2-v 3 0
		--assert (make vector! [1 2 0]) = vp2-v

	--test-- "vector-poke-3"
		vp3-v: make vector! [1 2 3]
		poke vp3-v 2 0
		--assert (make vector! [1 0 3]) = vp3-v

===end-group===

===start-group=== "vector remove"

	--test-- "vector-remove-1"
		--assert (make vector! [2 3]) = remove make vector! [1 2 3]

	--test-- "vector-remove-2"
		--assert (make vector! [3]) = remove next make vector! [1 2 3]

	--test-- "vector-remove-3"
		--assert (make vector! []) = remove tail make vector! [1 2 3]

	--test-- "vector-remove-4"
		--assert (make vector! []) = remove back tail make vector! [1 2 3]

	--test-- "vector-remove-5"
		--assert (make vector! [3]) = remove back back tail make vector! [1 2 3]

===end-group===

===start-group=== "vector reverse"

	--test-- "vector-reverse-1"
		--assert (make vector! [4 3 2 1]) = reverse make vector! [1 2 3 4]

	--test-- "vector-reverse-2"
		--assert (make vector! [1 4 3 2 ]) = head reverse next make vector! [1 2 3 4]

	--test-- "vector-reverse-2"
		--assert (make vector! [1 2 3 4]) = head reverse tail make vector! [1 2 3 4]

===end-group===

===start-group=== "vector take"

	--test-- "vector-take-1"
		vt1-v: make vector! [1 2 3 4]
		--assert 1 = take vt1-v
		--assert vt1-v = make vector! [2 3 4]

	--test-- "vector-take-2"
		vt2-v: make vector! [1 2 3 4]
		--assert 2 = take next vt2-v
		--assert vt2-v = make vector! [1 3 4]

	--test-- "vector-take-3"
		vt3-v: make vector! [1 2 3 4]
		--assert 4 = take/last vt3-v
		--assert vt3-v = make vector! [1 2 3]

	--test-- "vector-take-4"
		vt4-v: make vector! [1 2 3 4]
		--assert (make vector! [1 2]) = take/part vt4-v 2
		--assert vt4-v = make vector! [3 4]

	--test-- "vector-take-5"
		vt5-v: make vector! [1 2 3 4]
		--assert (make vector! [1 2]) = take/part vt5-v find vt5-v 3
		--assert vt5-v = make vector! [3 4]

===end-group===

===start-group=== "vector sort"

	--test-- "vector-sort-1"
		--assert (make vector! [1 2 3]) = sort make vector! [3 2 1]

	--test-- "vector-sort-2"
		--assert (make vector! [3 1 2]) = head sort next make vector! [3 2 1]

	--test-- "vector-sort-3"
		--assert (make vector! [3 2 1]) = head sort tail make vector! [3 2 1]

	--test-- "vector-sort-4"
		--assert (make vector! [#"c" #"à" #"é"]) = sort make vector! [#"é" #"à" #"c"]

===end-group===

===start-group=== "vector find"

	--test-- "vector-find-1"
		--assert none = find make vector! [1 2 3 4] "five"

	--test-- "vector-find-2"
		--assert none = find next make vector! [1 2 3 4] 1

	--test-- "vector-find-3"
		--assert 1 = first find make vector! [1 2 3 4] 1

	--test-- "vector-find-4"
		--assert none = find make vector! [1 2 3 4] 1.0

	--test-- "vector-find-5"
		--assert 1 = length? find make vector! [1 2 3 4] 4

	--test-- "vector-find-6"
		--assert none = find/part make vector! [1 2 3 4] 4 3

	--test-- "vector-find-7"
		--assert 3 = first find/part make vector! [1 2 3 4] 3 3
		--assert 4 = second find/part make vector! [1 2 3 4] 3 3
		--assert 2 = length? find/part make vector! [1 2 3 4] 3 3

	--test-- "vector-find-8"
		--assert #"a" = first find/case make vector! [ #"A" #"a" #"b" #"c"] #"a"
		--assert 3 = length? find/case make vector! [ #"A" #"a" #"b" #"c"] #"a"

	--test-- "vector-find-9"
		--assert #"a" = first find make vector! [ #"A" #"a" #"b" #"c"] #"a"

	--test-- "vector-find-10"
		--assert (make vector! [4 5 6]) = find/skip make vector! [1 4 4 4 5 6] 4 3

	--test-- "vector-find-11"
		--assert (make vector! [1]) = find/last make vector! [1 1 1 1 1] 1

	--test-- "vector-find-12"
		vf12-v: next next next make vector! [1 2 1 2 1 2]
		--assert (make vector! [2 1 2 1 2]) = find/reverse vf12-v 2

	--test-- "vector-find-13"
		--assert (make vector! [5 6]) = find/tail make vector! [1 2 3 4 5 6] 4

	--test-- "vector-find-14"
		--assert (make vector! [3 4]) = find/match next make vector! [1 2 3 4] 2

===end-group===

===start-group=== "vector select"

	--test-- "vector-select-1"
		--assert none = select make vector! [1 2 3 4] "five"

	--test-- "vector-select-2"
		--assert none = select next make vector! [1 2 3 4] 1

	--test-- "vector-select-3"
		--assert 2 = select make vector! [1 2 3 4] 1

	--test-- "vector-select-4"
		--assert none = select make vector! [1 2 3 4] 1.0

	--test-- "vector-select-5"
		--assert 4 = select make vector! [1 2 3 4] 3

	--test-- "vector-select-6"
		--assert none = select/part make vector! [1 2 3 4] 4 3

	--test-- "vector-select-7"
		--assert 4 = select/part make vector! [1 2 3 4] 3 3

	--test-- "vector-select-8"
		--assert #"b" = select/case make vector! [ #"A" #"a" #"b" #"c"] #"a"

	--test-- "vector-select-9"
		--assert #"b" = select make vector! [ #"A" #"a" #"b" #"c"] #"a"

	--test-- "vector-select-10"
		--assert 5 = select/skip make vector! [1 4 4 4 5 6] 4 3

	--test-- "vector-select-11"
		--assert 1 = select/last make vector! [1 2 3 4 1] 4

	--test-- "vector-select-12"
		vs12-v: next next next next make vector! [1 2 1 2 3 4]
		--assert 3 = select/reverse vs12-v 2

===end-group===

===start-group=== "vector add"

		va-v1: make vector! [10 20 30 40 50]
		va-v2: make vector! [2 3 4 5 6]

	--test-- "vector-add-1"
		va1-v: va-v1 + va-v2
		--assert va1-v = make vector! [12 23 34 45 56]

	--test-- "vector-add-2"
		va2-v: add va-v1 va-v2
		--assert va2-v = make vector! [12 23 34 45 56]

	--test-- "vector-add-3"
		va3-v: add next va-v1 va-v2
		--assert va3-v = make vector! [22 33 44 55]

	--test-- "vector-add-4"
		va4-v: add va-v1 next next va-v2
		--assert va4-v = make vector! [14 25 36]

	--test-- "vector-add-5"
		va-v1: make vector! [1.0 2.0 3.0 4.0 5.0]
		va5-v: va-v1 + va-v1
		--assert va5-v = make vector! [2.0 4.0 6.0 8.0 10.0]

	--test-- "vector-add-6"
		va6-v: va-v1 + 0.5
		--assert va6-v = make vector! [1.5 2.5 3.5 4.5 5.5]

	--test-- "vector-add-7"
		va-v1: make vector! [10 20 30 40 50]
		va7-v: va-v1 + -1
		--assert va7-v = make vector! [9 19 29 39 49]

	--test-- "vector-add-8"
		va-v1: make vector! [10 20 30 40 50]
		va8-v: va-v1 + 1.5
		--assert va8-v = make vector! [11 21 31 41 51]

	--test-- "vector-add-9"
		va-v1: make vector! [10 20 30 40 50]
		va9-v: va-v1 + 0.5
		--assert va9-v = make vector! [10 20 30 40 50]

	--test-- "vector-add-10"
		va10-v1: make vector! [integer! 8 [253 254 255]]
		va10-v2: make vector! [integer! 8 [3 2 1]]
		va10-v3: va10-v1 + va10-v2
		--assert va10-v3 = make vector! [integer! 8 [0 0 0]]

===end-group===

===start-group=== "vector subtract"

		vs-v1: make vector! [10 20 30 40 50]
		vs-v2: make vector! [2 3 4 5 6]

	--test-- "vector-subtract-1"
		vs1-v: vs-v1 - vs-v2
		--assert vs1-v = make vector! [8 17 26 35 44]

	--test-- "vector-subtract-2"
		vs2-v: subtract vs-v1 vs-v2
		--assert vs2-v = make vector! [8 17 26 35 44]

	--test-- "vector-subtract-3"
		vs3-v: subtract next vs-v1 vs-v2
		--assert vs3-v = make vector! [18 27 36 45]

	--test-- "vector-subtract-4"
		vs4-v: subtract vs-v1 next next vs-v2
		--assert vs4-v = make vector! [6 15 24]

	--test-- "vector-subtract-5"
		vs-v1: make vector! [1.0 2.0 3.0 4.0 5.0]
		vs5-v: vs-v1 - vs-v1
		--assert vs5-v = make vector! [0.0 0.0 0.0 0.0 0.0]

	--test-- "vector-subtract-6"
		vs6-v: vs-v1 - 0.5
		--assert vs6-v = make vector! [0.5 1.5 2.5 3.5 4.5]

	--test-- "vector-subtract-7"
		vs-v1: make vector! [10 20 30 40 50]
		vs7-v: vs-v1 - -1
		--assert vs7-v = make vector! [11 21 31 41 51]

	--test-- "vector-subtract-8"
		vs-v1: make vector! [10 20 30 40 50]
		vs8-v: vs-v1 - 1.5
		--assert vs8-v = make vector! [9 19 29 39 49]

	--test-- "vector-subtract-9"
		vs-v1: make vector! [10 20 30 40 50]
		vs9-v: vs-v1 - 0.5
		--assert vs9-v = make vector! [10 20 30 40 50]

===end-group===

===start-group=== "vector multiply"

		vm-v1: make vector! [10 20 30 40 50]
		vm-v2: make vector! [2 3 4 5 6]

	--test-- "vector-multiply-1"
		vm1-v: vm-v1 * vm-v2
		--assert vm1-v = make vector! [20 60 120 200 300]

	--test-- "vector-multiply-2"
		vm2-v: multiply vm-v1 vm-v2
		--assert vm2-v = make vector! [20 60 120 200 300]

	--test-- "vector-multiply-3"
		vm3-v: multiply next vm-v1 vm-v2
		--assert vm3-v = make vector! [40 90 160 250]

	--test-- "vector-multiply-4"
		vm4-v: multiply vm-v1 next next vm-v2
		--assert vm4-v = make vector! [40 100 180]

	--test-- "vector-multiply-5"
		vm-v1: make vector! [1.0 2.0 3.0 4.0 5.0]
		vm5-v: vm-v1 * vm-v1
		--assert vm5-v = make vector! [1.0 4.0 9.0 16.0 25.0]

	--test-- "vector-multiply-6"
		vm6-v: vm-v1 * 0.5
		--assert vm6-v = make vector! [0.5 1.0 1.5 2.0 2.5]

	--test-- "vector-multiply-7"
		vm-v1: make vector! [10 20 30 40 50]
		vm7-v: vm-v1 * -1
		--assert vm7-v = make vector! [-10 -20 -30 -40 -50]

	--test-- "vector-multiply-8"
		vm-v1: make vector! [10 20 30 40 50]
		vm8-v: vm-v1 * 1.5
		--assert vm8-v = make vector! [10 20 30 40 50]

	--test-- "vector-multiply-9"
		vm-v1: make vector! [10 20 30 40 50]
		vm9-v: vm-v1 * 0.5
		--assert vm9-v = make vector! [0 0 0 0 0]

	--test-- "vector-multiply-10"
		vm10-v1: make vector! [integer! 8 [253 254 255]]
		vm10-v2: make vector! [integer! 8 [3 2 1]]
		vm10-v3: vm10-v1 * vm10-v2
		--assert vm10-v3 = make vector! [integer! 8 [247 252 255]]

===end-group===

===start-group=== "vector divide"

		vm-v1: make vector! [10 20 30 40 50]
		vm-v2: make vector! [2 3 4 5 6]

	--test-- "vector-divide-1"
		vm1-v: vm-v1 / vm-v2
		--assert vm1-v = make vector! [5 6 7 8 8]

	--test-- "vector-divide-2"
		vm2-v: divide vm-v1 vm-v2
		--assert vm2-v = make vector! [5 6 7 8 8]

	--test-- "vector-divide-3"
		vm3-v: divide next vm-v1 vm-v2
		--assert vm3-v = make vector! [10 10 10 10]

	--test-- "vector-divide-4"
		vm4-v: divide vm-v1 next next vm-v2
		--assert vm4-v = make vector! [2 5 5]

	--test-- "vector-divide-5"
		vm-v1: make vector! [1.0 2.0 3.0 4.0 5.0]
		vm5-v: vm-v1 / vm-v1
		--assert vm5-v = make vector! [1.0 1.0 1.0 1.0 1.0]

	--test-- "vector-divide-6"
		vm6-v: vm-v1 / 0.5
		--assert vm6-v = make vector! [2.0 4.0 6.0 8.0 10.0]

	--test-- "vector-divide-7"
		vm-v1: make vector! [10 20 30 40 50]
		vm7-v: vm-v1 / -1
		--assert vm7-v = make vector! [-10 -20 -30 -40 -50]

	--test-- "vector-divide-8"
		vm-v1: make vector! [10 20 30 40 50]
		vm8-v: vm-v1 / 1.5
		--assert vm8-v = make vector! [10 20 30 40 50]

	--test-- "vector-divide-9"
		vm-v1: make vector! [1.0 2.0 3.0 4.0 5.0]
		vm9-v: vm-v1 / 5.0
		--assert vm9-v = make vector! [0.2 0.4 0.6 0.8 1.0]

===end-group===

===start-group=== "vector remainder"

		vm-v1: make vector! [10 20 30 40 50]
		vm-v2: make vector! [2 3 4 5 6]

	--test-- "vector-remainder-1"
		vm1-v: vm-v1 % vm-v2
		--assert vm1-v = make vector! [0 2 2 0 2]

	--test-- "vector-remainder-2"
		vm2-v: remainder vm-v1 vm-v2
		--assert vm2-v = make vector! [0 2 2 0 2]

	--test-- "vector-remainder-3"
		vm3-v: remainder next vm-v1 vm-v2
		--assert vm3-v = make vector! [0 0 0 0]

	--test-- "vector-remainder-4"
		vm4-v: remainder vm-v1 next next vm-v2
		--assert vm4-v = make vector! [2 0 0]

	--test-- "vector-remainder-5"
		vm-v1: make vector! [1.0 2.0 3.0 4.0 5.0]
		vm5-v: vm-v1 % vm-v1
		--assert vm5-v = make vector! [0.0 0.0 0.0 0.0 0.0]

	--test-- "vector-remainder-6"
		vm6-v: vm-v1 % 0.5
		--assert vm6-v = make vector! [0.0 0.0 0.0 0.0 0.0]

	--test-- "vector-remainder-7"
		vm-v1: make vector! [10 20 30 40 50]
		vm7-v: vm-v1 % -1
		--assert vm7-v = make vector! [0 0 0 0 0]

	--test-- "vector-remainder-8"
		vm-v1: make vector! [10 20 30 40 50]
		vm8-v: vm-v1 % 1.5
		--assert vm8-v = make vector! [0 0 0 0 0]

	--test-- "vector-remainder-9"
		vm-v1: make vector! [1.0 2.0 3.0 4.0 5.0]
		vm9-v: vm-v1 % 5.0
		--assert vm9-v = make vector! [1.0 2.0 3.0 4.0 0.0]

===end-group===

===start-group=== "vector and"

		vand-v1: make vector! [10 20 30 40 50]
		vand-v2: make vector! [2 3 4 5 6]

	--test-- "vector-and-1"
		vand1-v: vand-v1 and vand-v2
		--assert vand1-v = make vector! [2 0 4 0 2]

	--test-- "vector-and-2"
		vand2-v: vand-v1 and next vand-v2
		--assert vand2-v = make vector! [2 4 4 0]

	--test-- "vector-and-3"
		vand3-v: (next vand-v1) and vand-v2
		--assert vand3-v = make vector! [0 2 0 0]

	--test-- "vector-and-4"
		vand4-v: vand-v1 and next next vand-v2
		--assert vand4-v = make vector! [0 4 6]

	--test-- "vector-and-5"
		vand-v1: make vector! [10 20 30 40 50]
		vand7-v: vand-v1 and -1
		--assert vand7-v = make vector! [10 20 30 40 50]

	--test-- "vector-and-6"
		vand-v1: make vector! [10 20 30 40 50]
		vand8-v: vand-v1 and 1.5
		--assert vand8-v = make vector! [0 0 0 0 0]

===end-group===

===start-group=== "vector or"

		vor-v1: make vector! [10 20 30 40 50]
		vor-v2: make vector! [2 3 4 5 6]

	--test-- "vector-or-1"
		vor1-v: vor-v1 or vor-v2
		--assert vor1-v = make vector! [10 23 30 45 54]

	--test-- "vector-or-2"
		vor2-v: vor-v1 or next vor-v2
		--assert vor2-v = make vector! [11 20 31 46]

	--test-- "vector-or-3"
		vor3-v: (next vor-v1) or vor-v2
		--assert vor3-v = make vector! [22 31 44 55]

	--test-- "vector-or-4"
		vor4-v: vor-v1 or next next vor-v2
		--assert vor4-v = make vector! [14 21 30]

	--test-- "vector-or-5"
		vor-v1: make vector! [10 20 30 40 50]
		vor7-v: vor-v1 or -1
		--assert vor7-v = make vector! [-1 -1 -1 -1 -1]

	--test-- "vector-or-6"
		vor-v1: make vector! [10 20 30 40 50]
		vor8-v: vor-v1 or 1.5
		--assert vor8-v = make vector! [11 21 31 41 51]

===end-group===

===start-group=== "vector xor"

		vxor-v1: make vector! [10 20 30 40 50]
		vxor-v2: make vector! [2 3 4 5 6]

	--test-- "vector-xor-1"
		vxor1-v: vxor-v1 xor vxor-v2
		--assert vxor1-v = make vector! [8 23 26 45 52]

	--test-- "vector-xor-2"
		vxor2-v: vxor-v1 xor next vxor-v2
		--assert vxor2-v = make vector! [9 16 27 46]

	--test-- "vector-xor-3"
		vxor3-v: (next vxor-v1) xor vxor-v2
		--assert vxor3-v = make vector! [22 29 44 55]

	--test-- "vector-xor-4"
		vxor4-v: vxor-v1 xor next next vxor-v2
		--assert vxor4-v = make vector! [14 17 24]

	--test-- "vector-xor-5"
		vxor-v1: make vector! [10 20 30 40 50]
		vxor7-v: vxor-v1 xor -1
		--assert vxor7-v = make vector! [-11 -21 -31 -41 -51]

	--test-- "vector-xor-6"
		vxor-v1: make vector! [10 20 30 40 50]
		vxor8-v: vxor-v1 xor 1.5
		--assert vxor8-v = make vector! [11 21 31 41 51]

===end-group===

~~~end-file~~~

Red [
	Title:   "Red series test script"
	Author:  "Peter W A Wood"
	File: 	 %vector-test.red
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2015 Peter W A Wood. All rights reserved."
	License: "BSD-3 - https://github.com/red/red/blob/origin/BSD-3-License.txt"
]

#include  %../../../quick-test/quick-test.red

~~~start-file~~~ "vector"

===start-group=== "make"

	vector-make-test: func [
		name [string!]
		type [datatype!]
		spec [block!]
		len [integer!]
		test-value [char! float! integer!]
		/local
			vm-v
	][
		--test-- name
		vm-v: make vector! spec
		--assert len = length? vm-v
		foreach v vm-v [
			test-value: test-value + 1
			--assert test-value = v
			--assert type = type? v
		]
		--assert none = vm-v/0
		--assert none = vm-v/(len + 1)
	]

	--test-- "vector-make-1"
		vm1-v: make vector! 10
		--assert 10 = length? vm1-v
		foreach v vm1-v [
			--assert v = 0
			--assert integer! = type? v
		]
		--assert none = vm1-v/0
		--assert none = vm1-v/11

	vector-make-test "vector-make-2" integer! [1 2 3 4 5] 5 0

	vector-make-test "vector-make-3" char! [#"b" #"c" #"d" #"e"] 4 #"a"

	vector-make-test "vector-make-4" float! [1.0 2.0 3.0 4.0 5.0] 5 0.0

	vector-make-test "vector-make-5" integer! [integer! 8 [1 2 3 4 5]] 5 0

	vector-make-test "vector-make-6" integer! [integer! 16 [1 2 3 4 5]] 5 0

	vector-make-test "vector-make-7" integer! [integer! 32 [1 2 3 4 5]] 5 0

	vector-make-test "vector-make-8" float! [float! 64 [1.0 2.0 3.0 4.0 5.0]] 5 0.0

	vector-make-test "vector-make-9" float! [float! 32 [1.0 2.0 3.0 4.0 5.0]] 5 0.0

===end-group===

===start-group=== "vector-truncate"

	--test-- "vector-trunc-1"
		vt1-v: make vector! [char! 8 [#"^(00)" #"^(01)" #"^(02)"]]
		append vt1-v #"^(0100)"
		--assert 4 = length? vt1-v
		--assert #"^(00)" = vt1-v/4
		--assert none = vt1-v/5

	--test-- "vector-trunc-2"
		vt2-v: make vector! [char! 16 [#"^(00)" #"^(01)" #"^(02)"]]
		append vt2-v #"^(100100)"
		--assert 4 = length? vt2-v
		--assert #"^(0100)" = vt2-v/4
		--assert none = vt2-v/5

	--test-- "vector-trunc-3"
		vt3-v: make vector! [integer! 8 [0 1 2]]
		append vt3-v 256
		--assert 4 = length? vt3-v
		--assert 0 = vt3-v/4
		--assert none = vt3-v/5

	--test-- "vector-trunc-4"
		vt4-v: make vector! [integer! 16 [0 1 2]]
		append vt4-v 65536
		--assert 4 = length? vt4-v
		--assert 0 = vt4-v/4
		--assert none = vt4-v/5

	--test-- "vector-trunc-6"
		vt5-v: make vector! [float! 32 [0.0 1.0 2.0]]
		append vt5-v 1.23456789012345678901234567
		--assert 1.2345679 = round/to vt5-v/4 0.0000001

===end-group===

===start-group=== "vector path notation"

	--test-- "vector-path-1"
		vp1-v: [0 1 2 3 4]
		--assert none = vp1-v/0
		--assert 0 = vp1-v/1
		--assert 1 = vp1-v/2
		--assert 2 = vp1-v/3
		--assert 3 = vp1-v/4
		--assert 4 = vp1-v/5
		--assert none = vp1-v/6
		--assert none = vp1-v/-1

===end-group===

===start-group=== "vector navigation"

	--test-- "vector-navigation-1"
		vn-v: make vector! [0 1 2 3 4]
		vn-v: next vn-v
		--assert vn-v/1 = 1
		--assert vn-v/4 = 4

	--test-- "vector-navigation-2"
		vn-v: make vector! [0 1 2 3 4]
		vn-v: next next vn-v
		--assert vn-v/1 = 2
		--assert vn-v/3 = 4

	--test-- "vector-navigation-3"
		vn-v: make vector! [0 1 2 3 4]
		vn-v: next next next vn-v
		--assert vn-v/1 = 3
		--assert vn-v/2 = 4

	--test-- "vector-navigation-4"
		vn-v: make vector! [0 1 2 3 4]
		vn-v: next next next next vn-v
		--assert vn-v/1 = 4

	--test-- "vector-navigation-5"
		vn-v: make vector! [0 1 2 3 4]
		vn-v: tail vn-v
		--assert vn-v/1 = none

	--test-- "vector-navigation-6"
		vn-v: make vector! [0 1 2 3 4]
		vn-v: back tail vn-v
		--assert vn-v/1 = 4

	--test-- "vector-navigation-7"
		vn-v: make vector! [0 1 2 3 4]
		vn-v: head tail vn-v
		--assert vn-v/1 = 0
		--assert vn-v/5 = 4

===end-group===

===start-group=== "vector comparison"

	--test-- "vector-comparison-1"
		--assert (make vector! [1 2 3 4]) = make vector! [1 2 3 4]

	--test-- "vector-comparison-2"
		--assert (make vector! [1 2 3 4]) <> make vector! [1 2 3 3]

	--test-- "vector-comparison-3"
		--assert (make vector! [1 2 3 4]) > make vector! [1 2 3 3]

	--test-- "vector-comparison-4"
		--assert (make vector! [1 2 3 3]) < make vector! [1 2 3 4]

	--test-- "vector-comparison-5"
		--assert (make vector! [1 2 3]) < make vector! [1 2 3 4]

	--test-- "vector-comparison-6"
		--assert equal? make vector! [1 2 3 4] make vector! [1 2 3 4]

	--test-- "vector-comparison-7"
		--assert not equal? make vector! [1 2 3 4]make vector! [1 2 3 3]

	--test-- "vector-comparison-8"
		--assert greater? make vector! [1 2 3 4] make vector! [1 2 3 3]

	--test-- "vector-comparison-9"
		--assert lesser? make vector! [1 2 3 3] make vector! [1 2 3 4]

	--test-- "vector-comparison-10"
		--assert lesser? make vector! [1 2 3] make vector! [1 2 3 4]

===end-group===

===start-group=== "vector ordinal"

	--test-- "vector-ordinal-1"
		--assert 1 = first make vector! [1 2 3 4]

	--test-- "vector-ordinal-2"
		--assert 2 = second make vector! [1 2 3 4]

	--test-- "vector-ordinal-3"
		--assert 3 = third make vector! [1 2 3 4]

	--test-- "vector-ordinal-4"
		--assert 4 = fourth make vector! [1 2 3 4]

	--test-- "vector-ordinal-5"
		--assert 5 = fifth make vector! [1 2 3 4 5]

	--test-- "vector-ordinal-6"
		--assert none = fifth make vector! [1 2 3 4]

	--test-- "vector-ordinal-7"
		--assert 4 = last make vector! [1 2 3 4]

	--test-- "vector-ordinal-8"
		--assert 2 = first next make vector! [1 2 3 4]

	--test-- "vector-ordinal-7"
		--assert 3 = second next make vector! [1 2 3 4]

===end-group===

===start-group=== "vector-clear"

		empty-vector: make vector! []

	--test-- "vector-clear-1"
		--assert empty-vector = clear make vector! [1 2 3 4]

	--test-- "vector-clear-2"
		vc2-v: make vector! [1 2 3 4]
		append vc2-v 5
		--assert empty-vector = clear vc2-v

===end-group===

===start-group=== "vector-copy"

	--test-- "vector-copy-1"
		vcp1-v1: make vector! [1 2 3 4]
		vcp1-v2: copy vcp1-v1
		vcp1-v1/1: 5
		vcp1-v1/2: 6
		vcp1-v1/3: 7
		vcp1-v1/4: 8
		--assert vcp1-v1 = make vector! [5 6 7 8]
		--assert vcp1-v2 = make vector! [1 2 3 4]

	--test-- "vector-copy-2"
		vcp2-v: make vector! [1 2 3 4 5 6 7 8 9]
			--assert (make vector! [1 2 3 4]) = copy/part vcp2-v 4

	--test-- "vector-copy-3"
		vcp3-v: make vector! [1 2 3 4 5 6 7 8 9]
			--assert (make vector! [3 4]) = copy/part next next vcp3-v 2

	--test-- "vector-copy-4"
		vcp4-v: make vector! [1 2 3 4 5 6 7 8 9]
			--assert (make vector! [8]) = copy/part back back tail vcp4-v 1

	--test-- "vector-copy-5"
		vcp5-v: make vector! [1 2]
			--assert (make vector! [1 2]) = copy/part vcp5-v 4

===end-group===

===start-group=== "vector poke"

	--test-- "vector-poke-1"
		vp1-v: make vector! [1 2]
		poke vp1-v 1 0
		--assert (make vector! [0 2]) = vp1-v

	--test-- "vector-poke-2"
		vp2-v: make vector! [1 2 3]
		poke vp2-v 3 0
		--assert (make vector! [1 2 0]) = vp2-v

	--test-- "vector-poke-3"
		vp3-v: make vector! [1 2 3]
		poke vp3-v 2 0
		--assert (make vector! [1 0 3]) = vp3-v

===end-group===

===start-group=== "vector remove"

	--test-- "vector-remove-1"
		--assert (make vector! [2 3]) = remove make vector! [1 2 3]

	--test-- "vector-remove-2"
		--assert (make vector! [3]) = remove next make vector! [1 2 3]

	--test-- "vector-remove-3"
		--assert (make vector! []) = remove tail make vector! [1 2 3]

	--test-- "vector-remove-4"
		--assert (make vector! []) = remove back tail make vector! [1 2 3]

	--test-- "vector-remove-5"
		--assert (make vector! [3]) = remove back back tail make vector! [1 2 3]

===end-group===

===start-group=== "vector reverse"

	--test-- "vector-reverse-1"
		--assert (make vector! [4 3 2 1]) = reverse make vector! [1 2 3 4]

	--test-- "vector-reverse-2"
		--assert (make vector! [1 4 3 2 ]) = head reverse next make vector! [1 2 3 4]

	--test-- "vector-reverse-2"
		--assert (make vector! [1 2 3 4]) = head reverse tail make vector! [1 2 3 4]

===end-group===

===start-group=== "vector take"

	--test-- "vector-take-1"
		vt1-v: make vector! [1 2 3 4]
		--assert 1 = take vt1-v
		--assert vt1-v = make vector! [2 3 4]

	--test-- "vector-take-2"
		vt2-v: make vector! [1 2 3 4]
		--assert 2 = take next vt2-v
		--assert vt2-v = make vector! [1 3 4]

	--test-- "vector-take-3"
		vt3-v: make vector! [1 2 3 4]
		--assert 4 = take/last vt3-v
		--assert vt3-v = make vector! [1 2 3]

	--test-- "vector-take-4"
		vt4-v: make vector! [1 2 3 4]
		--assert (make vector! [1 2]) = take/part vt4-v 2
		--assert vt4-v = make vector! [3 4]

	--test-- "vector-take-5"
		vt5-v: make vector! [1 2 3 4]
		--assert (make vector! [1 2]) = take/part vt5-v find vt5-v 3
		--assert vt5-v = make vector! [3 4]

===end-group===

===start-group=== "vector sort"

	--test-- "vector-sort-1"
		--assert (make vector! [1 2 3]) = sort make vector! [3 2 1]

	--test-- "vector-sort-2"
		--assert (make vector! [3 1 2]) = head sort next make vector! [3 2 1]

	--test-- "vector-sort-3"
		--assert (make vector! [3 2 1]) = head sort tail make vector! [3 2 1]

	--test-- "vector-sort-4"
		--assert (make vector! [#"c" #"à" #"é"]) = sort make vector! [#"é" #"à" #"c"]

===end-group===

===start-group=== "vector find"

	--test-- "vector-find-1"
		--assert none = find make vector! [1 2 3 4] "five"

	--test-- "vector-find-2"
		--assert none = find next make vector! [1 2 3 4] 1

	--test-- "vector-find-3"
		--assert 1 = first find make vector! [1 2 3 4] 1

	--test-- "vector-find-4"
		--assert none = find make vector! [1 2 3 4] 1.0

	--test-- "vector-find-5"
		--assert 1 = length? find make vector! [1 2 3 4] 4

	--test-- "vector-find-6"
		--assert none = find/part make vector! [1 2 3 4] 4 3

	--test-- "vector-find-7"
		--assert 3 = first find/part make vector! [1 2 3 4] 3 3
		--assert 4 = second find/part make vector! [1 2 3 4] 3 3
		--assert 2 = length? find/part make vector! [1 2 3 4] 3 3

	--test-- "vector-find-8"
		--assert #"a" = first find/case make vector! [ #"A" #"a" #"b" #"c"] #"a"
		--assert 3 = length? find/case make vector! [ #"A" #"a" #"b" #"c"] #"a"

	--test-- "vector-find-9"
		--assert #"a" = first find make vector! [ #"A" #"a" #"b" #"c"] #"a"

	--test-- "vector-find-10"
		--assert (make vector! [4 5 6]) = find/skip make vector! [1 4 4 4 5 6] 4 3

	--test-- "vector-find-11"
		--assert (make vector! [1]) = find/last make vector! [1 1 1 1 1] 1

	--test-- "vector-find-12"
		vf12-v: next next next make vector! [1 2 1 2 1 2]
		--assert (make vector! [2 1 2 1 2]) = find/reverse vf12-v 2

	--test-- "vector-find-13"
		--assert (make vector! [5 6]) = find/tail make vector! [1 2 3 4 5 6] 4

	--test-- "vector-find-14"
		--assert (make vector! [3 4]) = find/match next make vector! [1 2 3 4] 2

===end-group===

===start-group=== "vector select"

	--test-- "vector-select-1"
		--assert none = select make vector! [1 2 3 4] "five"

	--test-- "vector-select-2"
		--assert none = select next make vector! [1 2 3 4] 1

	--test-- "vector-select-3"
		--assert 2 = select make vector! [1 2 3 4] 1

	--test-- "vector-select-4"
		--assert none = select make vector! [1 2 3 4] 1.0

	--test-- "vector-select-5"
		--assert 4 = select make vector! [1 2 3 4] 3

	--test-- "vector-select-6"
		--assert none = select/part make vector! [1 2 3 4] 4 3

	--test-- "vector-select-7"
		--assert 4 = select/part make vector! [1 2 3 4] 3 3

	--test-- "vector-select-8"
		--assert #"b" = select/case make vector! [ #"A" #"a" #"b" #"c"] #"a"

	--test-- "vector-select-9"
		--assert #"b" = select make vector! [ #"A" #"a" #"b" #"c"] #"a"

	--test-- "vector-select-10"
		--assert 5 = select/skip make vector! [1 4 4 4 5 6] 4 3

	--test-- "vector-select-11"
		--assert 1 = select/last make vector! [1 2 3 4 1] 4

	--test-- "vector-select-12"
		vs12-v: next next next next make vector! [1 2 1 2 3 4]
		--assert 3 = select/reverse vs12-v 2

===end-group===

===start-group=== "vector add"

		va-v1: make vector! [10 20 30 40 50]
		va-v2: make vector! [2 3 4 5 6]

	--test-- "vector-add-1"
		va1-v: va-v1 + va-v2
		--assert va1-v = make vector! [12 23 34 45 56]

	--test-- "vector-add-2"
		va2-v: add va-v1 va-v2
		--assert va2-v = make vector! [12 23 34 45 56]

	--test-- "vector-add-3"
		va3-v: add next va-v1 va-v2
		--assert va3-v = make vector! [22 33 44 55 6]

	--test-- "vector-add-4"
		va4-v: add va-v1 next next va-v2
		--assert va4-v = make vector! [14 25 36 40 50]

	--test-- "vector-add-5"
		va-v1: make vector! [1.0 2.0 3.0 4.0 5.0]
		va5-v: va-v1 + va-v1
		--assert va5-v = make vector! [2.0 4.0 6.0 8.0 10.0]

	--test-- "vector-add-6"
		va6-v: va-v1 + 0.5
		--assert va6-v = make vector! [1.5 2.5 3.5 4.5 5.5]

	--test-- "vector-add-7"
		va-v1: make vector! [10 20 30 40 50]
		va7-v: va-v1 + -1
		--assert va7-v = make vector! [9 19 29 39 49]

	--test-- "vector-add-8"
		va-v1: make vector! [10 20 30 40 50]
		va8-v: va-v1 + 1.5
		--assert va8-v = make vector! [11 21 31 41 51]

	--test-- "vector-add-9"
		va-v1: make vector! [10 20 30 40 50]
		va9-v: va-v1 + 0.5
		--assert va9-v = make vector! [10 20 30 40 50]

===end-group===

===start-group=== "vector subtract"

		vs-v1: make vector! [10 20 30 40 50]
		vs-v2: make vector! [2 3 4 5 6]

	--test-- "vector-subtract-1"
		vs1-v: vs-v1 - vs-v2
		--assert vs1-v = make vector! [8 17 26 35 44]

	--test-- "vector-subtract-2"
		vs2-v: subtract vs-v1 vs-v2
		--assert vs2-v = make vector! [8 17 26 35 44]

	--test-- "vector-subtract-3"
		vs3-v: subtract next vs-v1 vs-v2
		--assert vs3-v = make vector! [18 27 36 45 -6]

	--test-- "vector-subtract-4"
		vs4-v: subtract vs-v1 next next vs-v2
		--assert vs4-v = make vector! [6 15 24 40 50]

	--test-- "vector-subtract-5"
		vs-v1: make vector! [1.0 2.0 3.0 4.0 5.0]
		vs5-v: vs-v1 - vs-v1
		--assert vs5-v = make vector! [0.0 0.0 0.0 0.0 0.0]

	--test-- "vector-subtract-6"
		vs6-v: vs-v1 - 0.5
		--assert vs6-v = make vector! [0.5 1.5 2.5 3.5 4.5]

	--test-- "vector-subtract-7"
		vs-v1: make vector! [10 20 30 40 50]
		vs7-v: vs-v1 - -1
		--assert vs7-v = make vector! [11 21 31 41 51]

	--test-- "vector-subtract-8"
		vs-v1: make vector! [10 20 30 40 50]
		vs8-v: vs-v1 - 1.5
		--assert vs8-v = make vector! [9 19 29 39 49]

	--test-- "vector-subtract-9"
		vs-v1: make vector! [10 20 30 40 50]
		vs9-v: vs-v1 - 0.5
		--assert vs9-v = make vector! [10 20 30 40 50]

===end-group===

~~~end-file~~~


FIX: Console: "ReadConsole failed!"

FIX: Console: "ReadConsole failed!"

Red [
	Title:	"Red console"
	Author: ["Nenad Rakocevic" "Kaj de Vos"]
	File: 	%console.red
	Tabs: 	4
	Rights: "Copyright (C) 2012-2013 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

#system-global [
	#either OS = 'Windows [
		#import [
			"kernel32.dll" stdcall [
				AttachConsole: 	 "AttachConsole" [
					processID		[integer!]
					return:			[integer!]
				]
				SetConsoleTitle: "SetConsoleTitleA" [
					title			[c-string!]
					return:			[integer!]
				]
				ReadConsole: 	 "ReadConsoleW" [
					consoleInput	[integer!]
					buffer			[byte-ptr!]
					charsToRead		[integer!]
					numberOfChars	[int-ptr!]
					inputControl	[int-ptr!]
					return:			[integer!]
				]
			]
		]
		line-buffer-size: 15 * 1024
		line-buffer: allocate line-buffer-size * 2 + 1
	][
		#switch OS [
			MacOSX [
				#define ReadLine-library "libreadline.dylib"
			]
			#default [
				#define ReadLine-library "libreadline.so.6"
				#define History-library  "libhistory.so.6"
			]
		]
		#import [
			ReadLine-library cdecl [
				read-line: "readline" [  ; Read a line from the console.
					prompt			[c-string!]
					return:			[c-string!]
				]
				rl-bind-key: "rl_bind_key" [
					key				[integer!]
					command			[integer!]
					return:			[integer!]
				]
				rl-insert:	 "rl_insert" [
					count			[integer!]
					key				[integer!]
					return:			[integer!]
				]
			]
			#if OS <> 'MacOSX [
				History-library cdecl [
					add-history: "add_history" [  ; Add line to the history.
						line		[c-string!]
					]
				]
			]
		]

		rl-insert-wrapper: func [
			[cdecl]
			count   [integer!]
			key	    [integer!]
			return: [integer!]
		][
			rl-insert count key
		]

	]
]

#include %help.red

read-argument: routine [
	/local
		args [str-array!]
		str	 [red-string!]
][
	if system/args-count <> 2 [
		SET_RETURN(none-value)
		exit
	]
	args: system/args-list + 1							;-- skip binary filename
	str: simple-io/read-txt args/item
	SET_RETURN(str)
]

init-console: routine [
	str [string!]
	/local
		ret
][
	#either OS = 'Windows [
		;ret: AttachConsole -1
		;if zero? ret [print-line "ReadConsole failed!" halt]

		ret: SetConsoleTitle as c-string! string/rs-head str
		if zero? ret [print-line "SetConsoleTitle failed!" halt]
	][
		rl-bind-key as-integer tab as-integer :rl-insert-wrapper
	]
]

input: routine [
	prompt [string!]
	/local
		len ret str buffer line pos
][
	#either OS = 'Windows [
		len: 0
		print as c-string! string/rs-head prompt
		ret: ReadConsole stdin line-buffer line-buffer-size :len null
		if zero? ret [print-line "ReadConsole failed!" halt]
		pos: (len * 2) - 3								;-- position at lower 8bits of CR character
		line-buffer/pos: null-byte						;-- overwrite CR with NUL
		str: string/load as-c-string line-buffer len - 1 UTF-16LE
	][
		line: read-line as-c-string string/rs-head prompt
		if line = null [halt]  ; EOF

		 #if OS <> 'MacOSX [add-history line]

		str: string/load line  1 + length? line
;		free as byte-ptr! line
	]
	SET_RETURN(str)
]

count-delimiters: function [
	buffer	[string!]
	return: [block!]
][
	list: copy [0 0]
	c: none

	foreach c buffer [
		case [
			escaped?	[escaped?: no]
			in-comment? [if c = #"^/" [in-comment?: no]]
			'else [
				switch c [
					#"^^" [escaped?: yes]
					#";"  [if zero? list/2 [in-comment?: yes]]
					#"["  [unless in-string? [list/1: list/1 + 1]]
					#"]"  [unless in-string? [list/1: list/1 - 1]]
					#"{"  [if zero? list/2 [in-string?: yes] list/2: list/2 + 1]
					#"}"  [if 1 = list/2   [in-string?: no]  list/2: list/2 - 1]
				]
			]
		]
	]
	list
]

do-console: function [][
	buffer: make string! 10000
	prompt: red-prompt: "red>> "
	mode:  'mono

	switch-mode: [
		mode: case [
			cnt/1 > 0 ['block]
			cnt/2 > 0 ['string]
			'else 	  [
				prompt: red-prompt
				do eval
				'mono
			]
		]
		prompt: switch mode [
			block  ["[^-"]
			string ["{^-"]
			mono   [red-prompt]
		]
	]

	eval: [
		code: load/all buffer

		unless tail? code [
			set/any 'result do code

			unless unset? :result [
				if 67 = length? result: mold/part :result 67 [	;-- optimized for width = 72
					clear back tail result
					append result "..."
				]
				print ["==" result]
			]
		]
		clear buffer
	]

	while [true][
		unless tail? line: input prompt [
			append buffer line
			cnt: count-delimiters buffer
			append buffer lf							;-- needed for multiline modes

			switch mode [
				block  [if cnt/1 <= 0 [do switch-mode]]
				string [if cnt/2 <= 0 [do switch-mode]]
				mono   [do either any [cnt/1 > 0 cnt/2 > 0][switch-mode][eval]]
			]
		]
	]
]

q: :quit

if script: read-argument [
	script: load script
	either any [
		script/1 <> 'Red
		not block? script/2
	][
		print "*** Error: not a Red program!"
	][
		do skip script 2
	]
	quit
]
init-console "Red Console"

print {
-=== Red Console alpha version ===-
Type HELP for starting information.
}

do-console

Red [
	Title:	"Red console"
	Author: ["Nenad Rakocevic" "Kaj de Vos"]
	File: 	%console.red
	Tabs: 	4
	Rights: "Copyright (C) 2012-2013 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

#system-global [
	#either OS = 'Windows [
		#import [
			"kernel32.dll" stdcall [
				AttachConsole: 	 "AttachConsole" [
					processID		[integer!]
					return:			[integer!]
				]
				SetConsoleTitle: "SetConsoleTitleA" [
					title			[c-string!]
					return:			[integer!]
				]
				ReadConsole: 	 "ReadConsoleW" [
					consoleInput	[integer!]
					buffer			[byte-ptr!]
					charsToRead		[integer!]
					numberOfChars	[int-ptr!]
					inputControl	[int-ptr!]
					return:			[integer!]
				]
			]
		]
		line-buffer-size: 30 * 1024
		line-buffer: allocate line-buffer-size
	][
		#switch OS [
			MacOSX [
				#define ReadLine-library "libreadline.dylib"
			]
			#default [
				#define ReadLine-library "libreadline.so.6"
				#define History-library  "libhistory.so.6"
			]
		]
		#import [
			ReadLine-library cdecl [
				read-line: "readline" [  ; Read a line from the console.
					prompt			[c-string!]
					return:			[c-string!]
				]
				rl-bind-key: "rl_bind_key" [
					key				[integer!]
					command			[integer!]
					return:			[integer!]
				]
				rl-insert:	 "rl_insert" [
					count			[integer!]
					key				[integer!]
					return:			[integer!]
				]
			]
			#if OS <> 'MacOSX [
				History-library cdecl [
					add-history: "add_history" [  ; Add line to the history.
						line		[c-string!]
					]
				]
			]
		]

		rl-insert-wrapper: func [
			[cdecl]
			count   [integer!]
			key	    [integer!]
			return: [integer!]
		][
			rl-insert count key
		]

	]
]

#include %help.red

read-argument: routine [
	/local
		args [str-array!]
		str	 [red-string!]
][
	if system/args-count <> 2 [
		SET_RETURN(none-value)
		exit
	]
	args: system/args-list + 1							;-- skip binary filename
	str: simple-io/read-txt args/item
	SET_RETURN(str)
]

init-console: routine [
	str [string!]
	/local
		ret
][
	#either OS = 'Windows [
		;ret: AttachConsole -1
		;if zero? ret [print-line "ReadConsole failed!" halt]

		ret: SetConsoleTitle as c-string! string/rs-head str
		if zero? ret [print-line "SetConsoleTitle failed!" halt]
	][
		rl-bind-key as-integer tab as-integer :rl-insert-wrapper
	]
]

input: routine [
	prompt [string!]
	/local
		len ret str buffer line pos
][
	#either OS = 'Windows [
		len: 0
		print as c-string! string/rs-head prompt
		ret: ReadConsole stdin line-buffer line-buffer-size :len null
		if zero? ret [print-line "ReadConsole failed!" halt]
		pos: (len * 2) - 3								;-- position at lower 8bits of CR character
		line-buffer/pos: null-byte						;-- overwrite CR with NUL
		str: string/load as-c-string line-buffer len - 1 UTF-16LE
	][
		line: read-line as-c-string string/rs-head prompt
		if line = null [halt]  ; EOF

		 #if OS <> 'MacOSX [add-history line]

		str: string/load line  1 + length? line
;		free as byte-ptr! line
	]
	SET_RETURN(str)
]

count-delimiters: function [
	buffer	[string!]
	return: [block!]
][
	list: copy [0 0]
	c: none

	foreach c buffer [
		case [
			escaped?	[escaped?: no]
			in-comment? [if c = #"^/" [in-comment?: no]]
			'else [
				switch c [
					#"^^" [escaped?: yes]
					#";"  [if zero? list/2 [in-comment?: yes]]
					#"["  [unless in-string? [list/1: list/1 + 1]]
					#"]"  [unless in-string? [list/1: list/1 - 1]]
					#"{"  [if zero? list/2 [in-string?: yes] list/2: list/2 + 1]
					#"}"  [if 1 = list/2   [in-string?: no]  list/2: list/2 - 1]
				]
			]
		]
	]
	list
]

do-console: function [][
	buffer: make string! 10000
	prompt: red-prompt: "red>> "
	mode:  'mono

	switch-mode: [
		mode: case [
			cnt/1 > 0 ['block]
			cnt/2 > 0 ['string]
			'else 	  [
				prompt: red-prompt
				do eval
				'mono
			]
		]
		prompt: switch mode [
			block  ["[^-"]
			string ["{^-"]
			mono   [red-prompt]
		]
	]

	eval: [
		code: load/all buffer

		unless tail? code [
			set/any 'result do code

			unless unset? :result [
				if 67 = length? result: mold/part :result 67 [	;-- optimized for width = 72
					clear back tail result
					append result "..."
				]
				print ["==" result]
			]
		]
		clear buffer
	]

	while [true][
		unless tail? line: input prompt [
			append buffer line
			cnt: count-delimiters buffer
			append buffer lf							;-- needed for multiline modes

			switch mode [
				block  [if cnt/1 <= 0 [do switch-mode]]
				string [if cnt/2 <= 0 [do switch-mode]]
				mono   [do either any [cnt/1 > 0 cnt/2 > 0][switch-mode][eval]]
			]
		]
	]
]

q: :quit

if script: read-argument [
	script: load script
	either any [
		script/1 <> 'Red
		not block? script/2
	][
		print "*** Error: not a Red program!"
	][
		do skip script 2
	]
	quit
]
init-console "Red Console"

print {
-=== Red Console alpha version ===-
Type HELP for starting information.
}

do-console


TESTS: change null-char to null-byte in length-test.reds

Red/System [
	Title:   "Red/System length? test script"
	Author:  "Peter W A Wood"
	File: 	 %length-test.reds
	Rights:  "Copyright (C) 2011 Peter W A Wood. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/origin/BSD-3-License.txt"
]

#include %../../quick-test/quick-test.reds

~~~start-file~~~ "length?"

===start-group=== "Simple length? tests"

	--test-- "length?-1"
	--assert 1 = length? "1"

	--test-- "length?-2"
	  l?2-s: "123"
	--assert 3 = length? l?2-s

	--test-- "length?-3"
	  l?3-s: "1^(0A)3"
	--assert 3 = length? l?3-s

	--test-- "length?-4"
	--assert 3 = length? "1^(0A)3"

	--test-- "length?-5"
	  l?5-s: "1234567890"
	  l?5-s/6: null-byte
	--assert 5 = length? l?5-s

	--test-- "length?-6"
	  l?6-s: "1234567890"
	  l?6-s/6: null-byte
	  l?6-s/6: #"6"
	--assert 10 = length? l?6-s

===end-group===

===start-group=== "Chaining function calls"

  --test-- "len-chain-1"
    lc1-func: func [
      s [c-string!]
      return: [c-string!]
    ][
      s
    ]
  --assert 5 = length? lc1-func "Peter"

  --test-- "len-chain-2"
    lc2-func: func [
      s [c-string!]
      return: [c-string!]
    ][
      s
    ]
  --assert 5 = length? lc1-func lc1-func "Nenad"

===end-group===

===start-group=== "Allocated strings"

  --test-- "len-alloc-1"
    la1-s1: allocate 128
    la1-s1/128: null-byte
  --assert 128 > length? la1-s1

  --test-- "len-alloc-2"
    la2-s1: allocate 128
    la2-s1/1: null-byte
  --assert 0 = length? la2-s1

  --test-- "len-alloc-3"
    la2-s1: allocate 128
    la2-s1: "Nenad"
  --assert 5 = length? la2-s1

~~~end-file~~~

Red/System [
	Title:   "Red/System length? test script"
	Author:  "Peter W A Wood"
	File: 	 %length-test.reds
	Rights:  "Copyright (C) 2011 Peter W A Wood. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/origin/BSD-3-License.txt"
]

#include %../../quick-test/quick-test.reds

~~~start-file~~~ "length?"

===start-group=== "Simple length? tests"

	--test-- "length?-1"
	--assert 1 = length? "1"

	--test-- "length?-2"
	  l?2-s: "123"
	--assert 3 = length? l?2-s

	--test-- "length?-3"
	  l?3-s: "1^(0A)3"
	--assert 3 = length? l?3-s

	--test-- "length?-4"
	--assert 3 = length? "1^(0A)3"

	--test-- "length?-5"
	  l?5-s: "1234567890"
	  l?5-s/6: null-char
	--assert 5 = length? l?5-s

	--test-- "length?-6"
	  l?6-s: "1234567890"
	  l?6-s/6: null-char
	  l?6-s/6: #"6"
	--assert 10 = length? l?6-s

===end-group===

===start-group=== "Chaining function calls"

  --test-- "len-chain-1"
    lc1-func: func [
      s [c-string!]
      return: [c-string!]
    ][
      s
    ]
  --assert 5 = length? lc1-func "Peter"

  --test-- "len-chain-2"
    lc2-func: func [
      s [c-string!]
      return: [c-string!]
    ][
      s
    ]
  --assert 5 = length? lc1-func lc1-func "Nenad"

===end-group===

===start-group=== "Allocated strings"

  --test-- "len-alloc-1"
    la1-s1: allocate 128
    la1-s1/128: null-char
  --assert 128 > length? la1-s1

  --test-- "len-alloc-2"
    la2-s1: allocate 128
    la2-s1/1: null-char
  --assert 0 = length? la2-s1

  --test-- "len-alloc-3"
    la2-s1: allocate 128
    la2-s1: "Nenad"
  --assert 5 = length? la2-s1

~~~end-file~~~


FEAT: added missing assertions in struct tests s-rw-2 and l-rw-2 (for detecting memory corruptions on struct paths write accesses)

Red/System [
	Title:   "Red/System struct! datatype test script"
	Author:  "Nenad Rakocevic"
	File: 	 %struct-test.reds
	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/origin/BSD-3-License.txt"
]

#include %../../quick-test/quick-test.reds

~~~start-file~~~ "struct!"

===start-group=== "Struct members simple read/write tests"

	--test-- "s-rw-1"
	struct1: struct [b [integer!]]
	struct1/b: 12345
	--assert struct1/b = 12345

	--test-- "s-rw-2"
	struct2: struct [b [byte!] c [c-string!] d [integer!]]
	struct2/c: "a"
	struct2/d: 9876
	struct2/b: #"R"				;-- intentionnaly put there to test not overlapping memory storage
	--assert struct2/b   = #"R"
	--assert struct2/c/1 = #"a"
	--assert struct2/d   = 9876

	--test-- "s-rw-3"
	--assert struct2/c/1 = #"a"

	--test-- "s-rw-4"
	--assert struct2/d   = 9876

	--test-- "s-rw-5"
	struct2/c/1: #"x"
	--assert struct2/c/1 = #"x"

	--test-- "s-rw-6"
	struct2-b: struct2/b
	struct2-c: struct2/c
	struct2-d: struct2/d
	--assert struct2-b   = #"R"

	--test-- "s-rw-7"
	--assert struct2-c/1 = #"x"

	--test-- "s-rw-8"
	--assert struct2-d   = 9876

	--test-- "s-rw-9"
	struct2-c/1: #"y"
	--assert struct2-c/1 = #"y"

	--test-- "s-rw-10"
	struct2-foo-int:  func [a [integer!] return: [integer!]][a]
	struct2-foo-byte: func [a [byte!] return: [byte!]][a]
	--assert 9876 = struct2-foo-int struct2/d

	--test-- "s-rw-11"
	--assert #"R" = struct2-foo-byte struct2/b

===end-group===

===start-group=== "Nested structs read/write tests"

	--test-- "s-nested-1"
	struct3: struct [
		d [byte!]
		b [integer!]
		c [c-string!]
		sub [					;-- this is a reference to a struct! not a struct value
			struct! [
				e [integer!]
				f [c-string!]
			]
		]
		g [integer!]
	]
	struct3/sub: struct [
		e [integer!]
		f [c-string!]
	]
	struct3/d: #"A"
	struct3/b: 123
	struct3/c: "test"
	struct3/g: 123456798
	struct3/sub/e: 987
	struct3/sub/f: "hello"

	--assert struct3/b = 123
	--assert struct3/g = 123456798

	--test-- "s-nested-2"
	--assert struct3/d = #"A"

	--test-- "s-nested-3"
	--assert struct3/c/1 = #"t"

	--test-- "s-nested-4"
	--assert all [
		struct3/c/1 = #"t"
		struct3/c/2 = #"e"
		struct3/c/3 = #"s"
		struct3/c/4 = #"t"
	]

	--test-- "s-nested-5"
	--assert struct3/sub/e = 987

	--test-- "s-nested-6"
	struct3-e: struct3/sub/e
	--assert struct3-e = 987

	--test-- "s-nested-7"
	--assert all [
		struct3/sub/f/1 = #"h"
		struct3/sub/f/2 = #"e"
		struct3/sub/f/3 = #"l"
		struct3/sub/f/4 = #"l"
		struct3/sub/f/5 = #"o"
	]

	--test-- "s-nested-8"
	struct3-f: struct3/sub/f
	--assert struct3-f/1 = #"h"

	--test-- "s-nested-9"
	struct3-byte: struct3/sub/f/2
	--assert struct3-byte = #"e"

===end-group===

===start-group=== "Local struct variables read/write tests"

struct-local-foo: func [
	/local
		struct1   [struct! [b [integer!]]]
		struct2   [struct! [b [byte!] c [c-string!] d [integer!]]]
		struct2-b [byte!]
		struct2-c [c-string!]
		struct2-d [integer!]
		struct3   [struct! [d [byte!] b [integer!] c [c-string!] sub [struct! [e [integer!] f [c-string!]]] g [integer!]]]
		struct3-e [integer!]
		struct3-f [c-string!]
		struct3-byte [byte!]
][
	--test-- "ls-rw-1"
	struct1: struct [b [integer!]]
	struct1/b: 12345
	--assert struct1/b = 12345

	--test-- "ls-rw-2"
	struct2: struct [b [byte!] c [c-string!] d [integer!]]
	struct2/c: "a"
	struct2/d: 9876
	struct2/b: #"R"				;-- intentionnaly put there to test not overlapping memory storage
	--assert struct2/b   = #"R"
	--assert struct2/c/1 = #"a"
	--assert struct2/d   = 9876

	--test-- "ls-rw-3"
	--assert struct2/c/1 = #"a"

	--test-- "ls-rw-4"
	--assert struct2/d   = 9876

	--test-- "ls-rw-5"
	struct2/c/1: #"x"
	--assert struct2/c/1 = #"x"

	--test-- "ls-rw-6"
	struct2-b: struct2/b
	struct2-c: struct2/c
	struct2-d: struct2/d
	--assert struct2-b   = #"R"

	--test-- "ls-rw-7"
	--assert struct2-c/1 = #"x"

	--test-- "ls-rw-8"
	--assert struct2-d   = 9876

	--test-- "ls-rw-9"
	struct2-c/1: #"y"
	--assert struct2-c/1 = #"y"

	--test-- "ls-rw-10"
	struct2-foo-int:  func [a [integer!] return: [integer!]][a]
	struct2-foo-byte: func [a [byte!] return: [byte!]][a]
	--assert 9876 = struct2-foo-int struct2/d

	--test-- "ls-rw-11"
	--assert #"R" = struct2-foo-byte struct2/b

	--test-- "ls-nested-1"
	struct3: struct [
		d [byte!]
		b [integer!]
		c [c-string!]
		sub [					;-- this is a reference to a struct! not a struct value
			struct! [
				e [integer!]
				f [c-string!]
			]
		]
		g [integer!]
	]
	struct3/sub: struct [
		e [integer!]
		f [c-string!]
	]
	struct3/d: #"A"
	struct3/b: 123
	struct3/c: "test"
	struct3/g: 123456798
	struct3/sub/e: 987
	struct3/sub/f: "hello"

	--assert struct3/b = 123
	--assert struct3/g = 123456798

	--test-- "ls-nested-2"
	--assert struct3/d = #"A"

	--test-- "ls-nested-3"
	--assert struct3/c/1 = #"t"

	--test-- "ls-nested-4"
	--assert all [
		struct3/c/1 = #"t"
		struct3/c/2 = #"e"
		struct3/c/3 = #"s"
		struct3/c/4 = #"t"
	]

	--test-- "ls-nested-5"
	--assert struct3/sub/e = 987

	--test-- "ls-nested-6"
	struct3-e: struct3/sub/e
	--assert struct3-e = 987

	--test-- "ls-nested-7"
	--assert all [
		struct3/sub/f/1 = #"h"
		struct3/sub/f/2 = #"e"
		struct3/sub/f/3 = #"l"
		struct3/sub/f/4 = #"l"
		struct3/sub/f/5 = #"o"
	]

	--test-- "ls-nested-8"
	struct3-f: struct3/sub/f
	--assert struct3-f/1 = #"h"

	--test-- "ls-nested-9"
	struct3-byte: struct3/sub/f/2
	--assert struct3-byte = #"e"
]
struct-local-foo

===end-group===

===start-group=== "Struct variables arithmetic"

	--test-- "struct-math-1"
	struct4: struct [
		a [struct! [value [integer!]]]
		b [struct! [value [integer!]]]
		c [struct! [value [integer!]]]
	]
	struct5: struct [value [integer!]]

	struct4/a: struct [value [integer!]]
	struct4/b: struct [value [integer!]]
	struct4/c: struct [value [integer!]]

	struct4/a/value: 123
	struct4/b/value: 456
	struct4/c/value: 789

	--assert struct4/a/value = 123
	--assert struct4/b/value = 456
	--assert struct4/c/value = 789

	struct5: struct4/a
	--assert struct5/value = 123

	--test-- "struct-math-2"
	struct5: struct5 + 1
	--assert struct5/value = 456

	--test-- "struct-math-3"
	struct5: struct4/c
	--assert struct5/value = 789
	struct5: struct5 - 2
	--assert struct5/value = 123

	--test-- "struct-math-4"
	struct-idx: 2
	struct5: struct5 + struct-idx
	--assert struct5/value = 789

	--test-- "struct-math-5"
	struct-idx: -2
	struct5: struct5 + struct-idx
	--assert struct5/value = 123

	--test-- "struct-math-6"
	struct-idx: -2
	struct5: struct5 - struct-idx
	--assert struct5/value = 789

	--test-- "struct-math-7"
	struct6: struct [
		a [struct! [value [byte!]]]
		b [struct! [value [byte!]]]
		c [struct! [value [byte!]]]
	]
	struct7: struct [value [byte!]]

	struct6/a: struct [value [byte!]]
	struct6/b: struct [value [byte!]]
	struct6/c: struct [value [byte!]]

	struct6/a/value: #"a"
	struct6/b/value: #"b"
	struct6/c/value: #"c"

	--assert struct6/a/value = #"a"
	--assert struct6/b/value = #"b"
	--assert struct6/c/value = #"c"

	struct7: struct6/a
	--assert struct7/value = #"a"

	--test-- "struct-math-8"
	struct7: struct7 + 1
	--assert struct7/value = #"b"

	--test-- "struct-math-9"
	struct7: struct6/c
	--assert struct7/value = #"c"
	struct7: struct7 - 2
	--assert struct7/value = #"a"

	--test-- "struct-math-10"
	struct-idx: 2
	struct7: struct7 + struct-idx
	--assert struct7/value = #"c"

	--test-- "struct-math-11"
	struct-idx: -2
	struct7: struct7 + struct-idx
	--assert struct7/value = #"a"

	--test-- "struct-math-12"
	struct-idx: -2
	struct7: struct7 - struct-idx
	--assert struct7/value = #"c"

	--test-- "struct-math-13"
	struct8: struct [
		a [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
		b [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
		c [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
	]
	struct9: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]

	struct8/a: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]
	struct8/b: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]
	struct8/c: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]

	struct8/a/v1: 123
	struct8/b/v1: 456
	struct8/c/v1: 789

	struct8/a/v2: #"a"
	struct8/b/v2: #"b"
	struct8/c/v2: #"c"

	struct8/a/v3: "A"
	struct8/b/v3: "B"
	struct8/c/v3: "C"

	--assert struct8/a/v1 = 123
	--assert struct8/b/v1 = 456
	--assert struct8/c/v1 = 789

	--assert struct8/a/v2 = #"a"
	--assert struct8/b/v2 = #"b"
	--assert struct8/c/v2 = #"c"

	--assert struct8/a/v3/1 = #"A"
	--assert struct8/b/v3/1 = #"B"
	--assert struct8/c/v3/1 = #"C"

	struct9: struct8/a
	--assert struct9/v1 = 123
	--assert struct9/v2 = #"a"
	--assert struct9/v3/1 = #"A"

	--test-- "struct-math-14"
	struct9: struct9 + 1
	--assert struct9/v1 = 456
	--assert struct9/v2 = #"b"
	--assert struct9/v3/1 = #"B"

===end-group===

===start-group=== "Local struct variables arithmetic"

struct-local-foo2: func [
	/local
		struct4 [struct! [
			a [struct! [value [integer!]]]
			b [struct! [value [integer!]]]
			c [struct! [value [integer!]]]
		]]
		struct5 [struct! [value [integer!]]]
		struct6 [struct! [
			a [struct! [value [byte!]]]
			b [struct! [value [byte!]]]
			c [struct! [value [byte!]]]
		]]
		struct7 [struct! [value [byte!]]]
		struct8 [struct! [
			a [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
			b [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
			c [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
		]]
		struct9 [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
		struct-idx [integer!]
][
	--test-- "loc-struct-math-1"
	struct4: struct [
		a [struct! [value [integer!]]]
		b [struct! [value [integer!]]]
		c [struct! [value [integer!]]]
	]
	struct5: struct [value [integer!]]

	struct4/a: struct [value [integer!]]
	struct4/b: struct [value [integer!]]
	struct4/c: struct [value [integer!]]

	struct4/a/value: 123
	struct4/b/value: 456
	struct4/c/value: 789

	--assert struct4/a/value = 123
	--assert struct4/b/value = 456
	--assert struct4/c/value = 789

	struct5: struct4/a
	--assert struct5/value = 123

	--test-- "loc-struct-math-2"
	struct5: struct5 + 1
	--assert struct5/value = 456

	--test-- "loc-struct-math-3"
	struct5: struct4/c
	--assert struct5/value = 789
	struct5: struct5 - 2
	--assert struct5/value = 123

	--test-- "loc-struct-math-4"
	struct-idx: 2
	struct5: struct5 + struct-idx
	--assert struct5/value = 789

	--test-- "loc-struct-math-5"
	struct-idx: -2
	struct5: struct5 + struct-idx
	--assert struct5/value = 123

	--test-- "loc-struct-math-6"
	struct-idx: -2
	struct5: struct5 - struct-idx
	--assert struct5/value = 789

	--test-- "loc-struct-math-7"
	struct6: struct [
		a [struct! [value [byte!]]]
		b [struct! [value [byte!]]]
		c [struct! [value [byte!]]]
	]
	struct7: struct [value [byte!]]

	struct6/a: struct [value [byte!]]
	struct6/b: struct [value [byte!]]
	struct6/c: struct [value [byte!]]

	struct6/a/value: #"a"
	struct6/b/value: #"b"
	struct6/c/value: #"c"

	--assert struct6/a/value = #"a"
	--assert struct6/b/value = #"b"
	--assert struct6/c/value = #"c"

	struct7: struct6/a
	--assert struct7/value = #"a"

	--test-- "loc-struct-math-8"
	struct7: struct7 + 1
	--assert struct7/value = #"b"

	--test-- "loc-struct-math-9"
	struct7: struct6/c
	--assert struct7/value = #"c"
	struct7: struct7 - 2
	--assert struct7/value = #"a"

	--test-- "loc-struct-math-10"
	struct-idx: 2
	struct7: struct7 + struct-idx
	--assert struct7/value = #"c"

	--test-- "loc-struct-math-11"
	struct-idx: -2
	struct7: struct7 + struct-idx
	--assert struct7/value = #"a"

	--test-- "loc-struct-math-12"
	struct-idx: -2
	struct7: struct7 - struct-idx
	--assert struct7/value = #"c"

	--test-- "loc-struct-math-13"
	struct8: struct [
		a [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
		b [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
		c [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
	]
	struct9: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]

	struct8/a: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]
	struct8/b: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]
	struct8/c: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]

	struct8/a/v1: 123
	struct8/b/v1: 456
	struct8/c/v1: 789

	struct8/a/v2: #"a"
	struct8/b/v2: #"b"
	struct8/c/v2: #"c"

	struct8/a/v3: "A"
	struct8/b/v3: "B"
	struct8/c/v3: "C"

	--assert struct8/a/v1 = 123
	--assert struct8/b/v1 = 456
	--assert struct8/c/v1 = 789

	--assert struct8/a/v2 = #"a"
	--assert struct8/b/v2 = #"b"
	--assert struct8/c/v2 = #"c"

	--assert struct8/a/v3/1 = #"A"
	--assert struct8/b/v3/1 = #"B"
	--assert struct8/c/v3/1 = #"C"

	struct9: struct8/a
	--assert struct9/v1 = 123
	--assert struct9/v2 = #"a"
	--assert struct9/v3/1 = #"A"

	--test-- "loc-struct-math-14"
	struct9: struct9 + 1
	--assert struct9/v1 = 456
	--assert struct9/v2 = #"b"
	--assert struct9/v3/1 = #"B"
]
struct-local-foo2

===end-group===

~~~end-file~~~

Red/System [
	Title:   "Red/System struct! datatype test script"
	Author:  "Nenad Rakocevic"
	File: 	 %struct-test.reds
	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/origin/BSD-3-License.txt"
]

#include %../../quick-test/quick-test.reds

~~~start-file~~~ "struct!"

===start-group=== "Struct members simple read/write tests"

	--test-- "s-rw-1"
	struct1: struct [b [integer!]]
	struct1/b: 12345
	--assert struct1/b = 12345

	--test-- "s-rw-2"
	struct2: struct [b [byte!] c [c-string!] d [integer!]]
	struct2/c: "a"
	struct2/d: 9876
	struct2/b: #"R"				;-- intentionnaly put there to test not overlapping memory storage
	--assert struct2/b   = #"R"

	--test-- "s-rw-3"
	--assert struct2/c/1 = #"a"

	--test-- "s-rw-4"
	--assert struct2/d   = 9876

	--test-- "s-rw-5"
	struct2/c/1: #"x"
	--assert struct2/c/1 = #"x"

	--test-- "s-rw-6"
	struct2-b: struct2/b
	struct2-c: struct2/c
	struct2-d: struct2/d
	--assert struct2-b   = #"R"

	--test-- "s-rw-7"
	--assert struct2-c/1 = #"x"

	--test-- "s-rw-8"
	--assert struct2-d   = 9876

	--test-- "s-rw-9"
	struct2-c/1: #"y"
	--assert struct2-c/1 = #"y"

	--test-- "s-rw-10"
	struct2-foo-int:  func [a [integer!] return: [integer!]][a]
	struct2-foo-byte: func [a [byte!] return: [byte!]][a]
	--assert 9876 = struct2-foo-int struct2/d

	--test-- "s-rw-11"
	--assert #"R" = struct2-foo-byte struct2/b

===end-group===

===start-group=== "Nested structs read/write tests"

	--test-- "s-nested-1"
	struct3: struct [
		d [byte!]
		b [integer!]
		c [c-string!]
		sub [					;-- this is a reference to a struct! not a struct value
			struct! [
				e [integer!]
				f [c-string!]
			]
		]
		g [integer!]
	]
	struct3/sub: struct [
		e [integer!]
		f [c-string!]
	]
	struct3/d: #"A"
	struct3/b: 123
	struct3/c: "test"
	struct3/g: 123456798
	struct3/sub/e: 987
	struct3/sub/f: "hello"

	--assert struct3/b = 123
	--assert struct3/g = 123456798

	--test-- "s-nested-2"
	--assert struct3/d = #"A"

	--test-- "s-nested-3"
	--assert struct3/c/1 = #"t"

	--test-- "s-nested-4"
	--assert all [
		struct3/c/1 = #"t"
		struct3/c/2 = #"e"
		struct3/c/3 = #"s"
		struct3/c/4 = #"t"
	]

	--test-- "s-nested-5"
	--assert struct3/sub/e = 987

	--test-- "s-nested-6"
	struct3-e: struct3/sub/e
	--assert struct3-e = 987

	--test-- "s-nested-7"
	--assert all [
		struct3/sub/f/1 = #"h"
		struct3/sub/f/2 = #"e"
		struct3/sub/f/3 = #"l"
		struct3/sub/f/4 = #"l"
		struct3/sub/f/5 = #"o"
	]

	--test-- "s-nested-8"
	struct3-f: struct3/sub/f
	--assert struct3-f/1 = #"h"

	--test-- "s-nested-9"
	struct3-byte: struct3/sub/f/2
	--assert struct3-byte = #"e"

===end-group===

===start-group=== "Local struct variables read/write tests"

struct-local-foo: func [
	/local
		struct1   [struct! [b [integer!]]]
		struct2   [struct! [b [byte!] c [c-string!] d [integer!]]]
		struct2-b [byte!]
		struct2-c [c-string!]
		struct2-d [integer!]
		struct3   [struct! [d [byte!] b [integer!] c [c-string!] sub [struct! [e [integer!] f [c-string!]]] g [integer!]]]
		struct3-e [integer!]
		struct3-f [c-string!]
		struct3-byte [byte!]
][
	--test-- "ls-rw-1"
	struct1: struct [b [integer!]]
	struct1/b: 12345
	--assert struct1/b = 12345

	--test-- "ls-rw-2"
	struct2: struct [b [byte!] c [c-string!] d [integer!]]
	struct2/c: "a"
	struct2/d: 9876
	struct2/b: #"R"				;-- intentionnaly put there to test not overlapping memory storage
	--assert struct2/b   = #"R"

	--test-- "ls-rw-3"
	--assert struct2/c/1 = #"a"

	--test-- "ls-rw-4"
	--assert struct2/d   = 9876

	--test-- "ls-rw-5"
	struct2/c/1: #"x"
	--assert struct2/c/1 = #"x"

	--test-- "ls-rw-6"
	struct2-b: struct2/b
	struct2-c: struct2/c
	struct2-d: struct2/d
	--assert struct2-b   = #"R"

	--test-- "ls-rw-7"
	--assert struct2-c/1 = #"x"

	--test-- "ls-rw-8"
	--assert struct2-d   = 9876

	--test-- "ls-rw-9"
	struct2-c/1: #"y"
	--assert struct2-c/1 = #"y"

	--test-- "ls-rw-10"
	struct2-foo-int:  func [a [integer!] return: [integer!]][a]
	struct2-foo-byte: func [a [byte!] return: [byte!]][a]
	--assert 9876 = struct2-foo-int struct2/d

	--test-- "ls-rw-11"
	--assert #"R" = struct2-foo-byte struct2/b

	--test-- "ls-nested-1"
	struct3: struct [
		d [byte!]
		b [integer!]
		c [c-string!]
		sub [					;-- this is a reference to a struct! not a struct value
			struct! [
				e [integer!]
				f [c-string!]
			]
		]
		g [integer!]
	]
	struct3/sub: struct [
		e [integer!]
		f [c-string!]
	]
	struct3/d: #"A"
	struct3/b: 123
	struct3/c: "test"
	struct3/g: 123456798
	struct3/sub/e: 987
	struct3/sub/f: "hello"

	--assert struct3/b = 123
	--assert struct3/g = 123456798

	--test-- "ls-nested-2"
	--assert struct3/d = #"A"

	--test-- "ls-nested-3"
	--assert struct3/c/1 = #"t"

	--test-- "ls-nested-4"
	--assert all [
		struct3/c/1 = #"t"
		struct3/c/2 = #"e"
		struct3/c/3 = #"s"
		struct3/c/4 = #"t"
	]

	--test-- "ls-nested-5"
	--assert struct3/sub/e = 987

	--test-- "ls-nested-6"
	struct3-e: struct3/sub/e
	--assert struct3-e = 987

	--test-- "ls-nested-7"
	--assert all [
		struct3/sub/f/1 = #"h"
		struct3/sub/f/2 = #"e"
		struct3/sub/f/3 = #"l"
		struct3/sub/f/4 = #"l"
		struct3/sub/f/5 = #"o"
	]

	--test-- "ls-nested-8"
	struct3-f: struct3/sub/f
	--assert struct3-f/1 = #"h"

	--test-- "ls-nested-9"
	struct3-byte: struct3/sub/f/2
	--assert struct3-byte = #"e"
]
struct-local-foo

===end-group===

===start-group=== "Struct variables arithmetic"

	--test-- "struct-math-1"
	struct4: struct [
		a [struct! [value [integer!]]]
		b [struct! [value [integer!]]]
		c [struct! [value [integer!]]]
	]
	struct5: struct [value [integer!]]

	struct4/a: struct [value [integer!]]
	struct4/b: struct [value [integer!]]
	struct4/c: struct [value [integer!]]

	struct4/a/value: 123
	struct4/b/value: 456
	struct4/c/value: 789

	--assert struct4/a/value = 123
	--assert struct4/b/value = 456
	--assert struct4/c/value = 789

	struct5: struct4/a
	--assert struct5/value = 123

	--test-- "struct-math-2"
	struct5: struct5 + 1
	--assert struct5/value = 456

	--test-- "struct-math-3"
	struct5: struct4/c
	--assert struct5/value = 789
	struct5: struct5 - 2
	--assert struct5/value = 123

	--test-- "struct-math-4"
	struct-idx: 2
	struct5: struct5 + struct-idx
	--assert struct5/value = 789

	--test-- "struct-math-5"
	struct-idx: -2
	struct5: struct5 + struct-idx
	--assert struct5/value = 123

	--test-- "struct-math-6"
	struct-idx: -2
	struct5: struct5 - struct-idx
	--assert struct5/value = 789

	--test-- "struct-math-7"
	struct6: struct [
		a [struct! [value [byte!]]]
		b [struct! [value [byte!]]]
		c [struct! [value [byte!]]]
	]
	struct7: struct [value [byte!]]

	struct6/a: struct [value [byte!]]
	struct6/b: struct [value [byte!]]
	struct6/c: struct [value [byte!]]

	struct6/a/value: #"a"
	struct6/b/value: #"b"
	struct6/c/value: #"c"

	--assert struct6/a/value = #"a"
	--assert struct6/b/value = #"b"
	--assert struct6/c/value = #"c"

	struct7: struct6/a
	--assert struct7/value = #"a"

	--test-- "struct-math-8"
	struct7: struct7 + 1
	--assert struct7/value = #"b"

	--test-- "struct-math-9"
	struct7: struct6/c
	--assert struct7/value = #"c"
	struct7: struct7 - 2
	--assert struct7/value = #"a"

	--test-- "struct-math-10"
	struct-idx: 2
	struct7: struct7 + struct-idx
	--assert struct7/value = #"c"

	--test-- "struct-math-11"
	struct-idx: -2
	struct7: struct7 + struct-idx
	--assert struct7/value = #"a"

	--test-- "struct-math-12"
	struct-idx: -2
	struct7: struct7 - struct-idx
	--assert struct7/value = #"c"

	--test-- "struct-math-13"
	struct8: struct [
		a [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
		b [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
		c [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
	]
	struct9: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]

	struct8/a: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]
	struct8/b: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]
	struct8/c: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]

	struct8/a/v1: 123
	struct8/b/v1: 456
	struct8/c/v1: 789

	struct8/a/v2: #"a"
	struct8/b/v2: #"b"
	struct8/c/v2: #"c"

	struct8/a/v3: "A"
	struct8/b/v3: "B"
	struct8/c/v3: "C"

	--assert struct8/a/v1 = 123
	--assert struct8/b/v1 = 456
	--assert struct8/c/v1 = 789

	--assert struct8/a/v2 = #"a"
	--assert struct8/b/v2 = #"b"
	--assert struct8/c/v2 = #"c"

	--assert struct8/a/v3/1 = #"A"
	--assert struct8/b/v3/1 = #"B"
	--assert struct8/c/v3/1 = #"C"

	struct9: struct8/a
	--assert struct9/v1 = 123
	--assert struct9/v2 = #"a"
	--assert struct9/v3/1 = #"A"

	--test-- "struct-math-14"
	struct9: struct9 + 1
	--assert struct9/v1 = 456
	--assert struct9/v2 = #"b"
	--assert struct9/v3/1 = #"B"

===end-group===

===start-group=== "Local struct variables arithmetic"

struct-local-foo2: func [
	/local
		struct4 [struct! [
			a [struct! [value [integer!]]]
			b [struct! [value [integer!]]]
			c [struct! [value [integer!]]]
		]]
		struct5 [struct! [value [integer!]]]
		struct6 [struct! [
			a [struct! [value [byte!]]]
			b [struct! [value [byte!]]]
			c [struct! [value [byte!]]]
		]]
		struct7 [struct! [value [byte!]]]
		struct8 [struct! [
			a [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
			b [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
			c [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
		]]
		struct9 [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
		struct-idx [integer!]
][
	--test-- "loc-struct-math-1"
	struct4: struct [
		a [struct! [value [integer!]]]
		b [struct! [value [integer!]]]
		c [struct! [value [integer!]]]
	]
	struct5: struct [value [integer!]]

	struct4/a: struct [value [integer!]]
	struct4/b: struct [value [integer!]]
	struct4/c: struct [value [integer!]]

	struct4/a/value: 123
	struct4/b/value: 456
	struct4/c/value: 789

	--assert struct4/a/value = 123
	--assert struct4/b/value = 456
	--assert struct4/c/value = 789

	struct5: struct4/a
	--assert struct5/value = 123

	--test-- "loc-struct-math-2"
	struct5: struct5 + 1
	--assert struct5/value = 456

	--test-- "loc-struct-math-3"
	struct5: struct4/c
	--assert struct5/value = 789
	struct5: struct5 - 2
	--assert struct5/value = 123

	--test-- "loc-struct-math-4"
	struct-idx: 2
	struct5: struct5 + struct-idx
	--assert struct5/value = 789

	--test-- "loc-struct-math-5"
	struct-idx: -2
	struct5: struct5 + struct-idx
	--assert struct5/value = 123

	--test-- "loc-struct-math-6"
	struct-idx: -2
	struct5: struct5 - struct-idx
	--assert struct5/value = 789

	--test-- "loc-struct-math-7"
	struct6: struct [
		a [struct! [value [byte!]]]
		b [struct! [value [byte!]]]
		c [struct! [value [byte!]]]
	]
	struct7: struct [value [byte!]]

	struct6/a: struct [value [byte!]]
	struct6/b: struct [value [byte!]]
	struct6/c: struct [value [byte!]]

	struct6/a/value: #"a"
	struct6/b/value: #"b"
	struct6/c/value: #"c"

	--assert struct6/a/value = #"a"
	--assert struct6/b/value = #"b"
	--assert struct6/c/value = #"c"

	struct7: struct6/a
	--assert struct7/value = #"a"

	--test-- "loc-struct-math-8"
	struct7: struct7 + 1
	--assert struct7/value = #"b"

	--test-- "loc-struct-math-9"
	struct7: struct6/c
	--assert struct7/value = #"c"
	struct7: struct7 - 2
	--assert struct7/value = #"a"

	--test-- "loc-struct-math-10"
	struct-idx: 2
	struct7: struct7 + struct-idx
	--assert struct7/value = #"c"

	--test-- "loc-struct-math-11"
	struct-idx: -2
	struct7: struct7 + struct-idx
	--assert struct7/value = #"a"

	--test-- "loc-struct-math-12"
	struct-idx: -2
	struct7: struct7 - struct-idx
	--assert struct7/value = #"c"

	--test-- "loc-struct-math-13"
	struct8: struct [
		a [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
		b [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
		c [struct! [v1 [integer!] v2 [byte!] v3 [c-string!]]]
	]
	struct9: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]

	struct8/a: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]
	struct8/b: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]
	struct8/c: struct [v1 [integer!] v2 [byte!] v3 [c-string!]]

	struct8/a/v1: 123
	struct8/b/v1: 456
	struct8/c/v1: 789

	struct8/a/v2: #"a"
	struct8/b/v2: #"b"
	struct8/c/v2: #"c"

	struct8/a/v3: "A"
	struct8/b/v3: "B"
	struct8/c/v3: "C"

	--assert struct8/a/v1 = 123
	--assert struct8/b/v1 = 456
	--assert struct8/c/v1 = 789

	--assert struct8/a/v2 = #"a"
	--assert struct8/b/v2 = #"b"
	--assert struct8/c/v2 = #"c"

	--assert struct8/a/v3/1 = #"A"
	--assert struct8/b/v3/1 = #"B"
	--assert struct8/c/v3/1 = #"C"

	struct9: struct8/a
	--assert struct9/v1 = 123
	--assert struct9/v2 = #"a"
	--assert struct9/v3/1 = #"A"

	--test-- "loc-struct-math-14"
	struct9: struct9 + 1
	--assert struct9/v1 = 456
	--assert struct9/v2 = #"b"
	--assert struct9/v3/1 = #"B"
]
struct-local-foo2

===end-group===

~~~end-file~~~


FEAT: a bit more accurate error messages for unmatched ] or ). Related to tickets #606 and #608.

Red/System [
	Title:   "Red data loader"
	Author:  "Nenad Rakocevic"
	File: 	 %tokenizer.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2012 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

tokenizer: context [

	#define NOT_DELIMITER?(c) [
		all [
			c <> null-byte
			c <> #" "
			c <> #"/"
			c <> #"^/"
			c <> #"^M"
			c <> #"^-"
			c <> #":"
			c <> #"^""
			c <> #"["
			c <> #"]"
			c <> #"("
			c <> #")"
			c <> #"{"
			c <> #"}"
			c <> #";"
		]
	]

	#define NOT_FILE_DELIMITER?(c) [
		all [
			c <> null-byte
			c <> #" "
			c <> #"^/"
			c <> #"^M"
			c <> #"^-"
			c <> #":"
			c <> #"^""
			c <> #"["
			c <> #"]"
			c <> #"("
			c <> #")"
			c <> #"{"
			c <> #"}"
			c <> #";"
		]
	]

	#enum errors! [
		ERR_PREMATURE_END
		ERR_BLOCK_END
		ERR_PAREN_END
		ERR_STRING_DELIMIT
		ERR_MULTI_STRING_DELIMIT
		ERR_CHAR_DELIMIT
		ERR_INVALID_INTEGER
		ERR_INVALID_PATH
		ERR_INVALID_CHAR
	]

	throw-error: func [id [integer!]][
		print "*** Load Error: "
		print switch id [
			ERR_PREMATURE_END		 ["unmatched closing ] or )"]
			ERR_BLOCK_END			 ["unmatched ] closing bracket"]
			ERR_PAREN_END			 ["unmatched ) closing paren"]
			ERR_STRING_DELIMIT 		 [{string ending delimiter " not found}]
			ERR_MULTI_STRING_DELIMIT ["string ending delimiter } not found"]
			ERR_CHAR_DELIMIT		 [{char ending delimiter " not found}]
			ERR_INVALID_INTEGER		 ["invalid integer"]
			ERR_INVALID_PATH		 ["invalid path"]
			ERR_INVALID_CHAR		 ["invalid char"]
		]
		print-line #"!"
	]

	preprocess: func [
		str [red-string!]
		/local
			src	 [byte-ptr!]
			tail [byte-ptr!]
			dst	 [byte-ptr!]
			s	 [series!]
			c	 [byte!]
	][
		s: 		GET_BUFFER(str)
		src:	string/rs-head str
		tail:   string/rs-tail str
		dst:	src

		while [src < tail][
			either src/1 = #"^^" [
				src: src + 1
				c: src/1
				dst/1: switch c [
					#"-"	[#"^-"]
					#"/"	[#"^/"]
					#"^""	[#"^""]
					#"^^"	[#"^^"]
					#"{"	[#"{"]
					#"}"	[#"}"]
					default [src/1 - #"@"]
				]
			][
				if dst <> src [dst/1: src/1]
			]
			src: src + 1
			dst: dst + 1
		]
		dst/1: null-byte
		s/tail:	as red-value! dst
	]

	skip-spaces: func [
		src		[c-string!]
		return: [c-string!]
		/local
			c	[byte!]
	][
		while [
			c: src/1
			any [
				c = #" "
				c = #"^/"
				c = #"^M"
				c = #"^-"
			]
		][
			if c = null-byte [return src]
			src: src + 1
		]
		src
	]

	scan-comment: func [
		s		[c-string!]
		return: [c-string!]
	][
		while [not any [s/1 = #"^/" s/1 = null-byte]][s: s + 1]
		s
	]

	scan-char: func [
		s		[c-string!]
		blk		[red-block!]
		return: [c-string!]
		/local
			c	 [byte!]
			byte [byte!]
	][
		byte: either s/1 = #"^^" [
			s: s + 1
			c: s/1
			either all [#"@" <= c c <= #"Z"][
				c - #"@"
			][
				switch c [
					#"^"" [#"^""]
					#"/"  [#"^/"]
					#"-"  [#"^-"]
					#"?"  [#"^~"]
					#"^^" [#"^^"]
					default [throw-error ERR_INVALID_CHAR]
				]
			]
		][
			s/1
		]
		s: s + 1
		if s/1 <> #"^"" [throw-error ERR_CHAR_DELIMIT]

		char/load-in as-integer byte blk
		s + 1
	]

	scan-string-multi: func [
		s		[c-string!]
		blk		[red-block!]
		return: [c-string!]
		/local
			e	  [c-string!]
			c	  [byte!]
			saved [byte!]
			count [integer!]
	][
		s: s + 1										;-- skip opening brace
		e: s
		c: e/1
		count: 1

		while [all [c <> null-byte count > 0]][
			while [all [c <> null-byte c <> #"}"]][
				if c = #"{" [count: count + 1]
				e: e + either c = #"^^" [2][1]
				c: e/1
			]
			if c = #"}" [
				count: count - 1
				e: e + 1
				c: e/1
			]
		]
		e: e - 1
		c: e/1

		if c <> #"}" [throw-error ERR_MULTI_STRING_DELIMIT return e + 1]
		saved: e/1										;@@ allocate a new buffer instead
		e/1: null-byte
		preprocess string/load-in s (as-integer e - s) + 1 blk
		e/1: saved
		either c = #"}" [e + 1][e]
	]

	scan-string: func [
		s		[c-string!]
		blk		[red-block!]
		return: [c-string!]
		/local
			e	  [c-string!]
			c	  [byte!]
			saved [byte!]
	][
		s: s + 1										;-- skip first double quote
		e: s
		c: e/1

		while [all [c <> null-byte c <> #"^""]][
			e: e + either c = #"^^" [2][1]
			c: e/1
		]
		if c <> #"^"" [throw-error ERR_STRING_DELIMIT]
		saved: e/1										;@@ allocate a new buffer instead
		e/1: null-byte
		preprocess string/load-in s (as-integer e - s) + 1 blk
		e/1: saved
		either c = #"^"" [e + 1][e]
	]

	scan-file: func [
		s		[c-string!]
		blk		[red-block!]
		return: [c-string!]
		/local
			e	  [c-string!]
			c	  [byte!]
			saved [byte!]
	][
		s: s + 1										;-- skip first double quote
		e: s
		c: e/1

		while [NOT_FILE_DELIMITER?(c)][
			e: e + 1
			c: e/1
		]
		saved: e/1										;@@ allocate a new buffer instead
		e/1: null-byte
		file/load-in s (as-integer e - s) + 1 blk
		e/1: saved
		e
	]

	scan-integer: func [
		s		 [c-string!]
		blk		 [red-block!]
		neg?	 [logic!]
		return:  [c-string!]
		/local
			e	 [c-string!]
			c	 [byte!]
			i	 [integer!]
	][
		e: s
		c: e/1
		i: 0

		while [
			all [c <> null-byte #"0" <= c c <= #"9"]
		][
			i: i * 10
			i: i + (c - #"0")
			e: e + 1
			c: e/1
		]
		if neg? [i: 0 - i]
		integer/load-in blk i
		e
	]

	scan-minus: func [
		src		[c-string!]
		blk		[red-block!]
		return:	[c-string!]
		/local
			c	[byte!]
	][
		c: src/2
		either all [#"0" <= c c <= #"9"][
			scan-integer src + 1 blk yes
		][
			scan-word src blk TYPE_WORD no
		]
	]

	scan-word: func [
		s		  [c-string!]
		blk		  [red-block!]
		type	  [integer!]
		in-path?  [logic!]
		return:   [c-string!]
		/local
			e	  [c-string!]
			c	  [byte!]
			saved [byte!]
			set?  [logic!]
			path? [logic!]
	][
		e: s + 1
		c: e/1

		while [NOT_DELIMITER?(c)][
			e: e + 1
			c: e/1
		]
		set?:  all [e/1 = #":"  not in-path?]
		path?: all [e/1 = slash not in-path?]

		if all [
			type = TYPE_REFINEMENT
			s + 1 = e
		][
			type: TYPE_WORD								;-- / as word case
		]

		either path? [
			return scan-path s e blk type = TYPE_LIT_WORD
		][
			saved: e/1										;@@ allocate a new buffer instead
			e/1: null-byte
			case [
				type = TYPE_GET_WORD	[get-word/load-in s blk]
				type = TYPE_LIT_WORD	[lit-word/load-in s blk]
				type = TYPE_ISSUE		[issue/load-in s blk]
				type = TYPE_REFINEMENT	[refinement/load-in s + 1 blk]
				set?				 	[set-word/load-in s blk]
				true				 	[word/load-in s blk]
			]
			e/1: saved
			return either set? [e + 1][e]
		]
	]

	scan-path: func [
		s		 [c-string!]
		src		 [c-string!]
		blk		 [red-block!]
		lit?	 [logic!]
		return:  [c-string!]
		/local
			path  [red-block!]
			saved [byte!]
			set?  [logic!]
	][
		path: block/make-in blk 4						;-- arbitrary start size

		saved: src/1									;-- push first element
		src/1: null-byte
		word/load-in s path								;-- store undecorated word
		src/1: saved
		c: src/1
		set?: no

		while [c = #"/"][
			src: src + 1
			c: src/1
			case [
				c = #"("  [src: scan-paren src + 1 path]
				c = #":"  [src: scan-word src + 1 path TYPE_GET_WORD yes]
				c = #"-"  [src: scan-minus src path]
				all [#"0" <= c c <= #"9"][src: scan-integer src path no]
				all [#" " <  c c <= #""][src: scan-word src path TYPE_WORD yes]
				yes [throw-error ERR_INVALID_PATH]
			]
			c: src/1
			if c = #":" [set?: yes]
		]

		path/header: case [
			set? [TYPE_SET_PATH]
			lit? [TYPE_LIT_PATH]
			true [TYPE_PATH]
		]
		either set? [src + 1][src]
	]

	scan-block: func [
		src		[c-string!]
		blk		[red-block!]
		return: [c-string!]
	][
		src: scan src block/make-in blk 4				;-- arbitrary start size
		if src/1 <> #"]" [throw-error ERR_PREMATURE_END]
		src + 1											;-- skip ] character
	]

	scan-paren: func [
		src		 [c-string!]
		blk		 [red-block!]
		return:  [c-string!]
		/local
			s	 [series!]
			slot [red-value!]
	][
		src: scan src block/make-in blk 4				;-- arbitrary start size
		if src/1 <> #")" [throw-error ERR_PAREN_END]
		s: GET_BUFFER(blk)
		slot: s/tail - 1
		slot/header: TYPE_PAREN
		src + 1											;-- skip ) character

	]

	scan: func [
		src		  [c-string!]
		parent	  [red-block!]
		return:	  [c-string!]
		/local
			blk	  [red-block!]
			start [c-string!]
			end	  [c-string!]
			c	  [byte!]
	][
		blk: either null? parent [
			block/push* 4								;-- arbitrary start size
		][
			parent
		]

		while [
			src: skip-spaces src
			c: src/1
			all [
				c <> null-byte
				c <> #"]"
				c <> #")"
			]
		][
			case [
				c = #";"  [src: scan-comment src]
				c = #"-"  [src: scan-minus src blk]
				c = #"^"" [src: scan-string src blk]
				c = #"{"  [src: scan-string-multi src blk]
				c = #"%"  [src: scan-file src blk]
				c = #"["  [src: scan-block src + 1 blk]
				c = #"("  [src: scan-paren src + 1 blk]
				c = #":"  [src: scan-word src + 1 blk TYPE_GET_WORD no]
				c = #"'"  [src: scan-word src + 1 blk TYPE_LIT_WORD no]
				c = #"/"  [src: scan-word src blk TYPE_REFINEMENT no]
				c = #"#"  [
					c: src/2
					either c = #"^"" [
						src: scan-char src + 2 blk
					][
						src: scan-word src + 1 blk TYPE_ISSUE no
					]
				]
				all [#"0" <= c c <= #"9"][src: scan-integer src blk no]
				all [#" " <  c c <= #""][src: scan-word src blk TYPE_WORD no]
			]
		]
		if null? parent [
			if src/1 <> null-byte [throw-error ERR_PREMATURE_END]
			stack/set-last as red-value! blk
		]
		src
	]

]

Red/System [
	Title:   "Red data loader"
	Author:  "Nenad Rakocevic"
	File: 	 %tokenizer.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2012 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

tokenizer: context [

	#define NOT_DELIMITER?(c) [
		all [
			c <> null-byte
			c <> #" "
			c <> #"/"
			c <> #"^/"
			c <> #"^M"
			c <> #"^-"
			c <> #":"
			c <> #"^""
			c <> #"["
			c <> #"]"
			c <> #"("
			c <> #")"
			c <> #"{"
			c <> #"}"
			c <> #";"
		]
	]

	#define NOT_FILE_DELIMITER?(c) [
		all [
			c <> null-byte
			c <> #" "
			c <> #"^/"
			c <> #"^M"
			c <> #"^-"
			c <> #":"
			c <> #"^""
			c <> #"["
			c <> #"]"
			c <> #"("
			c <> #")"
			c <> #"{"
			c <> #"}"
			c <> #";"
		]
	]

	#enum errors! [
		ERR_PREMATURE_END
		ERR_PAREN_END
		ERR_STRING_DELIMIT
		ERR_MULTI_STRING_DELIMIT
		ERR_CHAR_DELIMIT
		ERR_INVALID_INTEGER
		ERR_INVALID_PATH
		ERR_INVALID_CHAR
	]

	throw-error: func [id [integer!]][
		print "*** Load Error: "
		print switch id [
			ERR_PREMATURE_END		 ["unmatched ] closing bracket"]
			ERR_PAREN_END			 ["unmatched ) closing paren"]
			ERR_STRING_DELIMIT 		 [{string ending delimiter " not found}]
			ERR_MULTI_STRING_DELIMIT ["string ending delimiter } not found"]
			ERR_CHAR_DELIMIT		 [{char ending delimiter " not found}]
			ERR_INVALID_INTEGER		 ["invalid integer"]
			ERR_INVALID_PATH		 ["invalid path"]
			ERR_INVALID_CHAR		 ["invalid char"]
		]
		print-line #"!"
	]

	preprocess: func [
		str [red-string!]
		/local
			src	 [byte-ptr!]
			tail [byte-ptr!]
			dst	 [byte-ptr!]
			s	 [series!]
			c	 [byte!]
	][
		s: 		GET_BUFFER(str)
		src:	string/rs-head str
		tail:   string/rs-tail str
		dst:	src

		while [src < tail][
			either src/1 = #"^^" [
				src: src + 1
				c: src/1
				dst/1: switch c [
					#"-"	[#"^-"]
					#"/"	[#"^/"]
					#"^""	[#"^""]
					#"^^"	[#"^^"]
					#"{"	[#"{"]
					#"}"	[#"}"]
					default [src/1 - #"@"]
				]
			][
				if dst <> src [dst/1: src/1]
			]
			src: src + 1
			dst: dst + 1
		]
		dst/1: null-byte
		s/tail:	as red-value! dst
	]

	skip-spaces: func [
		src		[c-string!]
		return: [c-string!]
		/local
			c	[byte!]
	][
		while [
			c: src/1
			any [
				c = #" "
				c = #"^/"
				c = #"^M"
				c = #"^-"
			]
		][
			if c = null-byte [return src]
			src: src + 1
		]
		src
	]

	scan-comment: func [
		s		[c-string!]
		return: [c-string!]
	][
		while [not any [s/1 = #"^/" s/1 = null-byte]][s: s + 1]
		s
	]

	scan-char: func [
		s		[c-string!]
		blk		[red-block!]
		return: [c-string!]
		/local
			c	 [byte!]
			byte [byte!]
	][
		byte: either s/1 = #"^^" [
			s: s + 1
			c: s/1
			either all [#"@" <= c c <= #"Z"][
				c - #"@"
			][
				switch c [
					#"^"" [#"^""]
					#"/"  [#"^/"]
					#"-"  [#"^-"]
					#"?"  [#"^~"]
					#"^^" [#"^^"]
					default [throw-error ERR_INVALID_CHAR]
				]
			]
		][
			s/1
		]
		s: s + 1
		if s/1 <> #"^"" [throw-error ERR_CHAR_DELIMIT]

		char/load-in as-integer byte blk
		s + 1
	]

	scan-string-multi: func [
		s		[c-string!]
		blk		[red-block!]
		return: [c-string!]
		/local
			e	  [c-string!]
			c	  [byte!]
			saved [byte!]
			count [integer!]
	][
		s: s + 1										;-- skip opening brace
		e: s
		c: e/1
		count: 1

		while [all [c <> null-byte count > 0]][
			while [all [c <> null-byte c <> #"}"]][
				if c = #"{" [count: count + 1]
				e: e + either c = #"^^" [2][1]
				c: e/1
			]
			if c = #"}" [
				count: count - 1
				e: e + 1
				c: e/1
			]
		]
		e: e - 1
		c: e/1

		if c <> #"}" [throw-error ERR_MULTI_STRING_DELIMIT return e + 1]
		saved: e/1										;@@ allocate a new buffer instead
		e/1: null-byte
		preprocess string/load-in s (as-integer e - s) + 1 blk
		e/1: saved
		either c = #"}" [e + 1][e]
	]

	scan-string: func [
		s		[c-string!]
		blk		[red-block!]
		return: [c-string!]
		/local
			e	  [c-string!]
			c	  [byte!]
			saved [byte!]
	][
		s: s + 1										;-- skip first double quote
		e: s
		c: e/1

		while [all [c <> null-byte c <> #"^""]][
			e: e + either c = #"^^" [2][1]
			c: e/1
		]
		if c <> #"^"" [throw-error ERR_STRING_DELIMIT]
		saved: e/1										;@@ allocate a new buffer instead
		e/1: null-byte
		preprocess string/load-in s (as-integer e - s) + 1 blk
		e/1: saved
		either c = #"^"" [e + 1][e]
	]

	scan-file: func [
		s		[c-string!]
		blk		[red-block!]
		return: [c-string!]
		/local
			e	  [c-string!]
			c	  [byte!]
			saved [byte!]
	][
		s: s + 1										;-- skip first double quote
		e: s
		c: e/1

		while [NOT_FILE_DELIMITER?(c)][
			e: e + 1
			c: e/1
		]
		saved: e/1										;@@ allocate a new buffer instead
		e/1: null-byte
		file/load-in s (as-integer e - s) + 1 blk
		e/1: saved
		e
	]

	scan-integer: func [
		s		 [c-string!]
		blk		 [red-block!]
		neg?	 [logic!]
		return:  [c-string!]
		/local
			e	 [c-string!]
			c	 [byte!]
			i	 [integer!]
	][
		e: s
		c: e/1
		i: 0

		while [
			all [c <> null-byte #"0" <= c c <= #"9"]
		][
			i: i * 10
			i: i + (c - #"0")
			e: e + 1
			c: e/1
		]
		if neg? [i: 0 - i]
		integer/load-in blk i
		e
	]

	scan-minus: func [
		src		[c-string!]
		blk		[red-block!]
		return:	[c-string!]
		/local
			c	[byte!]
	][
		c: src/2
		either all [#"0" <= c c <= #"9"][
			scan-integer src + 1 blk yes
		][
			scan-word src blk TYPE_WORD no
		]
	]

	scan-word: func [
		s		  [c-string!]
		blk		  [red-block!]
		type	  [integer!]
		in-path?  [logic!]
		return:   [c-string!]
		/local
			e	  [c-string!]
			c	  [byte!]
			saved [byte!]
			set?  [logic!]
			path? [logic!]
	][
		e: s + 1
		c: e/1

		while [NOT_DELIMITER?(c)][
			e: e + 1
			c: e/1
		]
		set?:  all [e/1 = #":"  not in-path?]
		path?: all [e/1 = slash not in-path?]

		if all [
			type = TYPE_REFINEMENT
			s + 1 = e
		][
			type: TYPE_WORD								;-- / as word case
		]

		either path? [
			return scan-path s e blk type = TYPE_LIT_WORD
		][
			saved: e/1										;@@ allocate a new buffer instead
			e/1: null-byte
			case [
				type = TYPE_GET_WORD	[get-word/load-in s blk]
				type = TYPE_LIT_WORD	[lit-word/load-in s blk]
				type = TYPE_ISSUE		[issue/load-in s blk]
				type = TYPE_REFINEMENT	[refinement/load-in s + 1 blk]
				set?				 	[set-word/load-in s blk]
				true				 	[word/load-in s blk]
			]
			e/1: saved
			return either set? [e + 1][e]
		]
	]

	scan-path: func [
		s		 [c-string!]
		src		 [c-string!]
		blk		 [red-block!]
		lit?	 [logic!]
		return:  [c-string!]
		/local
			path  [red-block!]
			saved [byte!]
			set?  [logic!]
	][
		path: block/make-in blk 4						;-- arbitrary start size

		saved: src/1									;-- push first element
		src/1: null-byte
		word/load-in s path								;-- store undecorated word
		src/1: saved
		c: src/1
		set?: no

		while [c = #"/"][
			src: src + 1
			c: src/1
			case [
				c = #"("  [src: scan-paren src + 1 path]
				c = #":"  [src: scan-word src + 1 path TYPE_GET_WORD yes]
				c = #"-"  [src: scan-minus src path]
				all [#"0" <= c c <= #"9"][src: scan-integer src path no]
				all [#" " <  c c <= #""][src: scan-word src path TYPE_WORD yes]
				yes [throw-error ERR_INVALID_PATH]
			]
			c: src/1
			if c = #":" [set?: yes]
		]

		path/header: case [
			set? [TYPE_SET_PATH]
			lit? [TYPE_LIT_PATH]
			true [TYPE_PATH]
		]
		either set? [src + 1][src]
	]

	scan-block: func [
		src		[c-string!]
		blk		[red-block!]
		return: [c-string!]
	][
		src: scan src block/make-in blk 4				;-- arbitrary start size
		if src/1 <> #"]" [throw-error ERR_PREMATURE_END]
		src + 1											;-- skip ] character
	]

	scan-paren: func [
		src		 [c-string!]
		blk		 [red-block!]
		return:  [c-string!]
		/local
			s	 [series!]
			slot [red-value!]
	][
		src: scan src block/make-in blk 4				;-- arbitrary start size
		if src/1 <> #")" [throw-error ERR_PREMATURE_END]
		s: GET_BUFFER(blk)
		slot: s/tail - 1
		slot/header: TYPE_PAREN
		src + 1											;-- skip ) character

	]

	scan: func [
		src		  [c-string!]
		parent	  [red-block!]
		return:	  [c-string!]
		/local
			blk	  [red-block!]
			start [c-string!]
			end	  [c-string!]
			c	  [byte!]
	][
		blk: either null? parent [
			block/push* 4								;-- arbitrary start size
		][
			parent
		]

		while [
			src: skip-spaces src
			c: src/1
			all [
				c <> null-byte
				c <> #"]"
				c <> #")"
			]
		][
			case [
				c = #";"  [src: scan-comment src]
				c = #"-"  [src: scan-minus src blk]
				c = #"^"" [src: scan-string src blk]
				c = #"{"  [src: scan-string-multi src blk]
				c = #"%"  [src: scan-file src blk]
				c = #"["  [src: scan-block src + 1 blk]
				c = #"("  [src: scan-paren src + 1 blk]
				c = #":"  [src: scan-word src + 1 blk TYPE_GET_WORD no]
				c = #"'"  [src: scan-word src + 1 blk TYPE_LIT_WORD no]
				c = #"/"  [src: scan-word src blk TYPE_REFINEMENT no]
				c = #"#"  [
					c: src/2
					either c = #"^"" [
						src: scan-char src + 2 blk
					][
						src: scan-word src + 1 blk TYPE_ISSUE no
					]
				]
				all [#"0" <= c c <= #"9"][src: scan-integer src blk no]
				all [#" " <  c c <= #""][src: scan-word src blk TYPE_WORD no]
			]
		]
		if null? parent [
			if src/1 <> null-byte [throw-error ERR_PREMATURE_END]
			stack/set-last as red-value! blk
		]
		src
	]

]