TESTS: additional Red series tests

TESTS: additional Red series tests

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

;; counters
qt-run-tests: 0
qt-run-asserts: 0
qt-run-passes: 0
qt-run-failures: 0
qt-file-tests: 0
qt-file-asserts: 0
qt-file-passes: 0
qt-file-failures: 0

;; group switches
qt-group-name-not-printed: true
qt-group?: false

_qt-init-group: func [] [
  qt-group-name-not-printed: true
  qt-group?: false
  qt-group-name: ""
]

qt-init-run: func [] [
  qt-run-tests: 0
  qt-run-asserts: 0
  qt-run-passes: 0
  qt-run-failures: 0
  _qt-init-group
]

qt-init-file: func [] [
  qt-file-tests: 0
  qt-file-asserts: 0
  qt-file-passes: 0
  qt-file-failures: 0
  _qt-init-group
]

***start-run***: func[
    title [string!]
][
  qt-init-run
  qt-run-name: title
  prin "***Starting*** "
  print title
]

~~~start-file~~~: func [
  title [string!]
][
  qt-init-file
  prin "~~~started test~~~ "
  print title
  qt-file-name: title
  qt-group?: false
]

===start-group===: func [
  title [string!]
][
  qt-group-name: title
  qt-group?: true
]

--test--: func [
  title [string!]
][
  qt-test-name: title
  qt-file-tests: qt-file-tests + 1
]

--assert: func [
  assertion [logic!]
][

  qt-file-asserts: qt-file-asserts + 1

  either assertion [
     qt-file-passes: qt-file-passes + 1
  ][
    qt-file-failures: qt-file-failures + 1
    if qt-group? [
      if qt-group-name-not-printed [
        prin "===group=== "
        print qt-group-name
        qt-group-name-not-printed: false
      ]
    ]
    prin "--test-- "
    prin qt-test-name
    print " FAILED**************"
  ]
]

===end-group===: func [] [
  _qt-init-group
]

qt-print-totals: func [
  tests     [integer!]
  asserts   [integer!]
  passes    [integer!]
  failures  [integer!]
][
  prin  "  Number of Tests Performed:      "
  print tests
  prin  "  Number of Assertions Performed: "
  print asserts
  prin  "  Number of Assertions Passed:    "
  print passes
  prin  "  Number of Assertions Failed:    "
  print failures
  if failures <> 0 [
    print "****************TEST FAILURES****************"
  ]
]

~~~end-file~~~: func [] [
  print ""
  prin "~~~finished test~~~ "
  print qt-file-name
  qt-print-totals qt-file-tests qt-file-asserts qt-file-passes qt-file-failures
  print ""

  ;; update run totals
  qt-run-passes: qt-run-passes + qt-file-passes
  qt-run-asserts: qt-run-asserts + qt-file-asserts
  qt-run-failures: qt-run-failures + qt-file-failures
  qt-run-tests: qt-run-tests + qt-file-tests
]

***end-run***: func [][
  prin "***Finished*** "
  print qt-run-name
  qt-print-totals qt-run-tests
                  qt-run-asserts
                  qt-run-passes
                  qt-run-failures
]

~~~start-file~~~ "series"

===start-group=== "first, second, third, fourth, fifth"

	--test-- "series-fstff-1"
	  sf1-ser:  [1 2 3 4 5]
	--assert 1 = first sf1-ser
	--assert 2 = second sf1-ser
	--assert 3 = third sf1-ser
	--assert 4 = fourth sf1-ser
	--assert 5 = fifth sf1-ser
	--assert 5 = last sf1-ser

	--test-- "series-fstff-2"
	  sf2-ser:  [1 2 3 4 5]
	--assert 2 = first next sf2-ser

	--test-- "series-fstff-3"
	  sf3-ser:  "12345"
	--assert 49 = first sf3-ser
	--assert 53 = last sf3-ser

	--test-- "series-fstff-4"
	  sf4-ser:  [1 2 3 4 5]
	--assert none = fifth next sf4-ser

	--test-- "series-fstff-5"
	  sf5-ser:  "12345"
	--assert 53 = fifth sf5-ser

	--test-- "series-fstff-6"
	  stf6-ser: #{000102}
	;;--assert 0 = first stf6-ser

	--test-- "series-fstff-7"
	--assert 'a = first [a b c d]

	--test-- "series-fstff-8"
	--assert 'a = first first first first first first first first first [[[[[[[[[a]]]]]]]]]

===end-group===

===start-group=== "next"
  --test-- "series-next-1"
  --assert 2 = first next [1 2 3 4 5]
  --test-- "series-next-2"
  --assert 3 = first next next [1 2 3 4 5]
  --test-- "series-next-3"
  --assert 4 = first next next next [1 2 3 4 5]
  --test-- "series-next-4"
  --assert 5 = first next next next next [1 2 3 4 5]
  --test-- "series-next-5"
  --assert none = first next next next next next [1 2 3 4 5]
  --test-- "series-next-6"
  --assert 50 = first next "12345"
  --test-- "series-next-7"
  --assert 51 = first next next "12345"
  --test-- "series-next-8"
  --assert 52 = first next next next "12345"
  --test-- "series-next-9"
  --assert 53 = first next next next next "12345"
  --test-- "series-next-10"
  --assert none = first next next next next next "12345"
===end-group===

===start-group=== "back"
--test-- "series-back-1"
  --assert 1 = first back next [1 2 3 4 5]
  --test-- "series-back-2"
  --assert 1 = first back back next next [1 2 3 4 5]
  --test-- "series-back-3"
  --assert 1 = first back back back next next next [1 2 3 4 5]
  --test-- "series-back-4"
  --assert 1 = first back back back back next next next next [1 2 3 4 5]
  --test-- "series-back-5"
  --assert 1 = first back back back back back next next next next next [1 2 3 4 5]
  --test-- "series-back-6"
  --assert 49 = first back next "12345"
  --test-- "series-back-7"
  --assert 50 = first back next next "12345"
  --test-- "series-back-8"
  --assert 51 = first back next next next "12345"
  --test-- "series-back-9"
  --assert 52 = first back next next next next "12345"
  --test-- "series-back-10"
  --assert 53 = first back next next next next next "12345"
  --test-- "series-back-11"
  --assert 49 = first back "12345"
===end-group===

===start-group=== "tail"
  --test-- "series-tail-1"
  --assert 5 = first back tail [1 2 3 4 5]
  --test-- "seried-tail-2"
  --assert none = pick tail [1 2 3 4 5] 1
===end-group===

===start-group=== "pick"

  --test-- "series-pick-1"
  --assert none = pick "" 1

  --test-- "series-pick-2"
  --assert none = pick "" 0

  --test-- "series-pick-3"
  --assert none = pick "" 2

  --test-- "series-pick-4"
  --assert 49 = pick "12345" 1

  --test-- "series-pick-5"
  --assert 53 = pick "12345" 5

  --test-- "series-pick-6"
  --assert 1 = pick [1 2 3 4 5] 1

  --test-- "series-pick-7"
  --assert 2 = pick [1 2 3 4 5] 2

  --test-- "series-pick-8"
  --assert 4 = pick [1 2 3 4 5] 4

  --test-- "series-pick-9"
  --assert 5 = pick [1 2 3 4 5] 5

  --test-- "series-pick-10"
  --assert 2 = pick next next next [1 2 3 4 5] -2

  --test-- "series-pick-11"
  --assert 3 = pick next next next [1 2 3 4 5] -1

  --test-- "series-pick-12"
  --assert none = pick next next next [1 2 3 4 5] 0

  --test-- "series-pick-13"
  --assert none = pick "12345" -1

  --test-- "series-pick-14"
    sp14-i: 1
  --assert 1 = pick [1 2 3 4 5] sp14-i

  --test-- "series-pick-15"
    sp15-i: 4
  --assert 4 = pick [1 2 3 4 5] sp15-i

  --test-- "series-pick-16"
    sp16-i: -2
  --assert 2 = pick next next next [1 2 3 4 5] sp16-i

  --test-- "series-pick-17"
    sp17-i: 0
  --assert none = pick next next next [1 2 3 4 5] sp17-i

  --test-- "series-pick-18"
    sp18-i: -1
  --assert none = pick "12345" sp18-i

===end-group===

===start-group=== "select"
  --test-- "series-select-1"
  ;--assert 2 = select [1 2 3 4 5] 1
===end-group===

===start-group=== "append"
  --test-- "series-append-1"
  --assert 6 = last append [1 2 3 4 5] 6
  --test-- "series-append-2"
  --assert 6 = last append [1 2 3 4] [5 6]
  --assert 4 = fourth append [1 2 3 4] [5 6]
  --assert 5 = fifth append [1 2 3 4] [5 6]
  --test-- "series-append-3"
  --assert 55 = last append "12345" "67"
  --test-- "series-append-4"
  --assert 233 = last append "abcde" "é" ;; utf-8 C3 A9
  --test-- "series-append-5"
  --assert 49 = last append "abcdeé" "1" ;; utf-8 C3 A9
  --test-- "series-append-6"
  --assert 10000 = last append "abcde" "✐"
  --test-- "series-append-7"
  --assert 48 = last append "abcde^(2710)" "0"
  --test-- "series-append-8"
  --assert 10000 = last append "abcdeé" "^(2710)"
  --test-- "series-append-9"
  --assert 233 = last append "abcde^(2710)" "é"
  --test-- "series-append-10"
  --assert 65536 = last append "abcde" "^(010000)"
  --test-- "series-append-11"
  --assert 48 = last append "abcde^(010000)" "0"
  --test-- "series=append-12"
  --assert 65536 = last append "abcde^(2710)é" "^(010000)"

===end-group===

===start-group=== "series-equal"

  --test-- "series-equal-1"
  --assert [] = []

  --test-- "series-equal-2"
    se2-b: []
  --assert [] = se2-b

  --test-- "series-equal-3"
    se3-b: []
  --assert se3-b = []

  --test-- "series-equal-4"
    se4-b: [1]
  --assert se4-b = [1]

  --test-- "series-equal-5"
    se5-b: ["abcde"]
  --assert se5-b = ["abcde"]

===end-group===

===start-group=== "series-find"

  --test-- "series-find-1"
  --assert 3 = first find [1 2 3 4 5] 3

  --test-- "series-find-2"
  --assert 'a = first find [a b c d e] 'a

  --test-- "series-find-3"
  --assert 'e = first find [a b c d e] 'e

  --test-- "series-find-4"
  --assert none = find [] 'a

  --test-- "series-find-5"
  --assert none = find [1 2 3 4] 'a

  --test-- "series-find-6"
  --assert none = find next [a b c d e] 'a

===end-group===

~~~end-file~~~

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

;; counters
qt-run-tests: 0
qt-run-asserts: 0
qt-run-passes: 0
qt-run-failures: 0
qt-file-tests: 0
qt-file-asserts: 0
qt-file-passes: 0
qt-file-failures: 0

;; group switches
qt-group-name-not-printed: true
qt-group?: false

_qt-init-group: func [] [
  qt-group-name-not-printed: true
  qt-group?: false
  qt-group-name: ""
]

qt-init-run: func [] [
  qt-run-tests: 0
  qt-run-asserts: 0
  qt-run-passes: 0
  qt-run-failures: 0
  _qt-init-group
]

qt-init-file: func [] [
  qt-file-tests: 0
  qt-file-asserts: 0
  qt-file-passes: 0
  qt-file-failures: 0
  _qt-init-group
]

***start-run***: func[
    title [string!]
][
  qt-init-run
  qt-run-name: title
  prin "***Starting*** "
  print title
]

~~~start-file~~~: func [
  title [string!]
][
  qt-init-file
  prin "~~~started test~~~ "
  print title
  qt-file-name: title
  qt-group?: false
]

===start-group===: func [
  title [string!]
][
  qt-group-name: title
  qt-group?: true
]

--test--: func [
  title [string!]
][
  qt-test-name: title
  qt-file-tests: qt-file-tests + 1
]

--assert: func [
  assertion [logic!]
][

  qt-file-asserts: qt-file-asserts + 1

  either assertion [
     qt-file-passes: qt-file-passes + 1
  ][
    qt-file-failures: qt-file-failures + 1
    if qt-group? [
      if qt-group-name-not-printed [
        prin "===group=== "
        print qt-group-name
        qt-group-name-not-printed: false
      ]
    ]
    prin "--test-- "
    prin qt-test-name
    print " FAILED**************"
  ]
]

===end-group===: func [] [
  _qt-init-group
]

qt-print-totals: func [
  tests     [integer!]
  asserts   [integer!]
  passes    [integer!]
  failures  [integer!]
][
  prin  "  Number of Tests Performed:      "
  print tests
  prin  "  Number of Assertions Performed: "
  print asserts
  prin  "  Number of Assertions Passed:    "
  print passes
  prin  "  Number of Assertions Failed:    "
  print failures
  if failures <> 0 [
    print "****************TEST FAILURES****************"
  ]
]

~~~end-file~~~: func [] [
  print ""
  prin "~~~finished test~~~ "
  print qt-file-name
  qt-print-totals qt-file-tests qt-file-asserts qt-file-passes qt-file-failures
  print ""

  ;; update run totals
  qt-run-passes: qt-run-passes + qt-file-passes
  qt-run-asserts: qt-run-asserts + qt-file-asserts
  qt-run-failures: qt-run-failures + qt-file-failures
  qt-run-tests: qt-run-tests + qt-file-tests
]

***end-run***: func [][
  prin "***Finished*** "
  print qt-run-name
  qt-print-totals qt-run-tests
                  qt-run-asserts
                  qt-run-passes
                  qt-run-failures
]

~~~start-file~~~ "series"

===start-group=== "first, second, third, fourth, fifth"

	--test-- "series-fstff-1"
	  sf1-ser:  [1 2 3 4 5]
	--assert 1 = first sf1-ser
	--assert 2 = second sf1-ser
	--assert 3 = third sf1-ser
	--assert 4 = fourth sf1-ser
	--assert 5 = fifth sf1-ser
	--assert 5 = last sf1-ser

	--test-- "series-fstff-2"
	  sf2-ser:  [1 2 3 4 5]
	--assert 2 = first next sf2-ser

	--test-- "series-fstff-3"
	  sf3-ser:  "12345"
	--assert 49 = first sf3-ser
	--assert 53 = last sf3-ser

	--test-- "series-fstff-4"
	  sf4-ser:  [1 2 3 4 5]
	--assert none = fifth next sf4-ser

	--test-- "series-fstff-5"
	  sf5-ser:  "12345"
	--assert 53 = fifth sf5-ser

	--test-- "series-fstff-6"
	  stf6-ser: #{000102}
	;;--assert 0 = first stf6-ser

	--test-- "series-fstff-7"
	--assert 'a = first [a b c d]

	--test-- "series-fstff-8"
	--assert 'a = first first first first first first first first first [[[[[[[[[a]]]]]]]]]

===end-group===

===start-group=== "next"
  --test-- "series-next-1"
  --assert 2 = first next [1 2 3 4 5]
  --test-- "series-next-2"
  --assert 3 = first next next [1 2 3 4 5]
  --test-- "series-next-3"
  --assert 4 = first next next next [1 2 3 4 5]
  --test-- "series-next-4"
  --assert 5 = first next next next next [1 2 3 4 5]
  --test-- "series-next-5"
  --assert none = first next next next next next [1 2 3 4 5]
  --test-- "series-next-6"
  --assert 50 = first next "12345"
  --test-- "series-next-7"
  --assert 51 = first next next "12345"
  --test-- "series-next-8"
  --assert 52 = first next next next "12345"
  --test-- "series-next-9"
  --assert 53 = first next next next next "12345"
  --test-- "series-next-10"
  --assert none = first next next next next next "12345"
===end-group===

===start-group=== "back"
--test-- "series-back-1"
  --assert 1 = first back next [1 2 3 4 5]
  --test-- "series-back-2"
  --assert 1 = first back back next next [1 2 3 4 5]
  --test-- "series-back-3"
  --assert 1 = first back back back next next next [1 2 3 4 5]
  --test-- "series-back-4"
  --assert 1 = first back back back back next next next next [1 2 3 4 5]
  --test-- "series-back-5"
  --assert 1 = first back back back back back next next next next next [1 2 3 4 5]
  --test-- "series-back-6"
  --assert 49 = first back next "12345"
  --test-- "series-back-7"
  --assert 50 = first back next next "12345"
  --test-- "series-back-8"
  --assert 51 = first back next next next "12345"
  --test-- "series-back-9"
  --assert 52 = first back next next next next "12345"
  --test-- "series-back-10"
  --assert 53 = first back next next next next next "12345"
  --test-- "series-back-11"
  --assert 49 = first back "12345"
===end-group===

===start-group=== "tail"
  --test-- "series-tail-1"
  --assert 5 = first back tail [1 2 3 4 5]
  --test-- "seried-tail-2"
  --assert none = pick tail [1 2 3 4 5] 1
===end-group===

===start-group=== "pick"

  --test-- "series-pick-1"
  --assert none = pick "" 1

  --test-- "series-pick-2"
  --assert none = pick "" 0

  --test-- "series-pick-3"
  --assert none = pick "" 2

  --test-- "series-pick-4"
  --assert 49 = pick "12345" 1

  --test-- "series-pick-5"
  --assert 53 = pick "12345" 5

  --test-- "series-pick-6"
  --assert 1 = pick [1 2 3 4 5] 1

  --test-- "series-pick-7"
  --assert 2 = pick [1 2 3 4 5] 2

  --test-- "series-pick-8"
  --assert 4 = pick [1 2 3 4 5] 4

  --test-- "series-pick-9"
  --assert 5 = pick [1 2 3 4 5] 5

  --test-- "series-pick-10"
  --assert 2 = pick next next next [1 2 3 4 5] -2

  --test-- "series-pick-11"
  --assert 3 = pick next next next [1 2 3 4 5] -1

  --test-- "series-pick-12"
  --assert none = pick next next next [1 2 3 4 5] 0

  --test-- "series-pick-13"
  --assert none = pick "12345" -1

  --test-- "series-pick-14"
    sp14-i: 1
  --assert 1 = pick [1 2 3 4 5] sp14-i

  --test-- "series-pick-15"
    sp15-i: 4
  --assert 4 = pick [1 2 3 4 5] sp15-i

  --test-- "series-pick-16"
    sp16-i: -2
  --assert 2 = pick next next next [1 2 3 4 5] sp16-i

  --test-- "series-pick-17"
    sp17-i: 0
  --assert none = pick next next next [1 2 3 4 5] sp17-i

  --test-- "series-pick-18"
    sp18-i: -1
  --assert none = pick "12345" sp18-i

===end-group===

===start-group=== "select"
  --test-- "series-select-1"
  ;--assert 2 = select [1 2 3 4 5] 1
===end-group===

===start-group=== "append"
  --test-- "series-append-1"
  --assert 6 = last append [1 2 3 4 5] 6
  --test-- "series-append-2"
  --assert 6 = last append [1 2 3 4] [5 6]
  --assert 4 = fourth append [1 2 3 4] [5 6]
  --assert 5 = fifth append [1 2 3 4] [5 6]
  --test-- "series-append-3"
  --assert 55 = last append "12345" "67"
  --test-- "series-append-4"
  --assert 233 = last append "abcde" "é" ;; utf-8 C3 A9
  --test-- "series-append-5"
  --assert 49 = last append "abcdeé" "1" ;; utf-8 C3 A9
  --test-- "series-append-6"
  --assert 10000 = last append "abcde" "✐"
  --test-- "series-append-7"
  --assert 48 = last append "abcde^(2710)" "0"
  --test-- "series-append-8"
  --assert 10000 = last append "abcdeé" "^(2710)"
  --test-- "series-append-9"
  --assert 233 = last append "abcde^(2710)" "é"
  --test-- "series-append-10"
  --assert 65536 = last append "abcde" "^(010000)"
  --test-- "series-append-11"
  --assert 48 = last append "abcde^(010000)" "0"
  --test-- "series=append-12"
  --assert 65536 = last append "abcde^(2710)é" "^(010000)"

===end-group===

~~~end-file~~~


TESTS: fixed SWITCH tests.

TESTS: fixed SWITCH tests.

Red [
	Title:   "Red switch function test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %switch-test.red
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2012, 2012 Nenad Rakocevic & 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.red

~~~start-file~~~ "switch"

===start-group=== "switch basics"

	--test-- "switch-basic-1"
		sb1-i: 1
		sb1-j: -1
		switch sb1-i [
			0	[sb1-j: 0]
			1	[sb1-j: 1]
			2	[sb1-j: 2]
		]
	--assert sb1-j = 1

	--test-- "switch-basic-2"
		sb2-i: "Nenad"
		sb2-j: "REBOL"
		switch sb2-i [
			"Andreas" 	[sb2-j: "Earl"]
			"Nenad"		[sb2-j: "Red"]
			"Peter"		[sb2-j: "Peter"]
		]
	--assert sb2-j = "Red"

	--test-- "switch-basic-3"
		sb3-i: "Χαῖρε, κόσμε"
		sb3-j: "REBOL"
		switch sb3-i [
			"Andreas" 			[sb3-j: "Earl"]
			"Nenad"				[sb3-j: "Red"]
			"Peter"				[sb3-j: "Peter"]
			"Χαῖρε, κόσμε"		[sb3-j: "Zorba"]
		]
	--assert sb3-j = "Zorba"

	--test-- "switch-basic-4"
		sb4-i: "Zorba"
		sb4-j: "REBOL"
		switch sb4-i [
			"Andreas" 			[sb4-j: "Earl"]
			"Nenad"				[sb4-j: "Red"]
			"Peter"				[sb4-j: "Peter"]
			"Zorba"				[sb4-j: "Χαῖρε, κόσμε"]
		]
	--assert sb4-j = "Χαῖρε, κόσμε"

	--test-- "switch-basic-5"
		sb5-i: "abcde^(010000)"
		sb5-j: "REBOL"
		switch sb5-i [
			"Andreas" 			[sb5-j: "Earl"]
			"Nenad"				[sb5-j: "Red"]
			"Peter"				[sb5-j: "Peter"]
			"Zorba"				[sb5-j: "Χαῖρε, κόσμε"]
			"abcde^(010000)"	[sb5-j: "boron"]
		]
	--assert sb5-j = "boron"

	--test-- "switch-basic-6"
		sb6-i: #"^(010000)"
		sb6-j: "REBOL"
		switch sb6-i [
			#"a" 				[sb6-j: "Earl"]
			#"b"				[sb6-j: "Red"]
			#"c"				[sb6-j: "Peter"]
			#"d"				[sb6-j: "Χαῖρε, κόσμε"]
			#"^(010000)"		[sb6-j: "boron"]
		]
	--assert sb6-j = "boron"

	--test-- "switch-basic-7"
		sb7-i: [a b c]
		sb7-j: "REBOL"
		switch sb7-i [
			[c b a] 			[sb7-j: "Earl"]
			[a b c]				[sb7-j: "Red"]
			[b c a]				[sb7-j: "Peter"]
		]
	--assert sb7-j = "Red"

	--test-- "switch-basic-8"
		sb8-i: %Nenad
		sb8-j: "REBOL"
		switch sb8-i [
			%Andreas 	[sb8-j: "Earl"]
			%Nenad		[sb8-j: "Red"]
			%Peter		[sb8-j: "Peter"]
		]
	--assert sb8-j = "Red"

	--test-- "switch-basic-9"
		sb9-i: #Nenad
		sb9-j: "REBOL"
		switch sb9-i [
			#Andreas 	[sb9-j: "Earl"]
			#Nenad		[sb9-j: "Red"]
			#Peter		[sb9-j: "Peter"]
		]
	--assert sb9-j = "Red"

	--test-- "switch-basic-10"
		sb10-i: true
		sb10-j: "REBOL"
		switch sb10-i [
			#[false]	[sb10-j: "Earl"]
			#[true]		[sb10-j: "Red"]
			#[true]		[sb10-j: "Peter"]
		]
	--assert sb10-j = "Red"

	--test-- "switch-basic-11"
		sb11-i: first [(1 2 3)]
		sb11-j: "REBOL"
		switch sb11-i [
			(3 2 1)	 	[sb11-j: "Earl"]
			(1 2 3)		[sb11-j: "Red"]
			(2 3 1)		[sb11-j: "Peter"]
		]
	--assert sb11-j = "Red"

	--test-- "switch-basic-12"
		sb12-i: [2]
		sb12-j: "REBOL"
		switch sb12-i [
			[1] 			[sb12-j: "Earl"]
			[2]				[sb12-j: "Red"]
			[3]				[sb12-j: "Peter"]
		]
	--assert sb12-j = "Red"

	--test-- "switch-basic-13"
		sb13-i: first [(2)]
		sb13-j: "REBOL"
		switch sb13-i [
			(1)	 	[sb13-j: "Earl"]
			(2)		[sb13-j: "Red"]
			(3)		[sb13-j: "Peter"]
		]
	--assert sb13-j = "Red"

	--test-- "switch-basic-14"
		sb14-i: [2]
		sb14-j: "REBOL"
		switch first sb14-i [
			1 		[sb14-j: "Earl"]
			2		[sb14-j: "Red"]
			3		[sb14-j: "Peter"]
		]
	--assert sb14-j = "Red"

===end-group===

===start-group=== "switch basics local"    ;; one "direct" type & one "indirect"
										   ;;  should be sufficient

	sb-i: "Hello"
	sb-j: "World"
	switch-fun: func [/local sb-i sb-j][
		--test-- "switch-basic-local-1"
			sb-i: 1
			sb-j: -1
			switch sb-i [
				0	[sb-j: 0]
				1	[sb-j: 1]
				2	[sb-j: 2]
			]
		--assert sb-j = 1
		--test-- "switch-basic-local-2"
			sb-i: "Nenad"
			sb-j: "REBOL"
			switch sb-i [
				"Andreas" 	[sb-j: "Earl"]
				"Nenad"		[sb-j: "Red"]
				"Peter"		[sb-j: "Peter"]
			]
		--assert sb-j = "Red"
	]
	switch-fun

	--test-- "switch-basic-local-global-1"
	--assert sb-i = "Hello"
	--assert sb-j = "World"

===end-group===

===start-group=== "switch-default"

	--test-- "switch-default-1"
		sd1-i: 2
		sd1-j: -1
		switch/default sd1-i [
			1	[sd1-j: 1]
			2	[sd1-j: 2]
		][
			sd1-j: 0
		]
	--assert sd1-j = 2

	--test-- "switch-default-2"
		sd2-i: 999
		sd2-j: -1
		switch/default sd2-i [
			1	[sd2-j: 1]
			2	[sd2-j: 2]
		][
			sd2-j: 0
		]
	--assert sd2-j = 0

	--test-- "switch-default-3"
		sd3-i: "hello"
		sd3-j: -1
		switch/default sd3-i [
			1	[sd3-j: 1]
			2	[sd3-j: 2]
		][
			sd3-j: 0
		]
	--assert sd3-j = 0

===end-group===

;===start-group=== "switch-all"			;; not sure if it will be implemented.
;
;	--test-- "switch-all-1"
;	comment { /all not yet implemented
;		sa1-i: 1
;		sa1-j: 0
;		switch/all sa1-i [
;			0	[sa1-j: sa1j + 1]
;			1	[sa1-j: sa1j + 2]
;			2	[sa1-j: sa1j + 4]
;		]
;	--assert sa1-j = 6
;	Following assert to highlight switch/all not yet implemented
;	}
;	--assert false
;===end-group===

~~~end-file~~~

Red [
	Title:   "Red switch function test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %switch-test.red
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2012, 2012 Nenad Rakocevic & 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.red

~~~start-file~~~ "switch"

===start-group=== "switch basics"

	--test-- "switch-basic-1"
		sb1-i: 1
		sb1-j: -1
		switch sb1-i [
			0	[sb1-j: 0]
			1	[sb1-j: 1]
			2	[sb1-j: 2]
		]
	--assert sb1-j = 1

	--test-- "switch-basic-2"
		sb2-i: "Nenad"
		sb2-j: "REBOL"
		switch sb2-i [
			"Andreas" 	[sb2-j: "Earl"]
			"Nenad"		[sb2-j: "Red"]
			"Peter"		[sb2-j: "Peter"]
		]
	--assert sb2-j = "Red"

	--test-- "switch-basic-3"
		sb3-i: "Χαῖρε, κόσμε"
		sb3-j: "REBOL"
		switch sb3-i [
			"Andreas" 			[sb3-j: "Earl"]
			"Nenad"				[sb3-j: "Red"]
			"Peter"				[sb3-j: "Peter"]
			"Χαῖρε, κόσμε"		[sb3-j: "Zorba"]
		]
	--assert sb3-j = "Zorba"

	--test-- "switch-basic-4"
		sb4-i: "Zorba"
		sb4-j: "REBOL"
		switch sb4-i [
			"Andreas" 			[sb4-j: "Earl"]
			"Nenad"				[sb4-j: "Red"]
			"Peter"				[sb4-j: "Peter"]
			"Zorba"				[sb4-j: "Χαῖρε, κόσμε"]
		]
	--assert sb4-j = "Χαῖρε, κόσμε"

	--test-- "switch-basic-5"
		sb5-i: "abcde^(010000)"
		sb5-j: "REBOL"
		switch sb5-i [
			"Andreas" 			[sb5-j: "Earl"]
			"Nenad"				[sb5-j: "Red"]
			"Peter"				[sb5-j: "Peter"]
			"Zorba"				[sb5-j: "Χαῖρε, κόσμε"]
			"abcde^(010000)"	[sb5-j: "boron"]
		]
	--assert sb5-j = "boron"

	--test-- "switch-basic-6"
		sb6-i: #"^(010000)"
		sb6-j: "REBOL"
		switch sb6-i [
			#"a" 				[sb6-j: "Earl"]
			#"b"				[sb6-j: "Red"]
			#"c"				[sb6-j: "Peter"]
			#"d"				[sb6-j: "Χαῖρε, κόσμε"]
			#"^(010000)"		[sb6-j: "boron"]
		]
	--assert sb6-j = "boron"

	--test-- "switch-basic-7"
	comment { This test produces a compile error - undefined word c"
		sb7-i: [a b c]
		sb7-j: "REBOL"
		switch sb7-i [
			[c b a] 			[sb7-j: "Earl"]
			[a b c]				[sb7-j: "Red"]
			[b c a]				[sb7-j: "Peter"]
		]
	--assert sb7-j = "Red"
	The following assert is a simple to highlight the compilation error"
	It should be removed when the issue is resolved.
	}
	--assert false

	--test-- "switch-basic-8"
		sb8-i: %Nenad
		sb8-j: "REBOL"
		switch sb8-i [
			%Andreas 	[sb8-j: "Earl"]
			%Nenad		[sb8-j: "Red"]
			%Peter		[sb8-j: "Peter"]
		]
	--assert sb8-j = "Red"

	--test-- "switch-basic-9"
		sb9-i: #Nenad
		sb9-j: "REBOL"
		switch sb9-i [
			#Andreas 	[sb9-j: "Earl"]
			#Nenad		[sb9-j: "Red"]
			#Peter		[sb9-j: "Peter"]
		]
	--assert sb9-j = "Red"

	--test-- "switch-basic-10"
		sb10-i: true
		sb10-j: "REBOL"
		switch sb10-i [
			false	 	[sb10-j: "Earl"]
			true		[sb10-j: "Red"]
			true		[sb10-j: "Peter"]
		]
	--assert sb10-j = "Red"

	--test-- "switch-basic-11"
		sb11-i: (1 2 3)
		sb11-j: "REBOL"
		switch sb11-i [
			(3 2 1)	 	[sb11-j: "Earl"]
			(1 2 3)		[sb11-j: "Red"]
			(2 3 1)		[sb11-j: "Peter"]
		]
	--assert sb11-j = "Red"

	--test-- "switch-basic-12"
		sb12-i: [2]
		sb12-j: "REBOL"
		switch sb12-i [
			[1] 			[sb12-j: "Earl"]
			[2]				[sb12-j: "Red"]
			[3]				[sb12-j: "Peter"]
		]
	--assert sb12-j = "Red"

	--test-- "switch-basic-13"
		sb13-i: (2)
		sb13-j: "REBOL"
		switch sb13-i [
			(1)	 	[sb13-j: "Earl"]
			(2)		[sb13-j: "Red"]
			(3)		[sb13-j: "Peter"]
		]
	--assert sb13-j = "Red"

	--test-- "switch-basic-14"
		sb14-i: [2]
		sb14-j: "REBOL"
		switch first sb14-i [
			1 		[sb14-j: "Earl"]
			2		[sb14-j: "Red"]
			3		[sb14-j: "Peter"]
		]
	--assert sb14-j = "Red"

===end-group===

===start-group=== "switch basics local"    ;; one "direct" type & one "indirect"
										   ;;  should be sufficient

	sb-i: "Hello"
	sb-j: "World"
	switch-fun: func [/local sb-i sb-j][
		--test-- "switch-basic-local-1"
			sb-i: 1
			sb-j: -1
			switch sb-i [
				0	[sb-j: 0]
				1	[sb-j: 1]
				2	[sb-j: 2]
			]
		--assert sb-j = 1
		--test-- "switch-basic-local-2"
			sb-i: "Nenad"
			sb-j: "REBOL"
			switch sb-i [
				"Andreas" 	[sb-j: "Earl"]
				"Nenad"		[sb-j: "Red"]
				"Peter"		[sb-j: "Peter"]
			]
		--assert sb-j = "Red"
	]
	switch-fun

	--test-- "switch-basic-local-global-1"
	--assert sb-i = "Hello"
	--assert sb-j = "World"

===end-group===

===start-group=== "switch-default"

	--test-- "switch-default-1"
		sd1-i: 2
		sd1-j: -1
		switch/default sd1-i [
			1	[sd1-j: 1]
			2	[sd1-j: 2]
		][
			sd1-j: 0
		]
	--assert sd1-j = 2

	--test-- "switch-default-2"
		sd2-i: 999
		sd2-j: -1
		switch/default sd2-i [
			1	[sd2-j: 1]
			2	[sd2-j: 2]
		][
			sd2-j: 0
		]
	--assert sd2-j = 0

	--test-- "switch-default-3"
		sd3-i: "hello"
		sd3-j: -1
		switch/default sd3-i [
			1	[sd3-j: 1]
			2	[sd3-j: 2]
		][
			sd3-j: 0
		]
	--assert sd3-j = 0

===end-group===

===start-group=== "switch-all"

	--test-- "switch-all-1"
	comment { /all not yet implemented
		sa1-i: 1
		sa1-j: 0
		switch/all sa1-i [
			0	[sa1-j: sa1j + 1]
			1	[sa1-j: sa1j + 2]
			2	[sa1-j: sa1j + 4]
		]
	--assert sa1-j = 6
	Following assert to highlight switch/all not yet implemented
	}
	--assert false
===end-group===

~~~end-file~~~


update to control client due to pipeline changes

Red [
	Title:		"MONICA ZeroMQ control client"
	Author:		"Michael Berg-Mohnicke"
	Rights:		"Copyright (C) Leibniz Centre for Agricultural Landscape Research (ZALF)"
	License: {
		This Source Code Form is subject to the terms of the Mozilla Public
		License, v. 2.0. If a copy of the MPL was not distributed with this
		file, You can obtain one at http://mozilla.org/MPL/2.0/.
	}
	Needs: 'View
	;Needs*: {
	;	Red >= 0.4.3
	;	%ZeroMQ-binding.red
	;}
	Based-on: "ZeroMQ request/reply client example by Kaj de Vos"
	Tabs:		4
]

#include %../../../sys-libs/red/ZeroMQ-binding/ZeroMQ-binding.red

;prin ["0MQ version:" major-version]
;	prin #"."  prin minor-version
;	prin #"."  print patch-version
;prin newline

timeout-ms: 3000
use-timeouts: false
set-timeouts: function [socket][
	set-integer socket send-timeout timeout-ms
	set-integer socket receive-timeout timeout-ms
]

defaults: [
	proxy-address "localhost"
	proxy-frontend-port 5555
	proxy-backend-port 5566
	control-address "tcp://localhost:8888"
	publisher-control-address "tcp://localhost:8899"
	input-address "tcp://localhost:6666"
	output-address "tcp://localhost:7777"
	input-host "localhost"
	output-host "localhost"
	input-fe-port 6666
	output-fe-port 7788
	input-be-port 6677
	output-be-port 7777
	service-port 6666
]

;address: any [get-argument 1 tcp://localhost:8888]
stop-msg-template: {{"type": "finish"}}
stop-pub-msg-template: {finish{"type": "finish"}}

control-stop-msg-template: {
	{	"type": "finish"
	,	"count": <count>
	}
}

service-msg-template: {
	{	"type": "<type>"
	,	"count": <count>
	,	"control-addresses": "<control-addresses>"
	,	"service-port": <service-port>
	}
}

proxy-msg-template: {
	{	"type": "<type>"
	,	"count": <count>
	,	"control-addresses": "<control-addresses>"
	,	"proxy-address": "<proxy-address>"
	, 	"proxy-frontend-port": <proxy-frontend-port>
	,	"proxy-backend-port": <proxy-backend-port>
	}
}

pipeline-msg-template: {
	{	"type": "<type>"
	,	"count": <count>
	,	"control-addresses": "<control-addresses>"
	,	"input-addresses": "<input-addresses>"
	,	"output-addresses": "<output-addresses>"
	}
}

pipeline-proxy-msg-template: {
	{	"type": "<type>"
	,	"input-frontend-port": <input-frontend-port>
	,	"input-backend-port": <input-backend-port>
	,	"output-frontend-port": <output-frontend-port>
	,	"output-backend-port": <output-backend-port>
	}
}

log-error: does [  ; FIXME: should go to stderr
	;print ["system-error: " system-error]
	print form-error system-error
]

log?: false
log: function [out][
	if log? [print out]
]

send-msg: function [socket msg][
	log ["Sending request"]

	either send socket msg [
		log ["Sent message: " msg]
	][
		log-error
	]
]

receive-msg: function [socket /debug][
	data: ""

	log ["Receiving msg"]

	either receive/over socket data [
		log ["Received message: " data]
	][
		log-error
	]
	data
]

comment {
#system [
	i: 1
	;pi: declare pointer! [integer!]
	pi: :i
	#define h! [pointer! [integer!]]

	i!: alias struct! [d [integer!]]
	si: declare i!

	si/d: 2

	print ["i: " i " pi: " pi " pi as i!: " as i! pi " si: " si " si as h!: " as h! si]

	h: 0
	hs: "0xFF"
	success: parse-hex hs :h
	print ["success?: " success " hs: " hs " h: " h]

]
}

def: function ['k][
	;print k
	v: select defaults k
	either any [
		(type? v) = string!
		v = none
	] [v] [to string! v]
]

replace-multi: function [template multi][
	t: copy template
	foreach [k v] multi [replace t k v v]
	t
]

connect-to: function [address cf dcf][
	either connect socket address [
		cf/enable?: false
		dcf/enable?: true
	][
		log-error
		cf/enable?: false
		dcf/enable?: true
	]
]

disconnect-from: function [cf dcf][
	lep: get-string socket last-endpoint
	either all [
		not empty? lep
		disconnect socket lep
	][
		cf/enable?: true
		dcf/enable?: false
	][
		;log-error
		cf/enable?: true
		dcf/enable?: false
	]
]

stop: function [address count][
	either zero? stopSocket: open-socket pool request! [
		log-error
	][
		if use-timeouts [set-timeouts stopSocket]

		loop count [
			either connect stopSocket address [
				send-msg stopSocket stop-msg-template
				receive-msg stopSocket
				disconnect stopSocket get-string stopSocket last-endpoint
			][
				log-error
			]
		]
	]
	unless close-socket stopSocket [log-error]
]

stop-via-pub: function [port /delay secs][
	either zero? stopSocket: open-socket pool publish! [
		log-error
	][
		if use-timeouts [set-timeouts stopSocket]

		address: replace-multi "tcp://*:port" reduce ["port" port]

		either serve stopSocket address [

			; try sending finish messages for 60 * delay seconds
			loop 30 [
				;print "now waiting to publish finish message"
				wait any [secs 1] ;wait 2 seconds for subscribers to connect

				send-msg stopSocket stop-pub-msg-template
			]

			if not unbind stopSocket get-string stopSocket last-endpoint [log-error]
		][
			log-error
		]
	]
	unless close-socket stopSocket [log-error]
]

either zero? pool: make-pool 1 [
	log-error
][
	either zero? socket: open-socket pool request! [
		log-error
	][
		if use-timeouts [set-timeouts socket]

		view compose/deep [
			title "MONICA ZeroMQ control client"

			across
			text "Control node address:" control-address: field 150 (def control-address)
			return

			check "Use timeouts" data (use-timeouts) [
				if use-timeouts: face/data [set-timeouts socket]
			]
			con: button "connect" [connect-to control-address/text con discon]
			discon: button "disconnect" disabled [disconnect-from con discon]
			return

			type: drop-down "start-new" data ["start-new" "start-max" "stop"] select 1
			count: field "1" text "MONICA instances"
			return

			text "Publisher control address(es):" pub-control-addresses: field 150 (def publisher-control-address)
			;text "wait for" pub-send-delay: field "2" text "seconds"
			return

			below
			tp: tab-panel [
				"Pipeline" [
					across
					panel [
						across
						text "Input host:" input-host: field 100 (def input-host)
						text "frontend port:" input-fe-port: field 50 (def input-fe-port)
						text "backend port:" input-be-port: field 50 (def input-be-port)
						return
						text "Output host:" output-host: field 100 (def output-host)
						text "frontend port:" output-fe-port: field 50 (def output-fe-port)
						text "backend port:" output-be-port: field 50 (def output-be-port)
						return
						button "start proxies" [
							m: replace-multi pipeline-proxy-msg-template reduce [
								"<type>" "start-pipeline-proxies"
								"<input-frontend-port>" to integer! input-fe-port/data
								"<input-backend-port>" to integer! input-be-port/data
								"<output-frontend-port>" to integer! output-fe-port/data
								"<output-backend-port>" to integer! output-be-port/data
							]
							;print m
							send-msg socket m
							receive-msg socket
						]
						button "action" react [face/text: type/text face/enable?: not con/enable?] [
							;print input-addresses/text
							m: replace-multi pipeline-msg-template reduce [
								"<type>" type/text
								"<count>" to integer! count/data
								"<control-addresses>" pub-control-addresses/text
								"<input-addresses>" replace-multi "tcp://host:port" reduce [ "host" input-host/data "port" input-be-port/data]
								"<output-addresses>" replace-multi "tcp://host:port" reduce [ "host" output-host/data "port" output-fe-port/data]
							]
							;print m
							send-msg socket m
							receive-msg socket
						]
						button "stop" [
							stop-via-pub/delay to integer! first parse pub-control-addresses/text [
								collect [some ["tcp://" thru ":" keep [to "," | thru end] opt ","]]
							] 1 ;to integer! pub-send-delay/text
						]
					]
					panel [
						across

					]
				]
				"Proxy" [
					across
					text "Proxy address:" proxy-address: field (def proxy-address)
					text "frontend-port:" frontend-port: field (def proxy-frontend-port)
					text "backend-port:" backend-port: field (def proxy-backend-port)
					return
					button "action" react [face/text: type/text face/enable?: not con/enable?] [
						m: replace-multi proxy-msg-template reduce [
							"<type>" type/text
							"<count>" to integer! count/data
							"<control-address>" pub-control-addresses/text
							"<proxy-address>" proxy-address/text
							"<proxy-frontend-port>" to integer! frontend-port/data
							"<proxy-backend-port>" to integer! backend-port/data
						]
						send-msg socket m
						receive-msg socket
					]
					button "stop" [
						stop proxy-address/text to integer! frontend-port/data to integer! count/data
					]
				]
				"Single-service" [
					across
					text "Service port:" service-port: field (def service-port)
					return
					button "action" react [face/text: type/text face/enable?: not con/enable?] [
						m: replace-multi service-msg-template reduce [
							"<type>" type/text
							"<count>" to integer! count/data
							"<control-address>" pub-control-addresses/text
							"<service-port>" to integer! service-port/data
						]
						send-msg socket m
						receive-msg socket
					]
					button "stop" [
						stop control-address/text to integer! service-port/data 1
					]
				]
			]
			do [
				;connect-to control-address/text control-port/text con discon
				self/actors: object [on-close: func [f e] [
					disconnect-from con discon
				]]
			]
		]
		unless close-socket socket [log-error]
	]
	unless end-pool pool [log-error]
]

Red [
	Title:		"MONICA ZeroMQ control client"
	Author:		"Michael Berg-Mohnicke"
	Rights:		"Copyright (C) Leibniz Centre for Agricultural Landscape Research (ZALF)"
	License: {
		This Source Code Form is subject to the terms of the Mozilla Public
		License, v. 2.0. If a copy of the MPL was not distributed with this
		file, You can obtain one at http://mozilla.org/MPL/2.0/.
	}
	Needs: 'View
	;Needs*: {
	;	Red >= 0.4.3
	;	%ZeroMQ-binding.red
	;}
	Based-on: "ZeroMQ request/reply client example by Kaj de Vos"
	Tabs:		4
]

#include %../../../sys-libs/red/ZeroMQ-binding/ZeroMQ-binding.red

;prin ["0MQ version:" major-version]
;	prin #"."  prin minor-version
;	prin #"."  print patch-version
;prin newline

timeout-ms: 3000
use-timeouts: false
set-timeouts: function [socket][
	set-integer socket send-timeout timeout-ms
	set-integer socket receive-timeout timeout-ms
]

defaults: [
	proxy-address "localhost"
	proxy-frontend-port 5555
	proxy-backend-port 5566
	control-address "tcp://localhost:8888"
	publisher-control-address "tcp://localhost:8899"
	input-address "tcp://localhost:6666"
	output-address "tcp://localhost:7777"
	service-port 6666
]

;address: any [get-argument 1 tcp://localhost:8888]
stop-msg-template: {{"type": "finish"}}
stop-pub-msg-template: {finish{"type": "finish"}}

control-stop-msg-template: {
	{	"type": "finish"
	,	"count": <count>
	}
}

service-msg-template: {
	{	"type": "<type>"
	,	"count": <count>
	,	"control-addresses": "<control-addresses>"
	,	"service-port": <service-port>
	}
}

proxy-msg-template: {
	{	"type": "<type>"
	,	"count": <count>
	,	"control-addresses": "<control-addresses>"
	,	"proxy-address": "<proxy-address>"
	, 	"proxy-frontend-port": <proxy-frontend-port>
	,	"proxy-backend-port": <proxy-backend-port>
	}
}

pipeline-msg-template: {
	{	"type": "<type>"
	,	"count": <count>
	,	"control-addresses": "<control-addresses>"
	,	"input-addresses": "<input-addresses>"
	,	"output-addresses": "<output-addresses>"
	}
}

log-error: does [  ; FIXME: should go to stderr
	;print ["system-error: " system-error]
	print form-error system-error
]

log?: false
log: function [out][
	if log? [print out]
]

send-msg: function [socket msg][
	log ["Sending request"]

	either send socket msg [
		log ["Sent message: " msg]
	][
		log-error
	]
]

receive-msg: function [socket /debug][
	data: ""

	log ["Receiving msg"]

	either receive/over socket data [
		log ["Received message: " data]
	][
		log-error
	]
	data
]

comment {
#system [
	i: 1
	;pi: declare pointer! [integer!]
	pi: :i
	#define h! [pointer! [integer!]]

	i!: alias struct! [d [integer!]]
	si: declare i!

	si/d: 2

	print ["i: " i " pi: " pi " pi as i!: " as i! pi " si: " si " si as h!: " as h! si]

	h: 0
	hs: "0xFF"
	success: parse-hex hs :h
	print ["success?: " success " hs: " hs " h: " h]

]
}

def: function ['k][
	;print k
	v: select defaults k
	either any [
		(type? v) = string!
		v = none
	] [v] [to string! v]
]

replace-multi: function [template multi][
	t: copy template
	foreach [k v] multi [replace t k v v]
	t
]

connect-to: function [address cf dcf][
	either connect socket address [
		cf/enable?: false
		dcf/enable?: true
	][
		log-error
		cf/enable?: false
		dcf/enable?: true
	]
]

disconnect-from: function [cf dcf][
	lep: get-string socket last-endpoint
	either all [
		not empty? lep
		disconnect socket lep
	][
		cf/enable?: true
		dcf/enable?: false
	][
		;log-error
		cf/enable?: true
		dcf/enable?: false
	]
]

stop: function [address count][
	either zero? stopSocket: open-socket pool request! [
		log-error
	][
		if use-timeouts [set-timeouts stopSocket]

		loop count [
			either connect stopSocket address [
				send-msg stopSocket stop-msg-template
				receive-msg stopSocket
				disconnect stopSocket get-string stopSocket last-endpoint
			][
				log-error
			]
		]
	]
	unless close-socket stopSocket [log-error]
]

stop-via-pub: function [port /delay secs][
	either zero? stopSocket: open-socket pool publish! [
		log-error
	][
		if use-timeouts [set-timeouts stopSocket]

		address: replace-multi "tcp://*:port" reduce ["port" port]

		either serve stopSocket address [

			; try sending finish messages for 60 * delay seconds
			loop 30 [
				;print "now waiting to publish finish message"
				wait any [secs 1] ;wait 2 seconds for subscribers to connect

				send-msg stopSocket stop-pub-msg-template
			]

			if not unbind stopSocket get-string stopSocket last-endpoint [log-error]
		][
			log-error
		]
	]
	unless close-socket stopSocket [log-error]
]

either zero? pool: make-pool 1 [
	log-error
][
	either zero? socket: open-socket pool request! [
		log-error
	][
		if use-timeouts [set-timeouts socket]

		view compose/deep [
			title "MONICA ZeroMQ control client"

			across
			text "Control node address:" control-address: field 150 (def control-address)
			return

			check "Use timeouts" data (use-timeouts) [
				if use-timeouts: face/data [set-timeouts socket]
			]
			con: button "connect" [connect-to control-address/text con discon]
			discon: button "disconnect" disabled [disconnect-from con discon]
			return

			type: drop-down "start-new" data ["start-new" "start-max" "stop"] select 1
			count: field "1" text "MONICA instances"
			return

			text "Publisher control address(es):" pub-control-addresses: field 150 (def publisher-control-address)
			;text "wait for" pub-send-delay: field "2" text "seconds"
			return

			below
			tp: tab-panel [
				"Pipeline" [
					across
					text "Input address(es):" input-addresses: field 150 (def input-address)
					return
					text "Output address(es):" output-addresses: field 150 (def output-address)
					return
					button "action" react [face/text: type/text face/enable?: not con/enable?] [
						;print input-addresses/text
						m: replace-multi pipeline-msg-template reduce [
							"<type>" type/text
							"<count>" to integer! count/data
							"<control-addresses>" pub-control-addresses/text
							"<input-addresses>" input-addresses/text
							"<output-addresses>" output-addresses/text
						]
						;print m
						send-msg socket m
						receive-msg socket
					]
					button "stop" [
						stop-via-pub/delay to integer! first parse pub-control-addresses/text [
							collect [some ["tcp://" thru ":" keep [to "," | thru end] opt ","]]
						] 1 ;to integer! pub-send-delay/text
					]
				]
				"Proxy" [
					across
					text "Proxy address:" proxy-address: field (def proxy-address)
					text "frontend-port:" frontend-port: field (def proxy-frontend-port)
					text "backend-port:" backend-port: field (def proxy-backend-port)
					return
					button "action" react [face/text: type/text face/enable?: not con/enable?] [
						m: replace-multi proxy-msg-template reduce [
							"<type>" type/text
							"<count>" to integer! count/data
							"<control-address>" pub-control-addresses/text
							"<proxy-address>" proxy-address/text
							"<proxy-frontend-port>" to integer! frontend-port/data
							"<proxy-backend-port>" to integer! backend-port/data
						]
						send-msg socket m
						receive-msg socket
					]
					button "stop" [
						stop proxy-address/text to integer! frontend-port/data to integer! count/data
					]
				]
				"Single-service" [
					across
					text "Service port:" service-port: field (def service-port)
					return
					button "action" react [face/text: type/text face/enable?: not con/enable?] [
						m: replace-multi service-msg-template reduce [
							"<type>" type/text
							"<count>" to integer! count/data
							"<control-address>" pub-control-addresses/text
							"<service-port>" to integer! service-port/data
						]
						send-msg socket m
						receive-msg socket
					]
					button "stop" [
						stop control-address/text to integer! service-port/data 1
					]
				]
			]
			do [
				;connect-to control-address/text control-port/text con discon
				self/actors: object [on-close: func [f e] [
					disconnect-from con discon
				]]
			]
		]
		unless close-socket socket [log-error]
	]
	unless end-pool pool [log-error]
]


TESTS: added find/string! tests to series-test.red

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

;; counters
qt-run-tests: 0
qt-run-asserts: 0
qt-run-passes: 0
qt-run-failures: 0
qt-file-tests: 0
qt-file-asserts: 0
qt-file-passes: 0
qt-file-failures: 0

;; group switches
qt-group-name-not-printed: true
qt-group?: false

_qt-init-group: func [] [
  qt-group-name-not-printed: true
  qt-group?: false
  qt-group-name: ""
]

qt-init-run: func [] [
  qt-run-tests: 0
  qt-run-asserts: 0
  qt-run-passes: 0
  qt-run-failures: 0
  _qt-init-group
]

qt-init-file: func [] [
  qt-file-tests: 0
  qt-file-asserts: 0
  qt-file-passes: 0
  qt-file-failures: 0
  _qt-init-group
]

***start-run***: func[
    title [string!]
][
  qt-init-run
  qt-run-name: title
  prin "***Starting*** "
  print title
]

~~~start-file~~~: func [
  title [string!]
][
  qt-init-file
  prin "~~~started test~~~ "
  print title
  qt-file-name: title
  qt-group?: false
]

===start-group===: func [
  title [string!]
][
  qt-group-name: title
  qt-group?: true
]

--test--: func [
  title [string!]
][
  qt-test-name: title
  qt-file-tests: qt-file-tests + 1
]

--assert: func [
  assertion [logic!]
][

  qt-file-asserts: qt-file-asserts + 1

  either assertion [
     qt-file-passes: qt-file-passes + 1
  ][
    qt-file-failures: qt-file-failures + 1
    if qt-group? [
      if qt-group-name-not-printed [
        prin "===group=== "
        print qt-group-name
        qt-group-name-not-printed: false
      ]
    ]
    prin "--test-- "
    prin qt-test-name
    print " FAILED**************"
  ]
]

===end-group===: func [] [
  _qt-init-group
]

qt-print-totals: func [
  tests     [integer!]
  asserts   [integer!]
  passes    [integer!]
  failures  [integer!]
][
  prin  "  Number of Tests Performed:      "
  print tests
  prin  "  Number of Assertions Performed: "
  print asserts
  prin  "  Number of Assertions Passed:    "
  print passes
  prin  "  Number of Assertions Failed:    "
  print failures
  if failures <> 0 [
    print "****************TEST FAILURES****************"
  ]
]

~~~end-file~~~: func [] [
  print ""
  prin "~~~finished test~~~ "
  print qt-file-name
  qt-print-totals qt-file-tests qt-file-asserts qt-file-passes qt-file-failures
  print ""

  ;; update run totals
  qt-run-passes: qt-run-passes + qt-file-passes
  qt-run-asserts: qt-run-asserts + qt-file-asserts
  qt-run-failures: qt-run-failures + qt-file-failures
  qt-run-tests: qt-run-tests + qt-file-tests
]

***end-run***: func [][
  prin "***Finished*** "
  print qt-run-name
  qt-print-totals qt-run-tests
                  qt-run-asserts
                  qt-run-passes
                  qt-run-failures
]

~~~start-file~~~ "series"

===start-group=== "first, second, third, fourth, fifth"

	--test-- "series-fstff-1"
	  sf1-ser:  [1 2 3 4 5]
	--assert 1 = first sf1-ser
	--assert 2 = second sf1-ser
	--assert 3 = third sf1-ser
	--assert 4 = fourth sf1-ser
	--assert 5 = fifth sf1-ser
	--assert 5 = last sf1-ser

	--test-- "series-fstff-2"
	  sf2-ser:  [1 2 3 4 5]
	--assert 2 = first next sf2-ser

	--test-- "series-fstff-3"
	  sf3-ser:  "12345"
	--assert 49 = first sf3-ser
	--assert 53 = last sf3-ser

	--test-- "series-fstff-4"
	  sf4-ser:  [1 2 3 4 5]
	--assert none = fifth next sf4-ser

	--test-- "series-fstff-5"
	  sf5-ser:  "12345"
	--assert 53 = fifth sf5-ser

	--test-- "series-fstff-6"
	  stf6-ser: #{000102}
	;;--assert 0 = first stf6-ser

	--test-- "series-fstff-7"
	--assert 'a = first [a b c d]

	--test-- "series-fstff-8"
	--assert 'a = first first first first first first first first first [[[[[[[[[a]]]]]]]]]

	--test-- "series-fstff-9"
	--assert #"^(00)" = first "^(00)"

	--test-- "series-fstff-10"
	--assert #"^(00)" = first "^(00)a"

	--test-- "series-fstff-11"
	--assert #"^(00)" = second "a^(00)"

	--test-- "series-fstff-12"
	--assert #"^(00)" = second "a^(00)b"

===end-group===

===start-group=== "next"
  --test-- "series-next-1"
  --assert 2 = first next [1 2 3 4 5]
  --test-- "series-next-2"
  --assert 3 = first next next [1 2 3 4 5]
  --test-- "series-next-3"
  --assert 4 = first next next next [1 2 3 4 5]
  --test-- "series-next-4"
  --assert 5 = first next next next next [1 2 3 4 5]
  --test-- "series-next-5"
  --assert none = first next next next next next [1 2 3 4 5]
  --test-- "series-next-6"
  --assert 50 = first next "12345"
  --test-- "series-next-7"
  --assert 51 = first next next "12345"
  --test-- "series-next-8"
  --assert 52 = first next next next "12345"
  --test-- "series-next-9"
  --assert 53 = first next next next next "12345"
  --test-- "series-next-10"
  --assert none = first next next next next next "12345"
  --test-- "series-next-11"
  --assert #"^(00)" = first next "a^(00)"
  --test-- "series-next-12"
  --assert #"^(00)" = first next "a^(00)b"
===end-group===

===start-group=== "back"
  --test-- "series-back-1"
  --assert 1 = first back next [1 2 3 4 5]
  --test-- "series-back-2"
  --assert 1 = first back back next next [1 2 3 4 5]
  --test-- "series-back-3"
  --assert 1 = first back back back next next next [1 2 3 4 5]
  --test-- "series-back-4"
  --assert 1 = first back back back back next next next next [1 2 3 4 5]
  --test-- "series-back-5"
  --assert 1 = first back back back back back next next next next next [1 2 3 4 5]
  --test-- "series-back-6"
  --assert 49 = first back next "12345"
  --test-- "series-back-7"
  --assert 50 = first back next next "12345"
  --test-- "series-back-8"
  --assert 51 = first back next next next "12345"
  --test-- "series-back-9"
  --assert 52 = first back next next next next "12345"
  --test-- "series-back-10"
  --assert 53 = first back next next next next next "12345"
  --test-- "series-back-11"
  --assert 49 = first back "12345"
===end-group===

===start-group=== "tail"
  --test-- "series-tail-1"
  --assert 5 = first back tail [1 2 3 4 5]
  --test-- "seried-tail-2"
  --assert none = pick tail [1 2 3 4 5] 1
===end-group===

===start-group=== "pick"

  --test-- "series-pick-1"
  --assert none = pick "" 1

  --test-- "series-pick-2"
  --assert none = pick "" 0

  --test-- "series-pick-3"
  --assert none = pick "" 2

  --test-- "series-pick-4"
  --assert 49 = pick "12345" 1

  --test-- "series-pick-5"
  --assert 53 = pick "12345" 5

  --test-- "series-pick-6"
  --assert 1 = pick [1 2 3 4 5] 1

  --test-- "series-pick-7"
  --assert 2 = pick [1 2 3 4 5] 2

  --test-- "series-pick-8"
  --assert 4 = pick [1 2 3 4 5] 4

  --test-- "series-pick-9"
  --assert 5 = pick [1 2 3 4 5] 5

  --test-- "series-pick-10"
  --assert 2 = pick next next next [1 2 3 4 5] -2

  --test-- "series-pick-11"
  --assert 3 = pick next next next [1 2 3 4 5] -1

  --test-- "series-pick-12"
  --assert none = pick next next next [1 2 3 4 5] 0

  --test-- "series-pick-13"
  --assert none = pick "12345" -1

  --test-- "series-pick-14"
    sp14-i: 1
  --assert 1 = pick [1 2 3 4 5] sp14-i

  --test-- "series-pick-15"
    sp15-i: 4
  --assert 4 = pick [1 2 3 4 5] sp15-i

  --test-- "series-pick-16"
    sp16-i: -2
  --assert 2 = pick next next next [1 2 3 4 5] sp16-i

  --test-- "series-pick-17"
    sp17-i: 0
  --assert none = pick next next next [1 2 3 4 5] sp17-i

  --test-- "series-pick-18"
    sp18-i: -1
  --assert none = pick "12345" sp18-i

===end-group===

===start-group=== "select"
  --test-- "series-select-1"
  ;--assert 2 = select [1 2 3 4 5] 1
===end-group===

===start-group=== "append"
  --test-- "series-append-1"
  --assert 6 = last append [1 2 3 4 5] 6
  --test-- "series-append-2"
  --assert 6 = last append [1 2 3 4] [5 6]
  --assert 4 = fourth append [1 2 3 4] [5 6]
  --assert 5 = fifth append [1 2 3 4] [5 6]
  --test-- "series-append-3"
  --assert 55 = last append "12345" "67"
  --test-- "series-append-4"
  --assert 233 = last append "abcde" "é" ;; utf-8 C3 A9
  --test-- "series-append-5"
  --assert 49 = last append "abcdeé" "1" ;; utf-8 C3 A9
  --test-- "series-append-6"
  --assert 10000 = last append "abcde" "✐"
  --test-- "series-append-7"
  --assert 48 = last append "abcde^(2710)" "0"
  --test-- "series-append-8"
  --assert 10000 = last append "abcdeé" "^(2710)"
  --test-- "series-append-9"
  --assert 233 = last append "abcde^(2710)" "é"
  --test-- "series-append-10"
  --assert 65536 = last append "abcde" "^(010000)"
  --test-- "series-append-11"
  --assert 48 = last append "abcde^(010000)" "0"
  --test-- "series=append-12"
  --assert 65536 = last append "abcde^(2710)é" "^(010000)"

===end-group===

===start-group=== "series-equal"

  --test-- "series-equal-1"
  --assert [] = []

  --test-- "series-equal-2"
    se2-b: []
  --assert [] = se2-b

  --test-- "series-equal-3"
    se3-b: []
  --assert se3-b = []

  --test-- "series-equal-4"
    se4-b: [1]
  --assert se4-b = [1]

  --test-- "series-equal-5"
    se5-b: ["abcde"]
  --assert se5-b = ["abcde"]

===end-group===

===start-group=== "series-find"

  --test-- "series-find-1"
  --assert 3 = first find [1 2 3 4 5] 3

  --test-- "series-find-2"
  --assert 'a = first find [a b c d e] 'a

  --test-- "series-find-3"
  --assert 'e = first find [a b c d e] 'e

  --test-- "series-find-4"
  --assert none = find [] 'a

  --test-- "series-find-5"
  --assert none = find [1 2 3 4] 'a

  --test-- "series-find-6"
  --assert none = find next [a b c d e] 'a

  --test-- "series-find-7"
  --assert 51 = first find "12345" "3"

  --test-- "series-find-8"
  --assert 51 = first find "12345" "^(33)"

  --test-- "series-find-9"
  --assert 51 = first find "12345" first "^(33)"

  --test-- "series-find-10"
  --assert 51 = first find "12345" #"3"

  --test-- "series-find-11"
  --assert 51 = first find "12345" #"^(33)"

  --test-- "series-find-12"
  --assert #"3" = first find "12345" #"3"

  --test-- "series-find-13"
  --assert #"a" = first find "abcdefghijklmno" #"a"

  --test-- "series-find-14"
  --assert "ghijklmno" = find "abcdefghijklmno" "ghij"

  --test-- "series-find-15"
  --assert #"o" = first find "abcdefghijklmno" #"o"

  --test-- "series-find-16"
  --assert "o" = find "abcdefghijklmno" #"o"

  --test-- "series-find-17"
  --assert #"o" = first find "abcdefghijklmno" "o"

  --test-- "series-find-18"
  --assert "o" = find "abcdefghijklmno" "o"

  --test-- "series-find-19"
  --assert none = find "" #"a"

  --test-- "series-find-20"
  --assert none = find "" #"^(00)"

  --test-- "series-find-21"
  --assert none = find "" ""

  --test-- "series-find-22"
  --assert "^(00)" = find "^(00)" "^(00)"

  --test-- "series-find-23"
  --assert "a^(00)" = find "a^(00)" "a^(00)"

  --test-- "series-find-24"
  --assert "^(00)a" = find "^(00)a" "^(00)a"

  --test-- "series-find-25"
  --assert "^(00)" = find "^(00)" #"^(00)"

  --test-- "series-find-26"
  ;--assert #"^(00)" = first find "^(00)" #"^(00)"
  ;; runtime error generated as find incorrectly returns none

  --test-- "series-find-27"
  --assert #"é" = first find "abcdeé" #"é"

  --test-- "series-find-28"
  --assert "é" = find "abcdeé" "é"

  --test-- "series-find-29"
  --assert "é" = find append "abcde" "é" "é"

  --test-- "series-find-30"
  --assert 10000 = first find "abcde✐" "✐"

  --test-- "series-find-31"
  --assert none = find "012345" 48

  --test-- "series-find-32"
  --assert "^(010000)" = find "abcde^(2710)é^(010000)" "^(010000)"

  --test-- "series-find-33"
  --assert "^(010000)cde^(2710)é" = find "ab^(010000)cde^(2710)é" #"^(010000)"

  --test-- "series-find-34"
  --assert "^(010000)cde^(2710)é" = find "ab^(010000)cde^(2710)é" "^(010000)"

===end-group===

~~~end-file~~~

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

;; counters
qt-run-tests: 0
qt-run-asserts: 0
qt-run-passes: 0
qt-run-failures: 0
qt-file-tests: 0
qt-file-asserts: 0
qt-file-passes: 0
qt-file-failures: 0

;; group switches
qt-group-name-not-printed: true
qt-group?: false

_qt-init-group: func [] [
  qt-group-name-not-printed: true
  qt-group?: false
  qt-group-name: ""
]

qt-init-run: func [] [
  qt-run-tests: 0
  qt-run-asserts: 0
  qt-run-passes: 0
  qt-run-failures: 0
  _qt-init-group
]

qt-init-file: func [] [
  qt-file-tests: 0
  qt-file-asserts: 0
  qt-file-passes: 0
  qt-file-failures: 0
  _qt-init-group
]

***start-run***: func[
    title [string!]
][
  qt-init-run
  qt-run-name: title
  prin "***Starting*** "
  print title
]

~~~start-file~~~: func [
  title [string!]
][
  qt-init-file
  prin "~~~started test~~~ "
  print title
  qt-file-name: title
  qt-group?: false
]

===start-group===: func [
  title [string!]
][
  qt-group-name: title
  qt-group?: true
]

--test--: func [
  title [string!]
][
  qt-test-name: title
  qt-file-tests: qt-file-tests + 1
]

--assert: func [
  assertion [logic!]
][

  qt-file-asserts: qt-file-asserts + 1

  either assertion [
     qt-file-passes: qt-file-passes + 1
  ][
    qt-file-failures: qt-file-failures + 1
    if qt-group? [
      if qt-group-name-not-printed [
        prin "===group=== "
        print qt-group-name
        qt-group-name-not-printed: false
      ]
    ]
    prin "--test-- "
    prin qt-test-name
    print " FAILED**************"
  ]
]

===end-group===: func [] [
  _qt-init-group
]

qt-print-totals: func [
  tests     [integer!]
  asserts   [integer!]
  passes    [integer!]
  failures  [integer!]
][
  prin  "  Number of Tests Performed:      "
  print tests
  prin  "  Number of Assertions Performed: "
  print asserts
  prin  "  Number of Assertions Passed:    "
  print passes
  prin  "  Number of Assertions Failed:    "
  print failures
  if failures <> 0 [
    print "****************TEST FAILURES****************"
  ]
]

~~~end-file~~~: func [] [
  print ""
  prin "~~~finished test~~~ "
  print qt-file-name
  qt-print-totals qt-file-tests qt-file-asserts qt-file-passes qt-file-failures
  print ""

  ;; update run totals
  qt-run-passes: qt-run-passes + qt-file-passes
  qt-run-asserts: qt-run-asserts + qt-file-asserts
  qt-run-failures: qt-run-failures + qt-file-failures
  qt-run-tests: qt-run-tests + qt-file-tests
]

***end-run***: func [][
  prin "***Finished*** "
  print qt-run-name
  qt-print-totals qt-run-tests
                  qt-run-asserts
                  qt-run-passes
                  qt-run-failures
]

~~~start-file~~~ "series"

===start-group=== "first, second, third, fourth, fifth"

	--test-- "series-fstff-1"
	  sf1-ser:  [1 2 3 4 5]
	--assert 1 = first sf1-ser
	--assert 2 = second sf1-ser
	--assert 3 = third sf1-ser
	--assert 4 = fourth sf1-ser
	--assert 5 = fifth sf1-ser
	--assert 5 = last sf1-ser

	--test-- "series-fstff-2"
	  sf2-ser:  [1 2 3 4 5]
	--assert 2 = first next sf2-ser

	--test-- "series-fstff-3"
	  sf3-ser:  "12345"
	--assert 49 = first sf3-ser
	--assert 53 = last sf3-ser

	--test-- "series-fstff-4"
	  sf4-ser:  [1 2 3 4 5]
	--assert none = fifth next sf4-ser

	--test-- "series-fstff-5"
	  sf5-ser:  "12345"
	--assert 53 = fifth sf5-ser

	--test-- "series-fstff-6"
	  stf6-ser: #{000102}
	;;--assert 0 = first stf6-ser

	--test-- "series-fstff-7"
	--assert 'a = first [a b c d]

	--test-- "series-fstff-8"
	--assert 'a = first first first first first first first first first [[[[[[[[[a]]]]]]]]]

===end-group===

===start-group=== "next"
  --test-- "series-next-1"
  --assert 2 = first next [1 2 3 4 5]
  --test-- "series-next-2"
  --assert 3 = first next next [1 2 3 4 5]
  --test-- "series-next-3"
  --assert 4 = first next next next [1 2 3 4 5]
  --test-- "series-next-4"
  --assert 5 = first next next next next [1 2 3 4 5]
  --test-- "series-next-5"
  --assert none = first next next next next next [1 2 3 4 5]
  --test-- "series-next-6"
  --assert 50 = first next "12345"
  --test-- "series-next-7"
  --assert 51 = first next next "12345"
  --test-- "series-next-8"
  --assert 52 = first next next next "12345"
  --test-- "series-next-9"
  --assert 53 = first next next next next "12345"
  --test-- "series-next-10"
  --assert none = first next next next next next "12345"
===end-group===

===start-group=== "back"
--test-- "series-back-1"
  --assert 1 = first back next [1 2 3 4 5]
  --test-- "series-back-2"
  --assert 1 = first back back next next [1 2 3 4 5]
  --test-- "series-back-3"
  --assert 1 = first back back back next next next [1 2 3 4 5]
  --test-- "series-back-4"
  --assert 1 = first back back back back next next next next [1 2 3 4 5]
  --test-- "series-back-5"
  --assert 1 = first back back back back back next next next next next [1 2 3 4 5]
  --test-- "series-back-6"
  --assert 49 = first back next "12345"
  --test-- "series-back-7"
  --assert 50 = first back next next "12345"
  --test-- "series-back-8"
  --assert 51 = first back next next next "12345"
  --test-- "series-back-9"
  --assert 52 = first back next next next next "12345"
  --test-- "series-back-10"
  --assert 53 = first back next next next next next "12345"
  --test-- "series-back-11"
  --assert 49 = first back "12345"
===end-group===

===start-group=== "tail"
  --test-- "series-tail-1"
  --assert 5 = first back tail [1 2 3 4 5]
  --test-- "seried-tail-2"
  --assert none = pick tail [1 2 3 4 5] 1
===end-group===

===start-group=== "pick"

  --test-- "series-pick-1"
  --assert none = pick "" 1

  --test-- "series-pick-2"
  --assert none = pick "" 0

  --test-- "series-pick-3"
  --assert none = pick "" 2

  --test-- "series-pick-4"
  --assert 49 = pick "12345" 1

  --test-- "series-pick-5"
  --assert 53 = pick "12345" 5

  --test-- "series-pick-6"
  --assert 1 = pick [1 2 3 4 5] 1

  --test-- "series-pick-7"
  --assert 2 = pick [1 2 3 4 5] 2

  --test-- "series-pick-8"
  --assert 4 = pick [1 2 3 4 5] 4

  --test-- "series-pick-9"
  --assert 5 = pick [1 2 3 4 5] 5

  --test-- "series-pick-10"
  --assert 2 = pick next next next [1 2 3 4 5] -2

  --test-- "series-pick-11"
  --assert 3 = pick next next next [1 2 3 4 5] -1

  --test-- "series-pick-12"
  --assert none = pick next next next [1 2 3 4 5] 0

  --test-- "series-pick-13"
  --assert none = pick "12345" -1

  --test-- "series-pick-14"
    sp14-i: 1
  --assert 1 = pick [1 2 3 4 5] sp14-i

  --test-- "series-pick-15"
    sp15-i: 4
  --assert 4 = pick [1 2 3 4 5] sp15-i

  --test-- "series-pick-16"
    sp16-i: -2
  --assert 2 = pick next next next [1 2 3 4 5] sp16-i

  --test-- "series-pick-17"
    sp17-i: 0
  --assert none = pick next next next [1 2 3 4 5] sp17-i

  --test-- "series-pick-18"
    sp18-i: -1
  --assert none = pick "12345" sp18-i

===end-group===

===start-group=== "select"
  --test-- "series-select-1"
  ;--assert 2 = select [1 2 3 4 5] 1
===end-group===

===start-group=== "append"
  --test-- "series-append-1"
  --assert 6 = last append [1 2 3 4 5] 6
  --test-- "series-append-2"
  --assert 6 = last append [1 2 3 4] [5 6]
  --assert 4 = fourth append [1 2 3 4] [5 6]
  --assert 5 = fifth append [1 2 3 4] [5 6]
  --test-- "series-append-3"
  --assert 55 = last append "12345" "67"
  --test-- "series-append-4"
  --assert 233 = last append "abcde" "é" ;; utf-8 C3 A9
  --test-- "series-append-5"
  --assert 49 = last append "abcdeé" "1" ;; utf-8 C3 A9
  --test-- "series-append-6"
  --assert 10000 = last append "abcde" "✐"
  --test-- "series-append-7"
  --assert 48 = last append "abcde^(2710)" "0"
  --test-- "series-append-8"
  --assert 10000 = last append "abcdeé" "^(2710)"
  --test-- "series-append-9"
  --assert 233 = last append "abcde^(2710)" "é"
  --test-- "series-append-10"
  --assert 65536 = last append "abcde" "^(010000)"
  --test-- "series-append-11"
  --assert 48 = last append "abcde^(010000)" "0"
  --test-- "series=append-12"
  --assert 65536 = last append "abcde^(2710)é" "^(010000)"

===end-group===

===start-group=== "series-equal"

  --test-- "series-equal-1"
  --assert [] = []

  --test-- "series-equal-2"
    se2-b: []
  --assert [] = se2-b

  --test-- "series-equal-3"
    se3-b: []
  --assert se3-b = []

  --test-- "series-equal-4"
    se4-b: [1]
  --assert se4-b = [1]

  --test-- "series-equal-5"
    se5-b: ["abcde"]
  --assert se5-b = ["abcde"]

===end-group===

===start-group=== "series-find"

  --test-- "series-find-1"
  --assert 3 = first find [1 2 3 4 5] 3

  --test-- "series-find-2"
  --assert 'a = first find [a b c d e] 'a

  --test-- "series-find-3"
  --assert 'e = first find [a b c d e] 'e

  --test-- "series-find-4"
  --assert none = find [] 'a

  --test-- "series-find-5"
  --assert none = find [1 2 3 4] 'a

  --test-- "series-find-6"
  --assert none = find next [a b c d e] 'a

===end-group===

~~~end-file~~~


TESTS: test re issue #468

TESTS: test re issue #468

Red [
	Title:   "Red function test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %routine-test.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2013 Nenad Rakocevic & 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.red

~~~start-file~~~ "routine"

===start-group=== "routine return tests"

	--test-- "rr1"
		rr1-r: routine [
			return:		[integer!]
		][
			1
		]
	--assert 1 = rr1-r

	--test-- "rr4"
		rr4-r: routine [
			return:			[logic!]
		][
			true
		]
	--assert rr4-r

===end-group===

===start-group=== "routine yo-yo tests"

	--test-- "ry1"
		ry1-r: routine [
			i			[integer!]
			return:		[integer!]
		][
			i
		]
	--assert 1 = ry1-r 1

	--test-- "ry4"
		ry4-r: routine [
			l				[logic!]
			return:			[logic!]
		][
			l
		]
	--assert ry4-r true
	--assert not ry4-r false

===end-group===

===start-group=== "routine return local tests"

	--test-- "rrl1"
		rrl1-r: routine [
			return:		[integer!]
			/local
			i			[integer!]
		][
			i: 1
			i
		]
	--assert 1 = rrl1-r

	--test-- "rrl4"
		rrl4-r: routine [
			return:			[logic!]
			/local
			l				[logic!]
		][
			l: true
			l
		]
	--assert rrl4-r true

===end-group===

===start-group=== "routine simple tests"

	--test-- "rs1"
		rs1-r: routine [
			i			[integer!]
			return:		[integer!]
		][
			i + 1
		]
	--assert 2 = rs1-r 1

	--test-- "rs4"
		rs4-r: routine [
			l				[logic!]
			return:			[logic!]
		][
			not l
		]
	--assert rs4-r false
	--assert not rs4-r true

===end-group===

===start-group=== "routine reported issues"

	--test-- "rri1 - issue #468"
		rri1-r: routine [
			return:			[integer!]
			/local
				b			[byte!]
				cp          [integer!]
		][
			cp: 1
			b: as byte! (cp >>> 6)
			cp: as integer! b
			cp
		]
	--assert 0 = rri1-r

===end-group===

~~~end-file~~~

Red [
	Title:   "Red function test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %routine-test.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2013 Nenad Rakocevic & 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.red

~~~start-file~~~ "routine"

===start-group=== "routine return tests"

	--test-- "rr1"
		rr1-r: routine [
			return:		[integer!]
		][
			1
		]
	--assert 1 = rr1-r

	--test-- "rr4"
		rr4-r: routine [
			return:			[logic!]
		][
			true
		]
	--assert rr4-r

===end-group===

===start-group=== "routine yo-yo tests"

	--test-- "ry1"
		ry1-r: routine [
			i			[integer!]
			return:		[integer!]
		][
			i
		]
	--assert 1 = ry1-r 1

	--test-- "ry4"
		ry4-r: routine [
			l				[logic!]
			return:			[logic!]
		][
			l
		]
	--assert ry4-r true
	--assert not ry4-r false

===end-group===

===start-group=== "routine return local tests"

	--test-- "rrl1"
		rrl1-r: routine [
			return:		[integer!]
			/local
			i			[integer!]
		][
			i: 1
			i
		]
	--assert 1 = rrl1-r

	--test-- "rrl4"
		rrl4-r: routine [
			return:			[logic!]
			/local
			l				[logic!]
		][
			l: true
			l
		]
	--assert rrl4-r true

===end-group===

===start-group=== "routine simple tests"

	--test-- "rs1"
		rs1-r: routine [
			i			[integer!]
			return:		[integer!]
		][
			i + 1
		]
	--assert 2 = rs1-r 1

	--test-- "rs4"
		rs4-r: routine [
			l				[logic!]
			return:			[logic!]
		][
			not l
		]
	--assert rs4-r false
	--assert not rs4-r true

===end-group===

~~~end-file~~~


FIX: issue #453 (FIND with a refinement value as search value won't compile)

Red/System [
	Title:   "Refinement! datatype runtime functions"
	Author:  "Nenad Rakocevic"
	File: 	 %refinement.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/red-system/runtime/BSL-License.txt
	}
]

refinement: context [
	verbose: 0

	load-in: func [
		str 	 [c-string!]
		blk		 [red-block!]
		return:	 [red-word!]
		/local
			cell [red-word!]
	][
		#if debug? = yes [if verbose > 0 [print-line "refinement/load"]]

		cell: word/load-in str blk
		cell/header: TYPE_REFINEMENT					;-- implicit reset of all header flags
		cell
	]

	load: func [
		str 	[c-string!]
		return:	[red-word!]
	][
		load-in str root
	]

	push: func [
		w  [red-word!]
	][
		#if debug? = yes [if verbose > 0 [print-line "refinement/push"]]

		w: word/push w
		set-type as red-value! w TYPE_REFINEMENT
	]

	push-local: func [
		ctx		[red-context!]
		index	[integer!]
		return: [red-refinement!]
		/local
			ref [red-refinement!]
	][
		ref: as red-refinement! word/push-local ctx index
		ref/header: TYPE_REFINEMENT
		ref
	]

	set: func [
		/local
			args [cell!]
	][
		#if debug? = yes [if verbose > 0 [print-line "refinement/set"]]

		args: stack/arguments
		_context/set as red-word! args args + 1
		stack/set-last args + 1
	]

	get: does [
		#if debug? = yes [if verbose > 0 [print-line "refinement/get"]]

		stack/set-last _context/get as red-word! stack/arguments
	]

	;-- Actions --

	mold: func [
		w	    [red-word!]
		buffer	[red-string!]
		only?	[logic!]
		all?	[logic!]
		flat?	[logic!]
		arg		[red-value!]
		part 	[integer!]
		return: [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "refinement/mold"]]

		string/append-char GET_BUFFER(buffer) as-integer #"/"
		word/form w buffer arg part - 1
	]

	compare: func [
		arg1	[red-word!]								;-- first operand
		arg2	[red-word!]								;-- second operand
		op		[integer!]								;-- type of comparison
		return:	[logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "refinement/compare"]]

		either op = COMP_STRICT_EQUAL [
			all [TYPE_OF(arg2) = TYPE_REFINEMENT arg1/symbol = arg2/symbol]
		][
			word/compare arg1 arg2 op
		]
	]

	datatype/register [
		TYPE_REFINEMENT
		TYPE_WORD
		"refinement!"
		;-- General actions --
		null			;make
		null			;random
		null			;reflect
		null			;to
		INHERIT_ACTION	;form
		:mold
		null			;get-path
		null			;set-path
		:compare
		;-- Scalar actions --
		null			;absolute
		null			;add
		null			;divide
		null			;multiply
		null			;negate
		null			;power
		null			;remainder
		null			;round
		null			;subtract
		null			;even?
		null			;odd?
		;-- Bitwise actions --
		null			;and~
		null			;complement
		null			;or~
		null			;xor~
		;-- Series actions --
		null			;append
		null			;at
		null			;back
		null			;change
		null			;clear
		null			;copy
		null			;find
		null			;head
		null			;head?
		null			;index?
		null			;insert
		null			;length?
		null			;next
		null			;pick
		null			;poke
		null			;remove
		null			;reverse
		null			;select
		null			;sort
		null			;skip
		null			;swap
		null			;tail
		null			;tail?
		null			;take
		null			;trim
		;-- I/O actions --
		null			;create
		null			;close
		null			;delete
		null			;modify
		null			;open
		null			;open?
		null			;query
		null			;read
		null			;rename
		null			;update
		null			;write
	]
]

Red/System [
	Title:   "Refinement! datatype runtime functions"
	Author:  "Nenad Rakocevic"
	File: 	 %refinement.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/red-system/runtime/BSL-License.txt
	}
]

refinement: context [
	verbose: 0

	load-in: func [
		str 	 [c-string!]
		blk		 [red-block!]
		return:	 [red-word!]
		/local
			cell [red-word!]
	][
		#if debug? = yes [if verbose > 0 [print-line "refinement/load"]]

		cell: word/load-in str blk
		cell/header: TYPE_REFINEMENT					;-- implicit reset of all header flags
		cell
	]

	load: func [
		str 	[c-string!]
		return:	[red-word!]
	][
		load-in str root
	]

	push: func [
		w  [red-word!]
	][
		#if debug? = yes [if verbose > 0 [print-line "refinement/push"]]

		w: word/push w
		set-type as red-value! w TYPE_REFINEMENT
	]

	set: func [
		/local
			args [cell!]
	][
		#if debug? = yes [if verbose > 0 [print-line "refinement/set"]]

		args: stack/arguments
		_context/set as red-word! args args + 1
		stack/set-last args + 1
	]

	get: does [
		#if debug? = yes [if verbose > 0 [print-line "refinement/get"]]

		stack/set-last _context/get as red-word! stack/arguments
	]

	;-- Actions --

	mold: func [
		w	    [red-word!]
		buffer	[red-string!]
		only?	[logic!]
		all?	[logic!]
		flat?	[logic!]
		arg		[red-value!]
		part 	[integer!]
		return: [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "refinement/mold"]]

		string/append-char GET_BUFFER(buffer) as-integer #"/"
		word/form w buffer arg part - 1
	]

	compare: func [
		arg1	[red-word!]								;-- first operand
		arg2	[red-word!]								;-- second operand
		op		[integer!]								;-- type of comparison
		return:	[logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "refinement/compare"]]

		either op = COMP_STRICT_EQUAL [
			all [TYPE_OF(arg2) = TYPE_REFINEMENT arg1/symbol = arg2/symbol]
		][
			word/compare arg1 arg2 op
		]
	]

	datatype/register [
		TYPE_REFINEMENT
		TYPE_WORD
		"refinement!"
		;-- General actions --
		null			;make
		null			;random
		null			;reflect
		null			;to
		INHERIT_ACTION	;form
		:mold
		null			;get-path
		null			;set-path
		:compare
		;-- Scalar actions --
		null			;absolute
		null			;add
		null			;divide
		null			;multiply
		null			;negate
		null			;power
		null			;remainder
		null			;round
		null			;subtract
		null			;even?
		null			;odd?
		;-- Bitwise actions --
		null			;and~
		null			;complement
		null			;or~
		null			;xor~
		;-- Series actions --
		null			;append
		null			;at
		null			;back
		null			;change
		null			;clear
		null			;copy
		null			;find
		null			;head
		null			;head?
		null			;index?
		null			;insert
		null			;length?
		null			;next
		null			;pick
		null			;poke
		null			;remove
		null			;reverse
		null			;select
		null			;sort
		null			;skip
		null			;swap
		null			;tail
		null			;tail?
		null			;take
		null			;trim
		;-- I/O actions --
		null			;create
		null			;close
		null			;delete
		null			;modify
		null			;open
		null			;open?
		null			;query
		null			;read
		null			;rename
		null			;update
		null			;write
	]
]