TESTS: additional function tests (includes reflection tests).

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

;; start of quick-test
;; 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
]

;; end of quick test

~~~start-file~~~ "function"

===start-group=== "Basic function tests"

	--test-- "fun-1"
		foo1: func [][1]
		--assert 1 = foo1

	--test-- "fun-2"
		foo2: func [a][a]
		--assert 5 = foo2 5
		--assert "a" = foo2 "a"
		--assert [123] = foo2 [123]

	--test-- "fun-3"
		foo3: func [a /local c][c: 1 a + c]
		--assert 3 = foo3 2

	--test-- "fun-4"
		foo4: func [a /ref][either ref [a][0]]
		--assert 0 = foo4 5
		--assert 5 = foo4/ref 5

	--test-- "fun-5"
		foo5: func [a /ref b][if ref [a: a + b] a * 2]
		--assert 10 = foo5 5
		--assert 16 = foo5/ref 5 3

	--test-- "fun-6"
		z: 10
		foo6: func [a [integer!] b [integer!] /ref d /local c][
			c: 2
			unless ref [d: 0]
			a + b * c + z + d
		]

		--assert 16 = foo6 1 2
		--assert 21 = foo6/ref 1 2 5

	--test-- "fun-7"
		bar:  func [] [foo7]
		foo7: func [] [42]
		--assert 42 = bar

	--test-- "fun-8"
		foo8: func ['a :b][
			--assert a = 'test
			--assert "(1 + 2)" = mold b
		]
		foo8 test (1 + 2)

	--test-- "fun-9"
		foo9: func [/local cnt][
			cnt: [0]
			cnt/1: cnt/1 + 1
		]
		--assert 1 = foo9
		--assert 2 = foo9
		--assert 3 = foo9

	--test-- "fun-10"
		foo10: func [a][a + 0]
		foo10: func [][1]
		--assert 1 = foo10 "dummy"						;-- make it crash if wrong function referenced

===end-group===

===start-group=== "Alternate constructor tests"

	--test-- "fun-alt-1"
		z: 0
		alt1: function [a][
			z: 2
			a + z
		]
		--assert 10 = alt1 8
		--assert z = 0

	--test-- "fun-alt-2"
		alt2: does [123]
		--assert 123 = alt2

	--test-- "fun-alt-3"
		alt3: has [c][c: 1 c]
		--assert 1 = alt3

===end-group===

===start-group=== "Exit and Return tests"

	--test-- "fun-exit-1"
		ex1: does [123 exit 0]
		--assert unset! = type? ex1

	--test-- "fun-exit-2"
		ex2: does [if true [exit] 0]
		--assert unset! = type? ex2

	--test-- "fun-exit-3"
		ex3: does [until [if true [if true [exit]] true] 0]
		--assert unset! = type? ex3

	--test-- "fun-ret-1"
		ret1: does [return true]
		--assert ret1

	--test-- "fun-ret-2"
		ret2: does [return 123]
		--assert 123 = ret2

	--test-- "fun-ret-3"
		ret3: does [if true [return 3]]
		--assert 3 = ret3

	--test-- "fun-ret-4"
		ret4: does [return 1 + 1]
		--assert 2 = ret4

	--test-- "fun-ret-5"
		ret5: does [return either false [12][34]]
		--assert 34 = ret5

	--test-- "fun-ret-6"
		ret6: func [i [integer!]][
			until [
				if true [
					if i = 0 [
						if true [return 0]
						return 1
					]
					return 2
				]
				return 3
				true
			]
		]
		--assert 0 = ret6 0
		--assert 2 = ret6 1

===end-group===

===start-group=== "Reflection"

	--test-- "fun-ref-1"
		ref1: func [a b][a + b]
		--assert [a b] = spec-of :ref1
		--assert [a + b] = body-of :ref1

	--test-- "fun-ref-2"
		--assert (spec-of :append) = [
			series [series!] value [any-type!] /part length [number! series!]
			/only /dup count [number!] return: [series!]
		]

	--test-- "fun-ref-3"
		--assert (spec-of :set) = [word [lit-word!] /any value [any-type!] return: [any-type!]]

	--test-- "fun-ref-4"
		--assert (spec-of :<) = [value1 [any-type!] value2 [any-type!]]

===end-group===

~~~end-file~~~

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

;; start of quick-test
;; 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
]

;; end of quick test

~~~start-file~~~ "function"

===start-group=== "Basic function tests"

	--test-- "fun-1"
		foo1: func [][1]
		--assert 1 = foo1

	--test-- "fun-2"
		foo2: func [a][a]
		--assert 5 = foo2 5
		--assert "a" = foo2 "a"
		--assert [123] = foo2 [123]

	--test-- "fun-3"
		foo3: func [a /local c][c: 1 a + c]
		--assert 3 = foo3 2

	--test-- "fun-4"
		foo4: func [a /ref][either ref [a][0]]
		--assert 0 = foo4 5
		--assert 5 = foo4/ref 5

	--test-- "fun-5"
		foo5: func [a /ref b][if ref [a: a + b] a * 2]
		--assert 10 = foo5 5
		--assert 16 = foo5/ref 5 3

	--test-- "fun-6"
		z: 10
		foo6: func [a [integer!] b [integer!] /ref d /local c][
			c: 2
			unless ref [d: 0]
			a + b * c + z + d
		]

		--assert 16 = foo6 1 2
		--assert 21 = foo6/ref 1 2 5

	--test-- "fun-7"
		bar:  func [] [foo7]
		foo7: func [] [42]
		--assert 42 = bar

	--test-- "fun-8"
		foo8: func ['a :b][
			--assert a = 'test
			--assert "(1 + 2)" = mold b
		]
		foo8 test (1 + 2)

	--test-- "fun-9"
		foo9: func [/local cnt][
			cnt: [0]
			cnt/1: cnt/1 + 1
		]
		--assert 1 = foo9
		--assert 2 = foo9
		--assert 3 = foo9

===end-group===

===start-group=== "Alternate constructor tests"

	--test-- "fun-alt-1"
		z: 0
		alt1: function [a][
			z: 2
			a + z
		]
		--assert 10 = alt1 8
		--assert z = 0

	--test-- "fun-alt-2"
		alt2: does [123]
		--assert 123 = alt2

	--test-- "fun-alt-3"
		alt3: has [c][c: 1 c]
		--assert 1 = alt3

===end-group===

===start-group=== "Exit and Return tests"

	--test-- "fun-exit-1"
		ex1: does [123 exit 0]
		--assert unset! = type? ex1

	--test-- "fun-exit-2"
		ex2: does [if true [exit] 0]
		--assert unset! = type? ex2

	--test-- "fun-exit-3"
		ex3: does [until [if true [if true [exit]] true] 0]
		--assert unset! = type? ex3

	--test-- "fun-ret-1"
		ret1: does [return true]
		--assert ret1

	--test-- "fun-ret-2"
		ret2: does [return 123]
		--assert 123 = ret2

	--test-- "fun-ret-3"
		ret3: does [if true [return 3]]
		--assert 3 = ret3

	--test-- "fun-ret-4"
		ret4: does [return 1 + 1]
		--assert 2 = ret4

	--test-- "fun-ret-5"
		ret5: does [return either false [12][34]]
		--assert 34 = ret5

	--test-- "fun-ret-6"
		ret6: does [
			until [
				if true [
					if true [
						if true [return 0]
						return 1
					]
					return 2
				]
				return 3
				true
			]
		]
		--assert 0 = ret6

===end-group===

===start-group=== "Reflection"

===end-group===

~~~end-file~~~


TESTS: reformat case-test.reds

TESTS: reformat case-test.reds

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

~~~start-file~~~ "case"

===start-group=== "case basics"

	--test-- "case-basic-1"
		ci:  0
		cia: 1
		case [true [0]]
		--assert cia = 1

	--test-- "case-basic-2"
		ci:  1
		cia: 2
		case [ci = 1 [cia: 2]]
		--assert cia = 2

	--test-- "case-basic-3"
		ci:  1
		cia: 2
		case [true [cia: 3]]
		--assert cia = 3

	--test-- "case-basic-4"
	ci:  0
	cia: 2
	case [ci <> 0 [cia: 0] true [cia: 3]]
	--assert cia = 3

	--test-- "case-basic-5"
		ci:  99
		cia: 2
		case [ci = 1 [cia: 2] true [cia: 3]]
		--assert cia = 3

	--test-- "case-basic-6"
		ci:  0
		cia: 1
		cia: case [true [2]]
		--assert cia = 2

	--test-- "case-basic-7"
		ci:  0
		cia: 2
		cia: case [ci <> 0 [0] true [3]]
		--assert cia = 3

	--test-- "case-basic-8"
		ci:  1
		cia: 2
		cia: case [ci = 1 [3]]
		--assert cia = 3

	--test-- "case-basic-9"
		ci:  1
		cia: 2
		case [ci = 1 [case [ci <> 0 [cia: 3] true [cia: 4]]]]
		--assert cia = 3

	--test-- "case-basic-10"
		ci:  1
		cia: 2
		cia: case [ci = 1 [case [ci <> 0 [3] true [4]]]]
		--assert cia = 3

	--test-- "case-basic-11"
		ci:  1
		cia: 2
		cia: case [ci = 1 [switch ci [1 [3] default [4]]]]
		--assert cia = 3

===end-group===

===start-group=== "case basics local"

	case-fun: func [/local ci cia][
		--test-- "case-loc-1"
			ci:  0
			cia: 1
			case [true [0]]
			--assert cia = 1

		--test-- "case-loc-2"
			ci:  1
			cia: 2
			case [ci = 1 [cia: 2]]
			--assert cia = 2

		--test-- "case-loc-3"
			ci:  1
			cia: 2
			case [true [cia: 3]]
			--assert cia = 3

		--test-- "case-loc-4"
			ci:  0
			cia: 2
			case [ci <> 0 [cia: 0] true [cia: 3]]
			--assert cia = 3

		--test-- "case-loc-5"
			ci:  99
			cia: 2
			case [ci = 1 [cia: 2] true [cia: 3]]
			--assert cia = 3

		--test-- "case-loc-6"
			ci:  0
			cia: 1
			cia: case [true [2]]
			--assert cia = 2

		--test-- "case-loc-7"
			ci:  0
			cia: 2
			cia: case [ci <> 0 [0] true [3]]
			--assert cia = 3

		--test-- "case-loc-8"
			ci:  1
			cia: 2
			cia: case [ci = 1 [3]]
			--assert cia = 3

		--test-- "case-loc-9"
			ci:  1
			cia: 2
			case [ci = 1 [case [ci <> 0 [cia: 3] true [cia: 4]]]]
			--assert cia = 3

		--test-- "case-loc-10"
			ci:  1
			cia: 2
			cia: case [ci = 1 [case [ci <> 0 [3] true [4]]]]
			--assert cia = 3

		--test-- "case-loc-11"
			ci:  1
			cia: 2
			cia: case [ci = 1 [switch ci [1 [3] default [4]]]]
			--assert cia = 3
	]
	case-fun

===end-group===

===start-group=== "case integer!"

	#define case-int-1 [case [ ci = 1 [cia: 1] ci = 2 [cia: 2] true [cia: 3]]]

	--test-- "case-int-1"
		ci: 1
		cia: 0
		case-int-1
		--assert 1 = cia

	--test-- "case-int-2"
		ci: 2
		cia: 0
		case-int-1
		--assert 2 = cia

	--test-- "case-int-3"
		ci: 3
		cia: 0
		case-int-1
		--assert 3 = cia

	--test-- "case-int-4"
		ci: 9
		cia: 0
		case-int-1
		--assert 3 = cia

	#define case-int-2 [case [ ci = 1 [1] ci = 2 [2] true [3]]]

	--test-- "case-int-5"
		ci: 1
		--assert 1 = case-int-2

	--test-- "case-int-6"
		ci: 1
		cres: case-int-2
		--assert 1 = cres

	--test-- "case-int-7"
		ci: 2
		--assert 2 = case-int-2

	--test-- "case-int-8"
		ci: 2
		cres: case-int-2
		--assert 2 = cres

	--test-- "case-int-9"
		ci: 3
		--assert 3 = case-int-2

	--test-- "case-int-10"
		ci: 3
		cres: case-int-2
		--assert 3 = cres

	--test-- "case-int-11"
		ci: 10
		--assert 3 = case-int-2

	--test-- "case-int-12"
		ci: 10
		cres: case-int-2
		--assert 3 = cres

	#define case-int-3 [case [ ci = 1 [cia: 1] ci = 2 [cia: 2] true [cia: 3]] ]

	--test-- "case-int-13"
		ci: 1
		cia: 0
		--assert 1 = case-int-3

	--test-- "case-int-14"
		ci: 1
		cia: 0
		cres: case-int-3
		--assert 1 = cres

	--test-- "case-int-15"
		ci: 2
		cia: 0
		--assert 2 = case-int-3

	--test-- "case-int-16"
		ci: 2
		cia: 0
		cres: case-int-3
		--assert 2 = cres

	--test-- "case-int-17"
		ci: 3
		cia: 0
		--assert 3 = case-int-3

	--test-- "case-int-18"
		ci: 3
		cia: 0
		cres: case-int-3
		--assert 3 = cres

	--test-- "case-int-19"
		ci: 9
		cia: 0
		--assert 3 = case-int-3

	--test-- "case-int-20"
		ci: 9
		cia: 0
		cres: case-int-3
		--assert 3 = cres

===end-group===

===start-group=== "case byte!"

	#define case-byte-1 [case [ cb = #"1" [cba: #"1"] cb = #"2" [cba: #"2"] true [cba: #"3"]]]

	--test-- "case-byte-1"
		cb: #"1"
		cba: #"0"
		case-byte-1
		--assert #"1" = cba

	--test-- "case-byte-2"
		cb: #"2"
		cba: #"0"
		case-byte-1
		--assert #"2" = cba

	--test-- "case-byte-3"
		cb: #"3"
		cba: #"0"
		case-byte-1
		--assert #"3" = cba

	--test-- "case-byte-4"
		cb: #"9"
		cba: #"0"
		case-byte-1
		--assert #"3" = cba

	#define case-byte-2 [case [ cb = #"1" [#"1"] cb = #"2" [#"2"] true [#"3"]]]

	--test-- "case-byte-5"
		cb: #"1"
		--assert #"1" = case-byte-2

	--test-- "case-byte-6"
		cb: #"1"
		cbres: case-byte-2
		--assert #"1" = cbres

	--test-- "case-byte-7"
		cb: #"2"
		--assert #"2" = case-byte-2

	--test-- "case-byte-8"
		cb: #"2"
		cbres: case-byte-2
		--assert #"2" = cbres

	--test-- "case-byte-9"
		cb: #"3"
		--assert #"3" = case-byte-2

	--test-- "case-byte-10"
		cb: #"3"
		cbres: case-byte-2
		--assert #"3" = cbres

	--test-- "case-byte-11"
		cb: #"9"
		--assert #"3" = case-byte-2

	--test-- "case-byte-12"
		cb: #"9"
		cbres: case-byte-2
		--assert #"3" = cbres

	#define case-byte-3 [case [ cb = #"1" [cba: #"1"] cb = #"2" [cba: #"2"] true [cba: #"3"]] ]

	--test-- "case-byte-13"
		cb: #"1"
		cba: #"0"
		--assert #"1" = case-byte-3

	--test-- "case-byte-14"
		cb: #"1"
		cba: #"0"
		cbres: case-byte-3
		--assert #"1" = cbres

	--test-- "case-byte-15"
		cb: #"2"
		cba: #"0"
		--assert #"2" = case-byte-3

	--test-- "case-byte-16"
		cb: #"2"
		cba: #"0"
		cbres: case-byte-3
		--assert #"2" = cbres

	--test-- "case-byte-17"
		cb: #"3"
		cba: #"0"
		--assert #"3" = case-byte-3

	--test-- "case-byte-18"
		cb: #"3"
		cba: #"0"
		cbres: case-byte-3
		--assert #"3" = cbres

	--test-- "case-byte-19"
		cb: #"9"
		cba: #"0"
		--assert #"3" = case-byte-3

	--test-- "case-byte-20"
		cb: #"9"
		cba: #"0"
		cbres: case-byte-3
		--assert #"3" = cbres

===end-group===

===start-group=== "case logic!"

	--test-- "case-logic-1"
		cl: true
		--assert case [ cl = true [true] cl = false [false] true [false]]

	--test-- "case-logic-2"
		cl: false
	--assert false = case [ cl = true [true] cl = false [false] true [true]]

===end-group===

~~~end-file~~~


TESTS: added c-string to logic tests in cast-test.reds

Red/System [
	Title:   "Red/System datatype casting test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %cast-test.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2015 Nenad Rakocevic & 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.reds

~~~start-file~~~ "cast"

===start-group=== "cast from byte!"

	--test-- "byte-cast-1"
	--assert 65 = as integer! #"A"

	--test-- "byte-cast-2"
		cast-b: #"A"
		cast-i: 65
		--assert cast-i = as integer! cast-b

	--test-- "byte-cast-3"
		--assert false = as logic! #"^(00)"

	--test-- "byte-cast-4"
		cast-b: #"^(00)"
		l: false
		--assert l = as logic! cast-b

	--test-- "byte-cast-5"
		--assert true = as logic! #"A"

	--test-- "byte-cast-6"
		  cast-b: #"A"
		  l: true
		  --assert l = as logic! cast-b

	--test-- "byte-cast-7"
		--assert true = as logic! #"^(FF)"

	--test-- "byte-cast-8"
		  cast-b: #"^(FF)"
		  l: true
		  --assert l = as logic! cast-b

	--test-- "byte-cast-9"							;-- issue #158
		  a: as-byte 10h
		  b: as-byte 80h
	  --assert 10h = as-integer a

	--test-- "byte-cast-10"							;-- issue #159
		  a: as-byte 10h
		  b: as-byte 80h
		  c: as-integer a
		  --assert 10h = c

	--test-- "byte-cast-11"							;-- issue #160
		  a: as-byte 1
		  b: as-byte 2
		  --assert (as byte-ptr! (as-integer a) * 2) = (as byte-ptr! 2)
		  --assert (as byte-ptr! (as-integer a) << 2) = (as byte-ptr! 4)

	--test-- "byte-cast-12"							;-- issue #161
		  a: as-byte 1
		  b: as-byte 2
		  c: (as-integer b) << 16 or as-integer a
		  --assert 00020001h = c

	--test-- "byte-cast-13"							;-- issue #162
		sb: declare struct! [
			a   [byte!]
			b   [byte!]
		]
		sb/a: as-byte 0
		sb/b: as-byte 1
		--assert not as-logic sb/a

	--test-- "byte-cast-13"							;-- issue #150
		s!: alias struct! [
			a   [byte!]
			b   [byte!]
			c   [byte!]
			d   [byte!]
		]
		t: declare s!
		t/a: as-byte 1
		t/b: as-byte 1
		t/c: as-byte 0
		t/d: as-byte 0
		h: as-integer t/a
		--assert h = 1

	--test-- "byte-cast-14"              ;-- issue 317
		bc14-a: as byte! 1
		bc14-b: as byte! 2
		bc14-c: as byte! 3
		bc14-d: as byte! 4
		bc14-e: as byte! 5
		bc14-a: as byte! 0
		--assert #"^(00)" = bc14-a
		--assert #"^(02)" = bc14-b
		--assert #"^(03)" = bc14-c
		--assert #"^(04)" = bc14-d
		--assert #"^(05)" = bc14-e

===end-group===

===start-group=== "cast from integer!"

	--test-- "int-cast-1"
		--assert #"^(00)" = as byte! 0

	--test-- "int-cast-2"
		i: 0
		cast-test-b: #"^(00)"
		--assert cast-test-b = as byte! i

	--test-- "int-cast-3"
		--assert #"^(01)" = as byte! 1

	--test-- "int-cast-4"
		i: 1
		cast-test-b: #"^(01)"
		--assert cast-test-b = as byte! i

	--test-- "int-cast-5"
		--assert #"^(FF)" = as byte! 255

	--test-- "int-cast-6"
		i: 255
		cast-test-b: #"^(FF)"
		--assert cast-test-b = as byte! i

	--test-- "int-cast-7"
		--assert #"^(00)" = as byte! 256

	--test-- "int-cast-8"
		i: 256
		cast-test-b: #"^(00)"
		--assert cast-test-b = as byte! i

	--test-- "int-cast-9"
	--assert false = as logic! 0

	--test-- "int-cast-10"
		i: 0
		l: false
		--assert l = as logic! i

	--test-- "int-cast-11"
		--assert true = as logic! FFFFFFFFh

	--test-- "int-cast-12"
		i: FFFFFFFFh
		l: true
		--assert l = as logic! i

	--test-- "int-cast-13"
		--assert true = as logic! 1

	--test-- "int-cast-14"
		i: 1
		l: true
		--assert l = as logic! i

	--test-- "int-cast-15"
		cs: "Hello"
		cs2: ""
		i: as integer! cs
		i: i + 1
		cs2: as c-string! i
		--assert cs2/1 = #"e"
		--assert 4 = length? cs2

	--test-- "int-cast-16"           ;; This test assumes 32-bit target
		i: 1
		p: declare pointer! [integer!]
		p: as [pointer! [integer!]] i
		p: p + 1
		i2: as integer! p
		--assert i2 = 5

	--test-- "int-cast-17"           ;; This test assumes 32-bit target
		i: 1
		p-int-cast-17: as [pointer! [integer!]] i
		p-int-cast-17: p-int-cast-17 + 1
		i2: as integer! p-int-cast-17
		--assert i2 = 5

	--test-- "int-cast-18"
		i: 1
		s: declare struct! [
			a [integer!]
			b [integer!]
		]
		s: as [struct! [a [integer!] b [integer!]]] i
		s: s + 1
		i2: as integer! s
		--assert i2 = 9

	--test-- "int-cast-19"
		ic19-logic: either as-logic 0 [
			false
		][
			true
		]
		--assert ic19-logic

	--test-- "int-cast-20"
		ic20-dummy: func [return: [integer!]][0]
		ic20-logic: either as-logic ic20-dummy [
			false
		][
			true
		]
		--assert ic20-logic

===end-group===

===start-group=== "cast from logic!"

	--test-- "logic-cast-1"
		--assert #"^(01)" = as byte! true

	--test-- "logic-cast-2"
		cast-test-b: #"^(01)"
		l: true
		--assert cast-test-b = as byte! l

	--test-- "logic-cast-3"
		--assert #"^(00)" = as byte! false

	--test-- "logic-cast-4"
		cast-test-b: #"^(00)"
		l: false
		--assert cast-test-b = as byte! l

	--test-- "logic-cast-5"
		--assert 1 = as integer! true

	--test-- "logic-cast-6"
		i: 1
		l: true
		--assert i = as integer! l

	--test-- "logic-cast-7"
		--assert 0 = as integer! false

	--test-- "logic-cast-8"
		i: 0
		l: false
		--assert i = as integer! l

===end-group===

===start-group=== "cast c-string! tests"

	--test-- "c-string-cast-1"
		csc1-str: "Hello, Nenad"
		i: 0
		i: as integer! csc1-str
		i: i + 7
		csc1-str: as c-string! i
		--assert csc1-str/1 = #"N"
		--assert csc1-str/2 = #"e"
		--assert csc1-str/3 = #"n"
		--assert csc1-str/4 = #"a"
		--assert csc1-str/5 = #"d"

		--test-- "c-string-cast-2"
			--assert true = as logic! ""

	--test-- "c-string-cast-3"
		csc3-str: ""
		--assert true = as logic! csc3-str

	--test-- "c-string-cast-4"
		--assert true = as logic! "Any old iron, any old iron"

	--test-- "c-string-cast-5"
		csc5-str: "Why not?"
		--assert true = as logic! csc5-str

	--test-- "c-string-cast-6"
		csc6-str: "Tour de France"
		csc6-p: declare pointer! [integer!]
		csc6-p: as [pointer! [integer!]] csc6-str
		csc6-p: csc6-p + 2
		csc6-str2: as c-string! csc6-p
		--assert csc6-str2/1 = #"F"
		--assert csc6-str2/2 = #"r"
		--assert csc6-str2/3 = #"a"
		--assert csc6-str2/4 = #"n"
		--assert csc6-str2/5 = #"c"
		--assert csc6-str2/6 = #"e"

	--test-- "C-string-cast-7"
		csc7-struct: declare struct! [
			c1 [byte!]
			c2 [byte!]
			c3 [byte!]
			c4 [byte!]
			c5 [byte!]
		]
		csc7-str: "Peter"
		csc7-struct: as [struct! [
			c1 [byte!] c2 [byte!] c3 [byte!] c4 [byte!] c5 [byte!]
		]] csc7-str
		--assert csc7-struct/c1 = #"P"
		--assert csc7-struct/c2 = #"e"
		--assert csc7-struct/c3 = #"t"
		--assert csc7-struct/c4 = #"e"
		--assert csc7-struct/c5 = #"r"

	--test-- "C-string-cast-8"
		csc8-p: declare byte-ptr!
		csc8-p: null
		csc8-s: as c-string! csc8-p
		--assert false = as logic! csc8-s

===end-group===

===start-group=== "cast from pointer!"

	--test-- "csp-1"
		csp1-p: declare pointer! [integer!]
		csp1-p: as [pointer! [integer!]] 256
		i: 0
		i: as integer! csp1-p
		--assert i = 256

	--test-- "csp-2"
		csp2-p: declare pointer! [integer!]
		csp2-p: as [pointer! [integer!]] 0
		--assert false = as logic! csp2-p

	--test-- "csp-3"
		csp3-p: declare pointer! [integer!]
		csp3-p: as [pointer! [integer!]] 1
		--assert true = as logic! csp3-p

	--test-- "csp-4"
		csp4-p: declare pointer! [integer!]
		csp4-p: as [pointer! [integer!]] FFFFFFFFh
		--assert true = as logic! csp4-p

	--test-- "csp-5"
		csp5-p: declare pointer! [integer!]
		csp5-p: as [pointer! [integer!]] 7FFFFFFFh
		--assert true = as logic! csp5-p

  ;; No test for pointer! to c-string! as it would simply
  ;;  duplicate the one of c-string! to pointer!

	--test-- "csp-6"
		csp6-p: declare pointer! [integer!]
		csp6-s: declare struct! [
			a [integer!]
			b [integer!]
		]
		csp6-s/a: 1
		csp6-s/b: 2
		csp6-p: as [pointer! [integer!]] csp6-s
		--assert csp6-p/value = 1
		csp6-p: csp6-p + 1
		--assert csp6-p/value = 2
		csp6-p: csp6-p - 1
		csp6-s: as [struct! [a [integer!] b [integer!]]] csp6-p
		--assert csp6-s/a = 1
		csp6-p: csp6-p + 1
		csp6-s: as [struct! [a [integer!] b [integer!]]] csp6-p
		--assert csp6-s/a = 2

===end-group===

===start-group=== "cast from struct!"

  ;; no test for cast to integer as it would simply
  ;;  duplicate the test from integer! to struct!

	--test-- "cfstruc-1"
		cfs1-struct: declare struct! [
			a [integer!]
			b [integer!]
		]
		cfs1-struct: as [struct! [a [integer!] b [integer!]]] 0
		--assert false = as logic! cfs1-struct

	--test-- "cfstruc-2"
		cfs2-struct: declare struct! [
			a [integer!]
			b [integer!]
		]
		--assert true = as logic! cfs2-struct

  ;; no test for cast to c-string! as it would simply
  ;;  duplicate the test from c-string! to struct!

  ;; no test for cast to pointer! as it would simply
  ;;  duplicate the test from pointer! to struct!

===end-group===

===start-group=== "byte-integer-cast"

	--test-- "bic-1"
		bic-a: as-byte 1
		--assert 1 = as-integer bic-a

	--test-- "bic-2"
		bic-a: as-byte 1
		--assert 65536 = ((as-integer bic-a) << 16)

	--test-- "bic-3"
		bic-a: as-byte 2
		--assert 131072 = ((as-integer bic-a) << 16)

	--test-- "bic-4"
		bic-a: #"^(01)"
		--assert 65537 = (65536 or (as-integer bic-a))

	--test-- "bic-5"
		bic-a: #"^(01)"
		bic-b: #"^(02)"
		--assert 131073 = ((as-integer bic-b) << 16 or as-integer bic-a)

	--test-- "bic-6"
		bic-a: #"^(01)"
		bic-b: #"^(02)"
		--assert 131073 = ((as-integer bic-b) << 16 or as-integer bic-a)

	--test-- "bic-7"
		bic-a: #"^(01)"
		bic-b: #"^(02)"
		--assert (as byte-ptr! 131073) = as byte-ptr! ((as-integer bic-b) << 16 or as-integer bic-a)

	--test-- "bic-8"
		bic-a: as-byte 1
		bic-b: as-byte 2
		--assert 131073 = ((as-integer bic-b) << 16 or as-integer bic-a)

	--test-- "bic-9"
		bic-a: as-byte 1
		bic-b: as-byte 2
		--assert (as byte-ptr! 131073) = as byte-ptr! ((as-integer bic-b) << 16 or as-integer bic-a)

	--test-- "bic-10"
		bic-s: declare struct! [
			bic-a [byte!]
			bic-b [byte!]
			bic-c [integer!]
			bic-d [byte!]
			bic-e [byte!]
			bic-f [integer!]
		]
		bic-s/bic-a: as-byte 0
		bic-s/bic-b: as-byte 1
		bic-s/bic-c: 2
		bic-s/bic-d: as-byte 3
		bic-s/bic-e: as-byte 255
		bic-s/bic-f: 255
		--assert false = as-logic bic-s/bic-a
		--assert true = as-logic bic-s/bic-b
		--assert bic-s/bic-e = as-byte bic-s/bic-f
		--assert bic-s/bic-f = as-integer bic-s/bic-e

===end-group===

===start-group=== "Cast in conditional tests"
		cic-r: false
	--test-- "cic-1"
		cic-d: as-byte 0
		either as-logic cic-d [cic-r: false] [cic-r: true]
		--assert cic-r

	--test-- "cic-2"
		cic-s: declare struct! [
			a   [byte!]
			b   [byte!]
		]
		cic-s/a: as-byte 0
		cic-s/b: as-byte 1
		either as-logic cic-s/a [cic-r: false] [cic-r: true]
		--assert cic-r

===end-group===

~~~end-file~~~

Red/System [
	Title:   "Red/System datatype casting test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %cast-test.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2015 Nenad Rakocevic & 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.reds

~~~start-file~~~ "cast"

===start-group=== "cast from byte!"

	--test-- "byte-cast-1"
	--assert 65 = as integer! #"A"

	--test-- "byte-cast-2"
		cast-b: #"A"
		cast-i: 65
		--assert cast-i = as integer! cast-b

	--test-- "byte-cast-3"
		--assert false = as logic! #"^(00)"

	--test-- "byte-cast-4"
		cast-b: #"^(00)"
		l: false
		--assert l = as logic! cast-b

	--test-- "byte-cast-5"
		--assert true = as logic! #"A"

	--test-- "byte-cast-6"
		  cast-b: #"A"
		  l: true
		  --assert l = as logic! cast-b

	--test-- "byte-cast-7"
		--assert true = as logic! #"^(FF)"

	--test-- "byte-cast-8"
		  cast-b: #"^(FF)"
		  l: true
		  --assert l = as logic! cast-b

	--test-- "byte-cast-9"							;-- issue #158
		  a: as-byte 10h
		  b: as-byte 80h
	  --assert 10h = as-integer a

	--test-- "byte-cast-10"							;-- issue #159
		  a: as-byte 10h
		  b: as-byte 80h
		  c: as-integer a
		  --assert 10h = c

	--test-- "byte-cast-11"							;-- issue #160
		  a: as-byte 1
		  b: as-byte 2
		  --assert (as byte-ptr! (as-integer a) * 2) = (as byte-ptr! 2)
		  --assert (as byte-ptr! (as-integer a) << 2) = (as byte-ptr! 4)

	--test-- "byte-cast-12"							;-- issue #161
		  a: as-byte 1
		  b: as-byte 2
		  c: (as-integer b) << 16 or as-integer a
		  --assert 00020001h = c

	--test-- "byte-cast-13"							;-- issue #162
		sb: declare struct! [
			a   [byte!]
			b   [byte!]
		]
		sb/a: as-byte 0
		sb/b: as-byte 1
		--assert not as-logic sb/a

	--test-- "byte-cast-13"							;-- issue #150
		s!: alias struct! [
			a   [byte!]
			b   [byte!]
			c   [byte!]
			d   [byte!]
		]
		t: declare s!
		t/a: as-byte 1
		t/b: as-byte 1
		t/c: as-byte 0
		t/d: as-byte 0
		h: as-integer t/a
		--assert h = 1

	--test-- "byte-cast-14"              ;-- issue 317
		bc14-a: as byte! 1
		bc14-b: as byte! 2
		bc14-c: as byte! 3
		bc14-d: as byte! 4
		bc14-e: as byte! 5
		bc14-a: as byte! 0
		--assert #"^(00)" = bc14-a
		--assert #"^(02)" = bc14-b
		--assert #"^(03)" = bc14-c
		--assert #"^(04)" = bc14-d
		--assert #"^(05)" = bc14-e

===end-group===

===start-group=== "cast from integer!"

	--test-- "int-cast-1"
		--assert #"^(00)" = as byte! 0

	--test-- "int-cast-2"
		i: 0
		cast-test-b: #"^(00)"
		--assert cast-test-b = as byte! i

	--test-- "int-cast-3"
		--assert #"^(01)" = as byte! 1

	--test-- "int-cast-4"
		i: 1
		cast-test-b: #"^(01)"
		--assert cast-test-b = as byte! i

	--test-- "int-cast-5"
		--assert #"^(FF)" = as byte! 255

	--test-- "int-cast-6"
		i: 255
		cast-test-b: #"^(FF)"
		--assert cast-test-b = as byte! i

	--test-- "int-cast-7"
		--assert #"^(00)" = as byte! 256

	--test-- "int-cast-8"
		i: 256
		cast-test-b: #"^(00)"
		--assert cast-test-b = as byte! i

	--test-- "int-cast-9"
	--assert false = as logic! 0

	--test-- "int-cast-10"
		i: 0
		l: false
		--assert l = as logic! i

	--test-- "int-cast-11"
		--assert true = as logic! FFFFFFFFh

	--test-- "int-cast-12"
		i: FFFFFFFFh
		l: true
		--assert l = as logic! i

	--test-- "int-cast-13"
		--assert true = as logic! 1

	--test-- "int-cast-14"
		i: 1
		l: true
		--assert l = as logic! i

	--test-- "int-cast-15"
		cs: "Hello"
		cs2: ""
		i: as integer! cs
		i: i + 1
		cs2: as c-string! i
		--assert cs2/1 = #"e"
		--assert 4 = length? cs2

	--test-- "int-cast-16"           ;; This test assumes 32-bit target
		i: 1
		p: declare pointer! [integer!]
		p: as [pointer! [integer!]] i
		p: p + 1
		i2: as integer! p
		--assert i2 = 5

	--test-- "int-cast-17"           ;; This test assumes 32-bit target
		i: 1
		p-int-cast-17: as [pointer! [integer!]] i
		p-int-cast-17: p-int-cast-17 + 1
		i2: as integer! p-int-cast-17
		--assert i2 = 5

	--test-- "int-cast-18"
		i: 1
		s: declare struct! [
			a [integer!]
			b [integer!]
		]
		s: as [struct! [a [integer!] b [integer!]]] i
		s: s + 1
		i2: as integer! s
		--assert i2 = 9

	--test-- "int-cast-19"
		ic19-logic: either as-logic 0 [
			false
		][
			true
		]
		--assert ic19-logic

	--test-- "int-cast-20"
		ic20-dummy: func [return: [integer!]][0]
		ic20-logic: either as-logic ic20-dummy [
			false
		][
			true
		]
		--assert ic20-logic

===end-group===

===start-group=== "cast from logic!"

	--test-- "logic-cast-1"
		--assert #"^(01)" = as byte! true

	--test-- "logic-cast-2"
		cast-test-b: #"^(01)"
		l: true
		--assert cast-test-b = as byte! l

	--test-- "logic-cast-3"
		--assert #"^(00)" = as byte! false

	--test-- "logic-cast-4"
		cast-test-b: #"^(00)"
		l: false
		--assert cast-test-b = as byte! l

	--test-- "logic-cast-5"
		--assert 1 = as integer! true

	--test-- "logic-cast-6"
		i: 1
		l: true
		--assert i = as integer! l

	--test-- "logic-cast-7"
		--assert 0 = as integer! false

	--test-- "logic-cast-8"
		i: 0
		l: false
		--assert i = as integer! l

===end-group===

===start-group=== "cast c-string! tests"

	--test-- "c-string-cast-1"
		csc1-str: "Hello, Nenad"
		i: 0
		i: as integer! csc1-str
		i: i + 7
		csc1-str: as c-string! i
		--assert csc1-str/1 = #"N"
		--assert csc1-str/2 = #"e"
		--assert csc1-str/3 = #"n"
		--assert csc1-str/4 = #"a"
		--assert csc1-str/5 = #"d"

	--test-- "c-string-cast-3"
		csc3-str: ""
		--assert true = as logic! csc3-str

	--test-- "c-string-cast-4"
		--assert true = as logic! "Any old iron, any old iron"

	--test-- "c-string-cast-5"
		csc5-str: "Why not?"
		--assert true = as logic! csc5-str

	--test-- "c-string-cast-6"
		csc6-str: "Tour de France"
		csc6-p: declare pointer! [integer!]
		csc6-p: as [pointer! [integer!]] csc6-str
		csc6-p: csc6-p + 2
		csc6-str2: as c-string! csc6-p
		--assert csc6-str2/1 = #"F"
		--assert csc6-str2/2 = #"r"
		--assert csc6-str2/3 = #"a"
		--assert csc6-str2/4 = #"n"
		--assert csc6-str2/5 = #"c"
		--assert csc6-str2/6 = #"e"

	--test-- "C-string-cast-7"
		csc7-struct: declare struct! [
			c1 [byte!]
			c2 [byte!]
			c3 [byte!]
			c4 [byte!]
			c5 [byte!]
		]
		csc7-str: "Peter"
		csc7-struct: as [struct! [
			c1 [byte!] c2 [byte!] c3 [byte!] c4 [byte!] c5 [byte!]
		]] csc7-str
	--assert csc7-struct/c1 = #"P"
	--assert csc7-struct/c2 = #"e"
	--assert csc7-struct/c3 = #"t"
	--assert csc7-struct/c4 = #"e"
	--assert csc7-struct/c5 = #"r"

===end-group===

===start-group=== "cast from pointer!"

	--test-- "csp-1"
		csp1-p: declare pointer! [integer!]
		csp1-p: as [pointer! [integer!]] 256
		i: 0
		i: as integer! csp1-p
		--assert i = 256

	--test-- "csp-2"
		csp2-p: declare pointer! [integer!]
		csp2-p: as [pointer! [integer!]] 0
		--assert false = as logic! csp2-p

	--test-- "csp-3"
		csp3-p: declare pointer! [integer!]
		csp3-p: as [pointer! [integer!]] 1
		--assert true = as logic! csp3-p

	--test-- "csp-4"
		csp4-p: declare pointer! [integer!]
		csp4-p: as [pointer! [integer!]] FFFFFFFFh
		--assert true = as logic! csp4-p

	--test-- "csp-5"
		csp5-p: declare pointer! [integer!]
		csp5-p: as [pointer! [integer!]] 7FFFFFFFh
		--assert true = as logic! csp5-p

  ;; No test for pointer! to c-string! as it would simply
  ;;  duplicate the one of c-string! to pointer!

	--test-- "csp-6"
		csp6-p: declare pointer! [integer!]
		csp6-s: declare struct! [
			a [integer!]
			b [integer!]
		]
		csp6-s/a: 1
		csp6-s/b: 2
		csp6-p: as [pointer! [integer!]] csp6-s
		--assert csp6-p/value = 1
		csp6-p: csp6-p + 1
		--assert csp6-p/value = 2
		csp6-p: csp6-p - 1
		csp6-s: as [struct! [a [integer!] b [integer!]]] csp6-p
		--assert csp6-s/a = 1
		csp6-p: csp6-p + 1
		csp6-s: as [struct! [a [integer!] b [integer!]]] csp6-p
		--assert csp6-s/a = 2

===end-group===

===start-group=== "cast from struct!"

  ;; no test for cast to integer as it would simply
  ;;  duplicate the test from integer! to struct!

	--test-- "cfstruc-1"
		cfs1-struct: declare struct! [
			a [integer!]
			b [integer!]
		]
		cfs1-struct: as [struct! [a [integer!] b [integer!]]] 0
		--assert false = as logic! cfs1-struct

	--test-- "cfstruc-2"
		cfs2-struct: declare struct! [
			a [integer!]
			b [integer!]
		]
		--assert true = as logic! cfs2-struct

  ;; no test for cast to c-string! as it would simply
  ;;  duplicate the test from c-string! to struct!

  ;; no test for cast to pointer! as it would simply
  ;;  duplicate the test from pointer! to struct!

===end-group===

===start-group=== "byte-integer-cast"

	--test-- "bic-1"
		bic-a: as-byte 1
		--assert 1 = as-integer bic-a

	--test-- "bic-2"
		bic-a: as-byte 1
		--assert 65536 = ((as-integer bic-a) << 16)

	--test-- "bic-3"
		bic-a: as-byte 2
		--assert 131072 = ((as-integer bic-a) << 16)

	--test-- "bic-4"
		bic-a: #"^(01)"
		--assert 65537 = (65536 or (as-integer bic-a))

	--test-- "bic-5"
		bic-a: #"^(01)"
		bic-b: #"^(02)"
		--assert 131073 = ((as-integer bic-b) << 16 or as-integer bic-a)

	--test-- "bic-6"
		bic-a: #"^(01)"
		bic-b: #"^(02)"
		--assert 131073 = ((as-integer bic-b) << 16 or as-integer bic-a)

	--test-- "bic-7"
		bic-a: #"^(01)"
		bic-b: #"^(02)"
		--assert (as byte-ptr! 131073) = as byte-ptr! ((as-integer bic-b) << 16 or as-integer bic-a)

	--test-- "bic-8"
		bic-a: as-byte 1
		bic-b: as-byte 2
		--assert 131073 = ((as-integer bic-b) << 16 or as-integer bic-a)

	--test-- "bic-9"
		bic-a: as-byte 1
		bic-b: as-byte 2
		--assert (as byte-ptr! 131073) = as byte-ptr! ((as-integer bic-b) << 16 or as-integer bic-a)

	--test-- "bic-10"
		bic-s: declare struct! [
			bic-a [byte!]
			bic-b [byte!]
			bic-c [integer!]
			bic-d [byte!]
			bic-e [byte!]
			bic-f [integer!]
		]
		bic-s/bic-a: as-byte 0
		bic-s/bic-b: as-byte 1
		bic-s/bic-c: 2
		bic-s/bic-d: as-byte 3
		bic-s/bic-e: as-byte 255
		bic-s/bic-f: 255
		--assert false = as-logic bic-s/bic-a
		--assert true = as-logic bic-s/bic-b
		--assert bic-s/bic-e = as-byte bic-s/bic-f
		--assert bic-s/bic-f = as-integer bic-s/bic-e

===end-group===

===start-group=== "Cast in conditional tests"
		cic-r: false
	--test-- "cic-1"
		cic-d: as-byte 0
		either as-logic cic-d [cic-r: false] [cic-r: true]
		--assert cic-r

	--test-- "cic-2"
		cic-s: declare struct! [
			a   [byte!]
			b   [byte!]
		]
		cic-s/a: as-byte 0
		cic-s/b: as-byte 1
		either as-logic cic-s/a [cic-r: false] [cic-r: true]
		--assert cic-r

===end-group===

~~~end-file~~~


FEAT: added `probe` as alias to `print-line` for handier debugging.

Red/System [
	Title:   "Red/System OS-independent runtime"
	Author:  "Nenad Rakocevic"
	File: 	 %common.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
	}
]

#define zero? 		  [0 =]
#define positive?	  [0 < ]				;-- space required after the lesser-than symbol
#define negative?	  [0 > ]
#define negate		  [0 -]
#define null?		  [null =]

#define halt		  [quit 0]
#define forever		  [while [true]]
#define does		  [func []]
#define unless		  [if not]
#define	raise-error	  ***-on-quit
#define probe		  print-line

#define as-byte		  [as byte!]
#define as-logic	  [as logic!]
#define as-integer	  [as integer!]
#define as-float	  [as float!]
#define as-float32	  [as float32!]
#define as-c-string	  [as c-string!]

#define null-byte	  #"^(00)"
#define yes			  true
#define no			  false
#define on			  true
#define off			  false

#define byte-ptr!	  [pointer! [byte!]]
#define int-ptr!	  [pointer! [integer!]]
#define make-c-string [as c-string! allocate]

#define type-logic!		1					;-- type ID list for 'typeinfo attribut
#define type-integer!	2
#define type-byte!	    3
#define type-float32!	4
#define type-float64!	5					;-- float! is just an alias for float64!
#define type-float!		5
#define type-c-string!  6
#define type-byte-ptr!  7
#define type-int-ptr!	8
#define type-function!	9
#define type-struct!	1000
#define any-struct?		[1000 <=]
#define alias?  		[1001 <=]

;-- Global variables definition --
stdout:		-1								;-- uninitialized default value
stdin:		-1								;-- uninitialized default value
stderr:		-1								;-- uninitialized default value

str-array!: alias struct! [
	item [c-string!]
]

typed-value!: alias struct! [
	type	 [integer!]
	value	 [integer!]
	_padding [integer!]						;-- extra space for 64-bit values
]

typed-float!: alias struct! [
	type	 [integer!]
	value	 [float!]
]

#include %system.reds

;-------------------------------------------
;-- Convert a type ID to a c-string!
;-------------------------------------------
form-type: func [
	type 	[integer!]				  		;-- type ID
	return: [c-string!]						;-- type representation as c-string
][
	switch type [
		type-integer!   ["integer!"]
		type-c-string!  ["c-string!"]
		type-logic! 	["logic!"]
		type-byte! 	    ["byte!"]
		type-float32!   ["float32!"]
		type-float! 	["float!"]
		type-byte-ptr!  ["pointer! [byte!]"]
		type-int-ptr!   ["pointer! [integer!]"]
		type-struct!    ["struct!"]
		type-function!  ["function!"]
		default			[either alias? type ["alias"]["invalid type"]]
	]
]

#include %lib-names.reds

#either use-natives? = no [					;-- C bindings or native counterparts
	#include %libc.reds
][
	#include %lib-natives.reds
]

#switch OS [								;-- loading OS-specific bindings
	Windows  [#include %win32.reds]
	Syllable [#include %syllable.reds]
	MacOSX	 [#include %darwin.reds]
	#default [#include %linux.reds]
]

#include %utils.reds						;-- load additional utility functions

#if debug? = yes [#include %debug.reds]		;-- loads optionally debug functions

;-- Run-time error handling --

#define RED_ERR_VMEM_RELEASE_FAILED		96
#define RED_ERR_VMEM_OUT_OF_MEMORY		97

***-on-quit: func [							;-- global exit handler
	status [integer!]
	address [integer!]
	/local msg
][
	unless zero? status [
		print [lf "*** Runtime Error " status ": "]

		msg: switch status [
			1	["access violation"]
			2	["invalid alignment"]
			3	["breakpoint"]
			4	["single step"]
			5	["bounds exceeded"]
			6	["float denormal operan"]
			7	["float divide by zero"]
			8	["float inexact result"]
			9	["float invalid operation"]
			10	["float overflow"]
			11	["float stack check"]
			12	["float underflow"]
			13	["integer divide by zero"]
			14	["integer overflow"]
			15	["privileged instruction"]
			16	["invalid virtual address"]
			17	["illegal instruction"]
			18	["non-continuable exception"]
			19	["stack error or overflow"]
			20	["invalid disposition"]
			21	["guard page"]
			22	["invalid handle"]
			23	["illegal operand"]
			24	["illegal addressing mode"]
			25	["illegal trap"]
			26	["coprocessor error"]
			27	["non-existant physical address"]
			28	["object specific hardware error"]
			29	["hardware memory error consumed AR"]
			30	["hardware memory error consumed AO"]
			31	["privileged register"]
			32	["segmentation fault"]		;-- generic SIGSEGV message
			33	["FPU error"]				;-- generic SIGFPE message
			34	["Bus error"]				;-- generic SIGBUS message

			96	["virtual memory release failed"]
			97	["out of memory"]
			98	["assertion failed"]
			99	["unknown error"]

			100	["no value matched in CASE"]
			101	["no value matched in SWITCH"]

			default ["unknown error code!"]
		]
		print msg

		#either debug? = yes [
			__print-debug-line as byte-ptr! address
		][
			print [lf "*** at: " as byte-ptr! address "h" lf]
		]
	]

	#if OS = 'Windows [						;-- special exit handler for Windows
		***-on-win32-quit
	]
	quit status
]

Red/System [
	Title:   "Red/System OS-independent runtime"
	Author:  "Nenad Rakocevic"
	File: 	 %common.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
	}
]

#define zero? 		  [0 =]
#define positive?	  [0 < ]				;-- space required after the lesser-than symbol
#define negative?	  [0 > ]
#define negate		  [0 -]
#define null?		  [null =]

#define halt		  [quit 0]
#define forever		  [while [true]]
#define does		  [func []]
#define unless		  [if not]
#define	raise-error	  ***-on-quit
#define ?? 			  print-line			;-- DEPRECATED since 14/02/2012

#define as-byte		  [as byte!]
#define as-logic	  [as logic!]
#define as-integer	  [as integer!]
#define as-float	  [as float!]
#define as-float32	  [as float32!]
#define as-c-string	  [as c-string!]

#define null-byte	  #"^(00)"
#define yes			  true
#define no			  false
#define on			  true
#define off			  false

#define byte-ptr!	  [pointer! [byte!]]
#define int-ptr!	  [pointer! [integer!]]
#define make-c-string [as c-string! allocate]

#define type-logic!		1					;-- type ID list for 'typeinfo attribut
#define type-integer!	2
#define type-byte!	    3
#define type-float32!	4
#define type-float64!	5					;-- float! is just an alias for float64!
#define type-float!		5
#define type-c-string!  6
#define type-byte-ptr!  7
#define type-int-ptr!	8
#define type-function!	9
#define type-struct!	1000
#define any-struct?		[1000 <=]
#define alias?  		[1001 <=]

;-- Global variables definition --
stdout:		-1								;-- uninitialized default value
stdin:		-1								;-- uninitialized default value
stderr:		-1								;-- uninitialized default value

str-array!: alias struct! [
	item [c-string!]
]

typed-value!: alias struct! [
	type	 [integer!]
	value	 [integer!]
	_padding [integer!]						;-- extra space for 64-bit values
]

typed-float!: alias struct! [
	type	 [integer!]
	value	 [float!]
]

#include %system.reds

;-------------------------------------------
;-- Convert a type ID to a c-string!
;-------------------------------------------
form-type: func [
	type 	[integer!]				  		;-- type ID
	return: [c-string!]						;-- type representation as c-string
][
	switch type [
		type-integer!   ["integer!"]
		type-c-string!  ["c-string!"]
		type-logic! 	["logic!"]
		type-byte! 	    ["byte!"]
		type-float32!   ["float32!"]
		type-float! 	["float!"]
		type-byte-ptr!  ["pointer! [byte!]"]
		type-int-ptr!   ["pointer! [integer!]"]
		type-struct!    ["struct!"]
		type-function!  ["function!"]
		default			[either alias? type ["alias"]["invalid type"]]
	]
]

#include %lib-names.reds

#either use-natives? = no [					;-- C bindings or native counterparts
	#include %libc.reds
][
	#include %lib-natives.reds
]

#switch OS [								;-- loading OS-specific bindings
	Windows  [#include %win32.reds]
	Syllable [#include %syllable.reds]
	MacOSX	 [#include %darwin.reds]
	#default [#include %linux.reds]
]

#include %utils.reds						;-- load additional utility functions

#if debug? = yes [#include %debug.reds]		;-- loads optionally debug functions

;-- Run-time error handling --

#define RED_ERR_VMEM_RELEASE_FAILED		96
#define RED_ERR_VMEM_OUT_OF_MEMORY		97

***-on-quit: func [							;-- global exit handler
	status [integer!]
	address [integer!]
	/local msg
][
	unless zero? status [
		print [lf "*** Runtime Error " status ": "]

		msg: switch status [
			1	["access violation"]
			2	["invalid alignment"]
			3	["breakpoint"]
			4	["single step"]
			5	["bounds exceeded"]
			6	["float denormal operan"]
			7	["float divide by zero"]
			8	["float inexact result"]
			9	["float invalid operation"]
			10	["float overflow"]
			11	["float stack check"]
			12	["float underflow"]
			13	["integer divide by zero"]
			14	["integer overflow"]
			15	["privileged instruction"]
			16	["invalid virtual address"]
			17	["illegal instruction"]
			18	["non-continuable exception"]
			19	["stack error or overflow"]
			20	["invalid disposition"]
			21	["guard page"]
			22	["invalid handle"]
			23	["illegal operand"]
			24	["illegal addressing mode"]
			25	["illegal trap"]
			26	["coprocessor error"]
			27	["non-existant physical address"]
			28	["object specific hardware error"]
			29	["hardware memory error consumed AR"]
			30	["hardware memory error consumed AO"]
			31	["privileged register"]
			32	["segmentation fault"]		;-- generic SIGSEGV message
			33	["FPU error"]				;-- generic SIGFPE message
			34	["Bus error"]				;-- generic SIGBUS message

			96	["virtual memory release failed"]
			97	["out of memory"]
			98	["assertion failed"]
			99	["unknown error"]

			100	["no value matched in CASE"]
			101	["no value matched in SWITCH"]

			default ["unknown error code!"]
		]
		print msg

		#either debug? = yes [
			__print-debug-line as byte-ptr! address
		][
			print [lf "*** at: " as byte-ptr! address "h" lf]
		]
	]

	#if OS = 'Windows [						;-- special exit handler for Windows
		***-on-win32-quit
	]
	quit status
]


FIX: added error catching for ABSOLUTE on -2147483648 value.

Red/System [
	Title:   "Integer! datatype runtime functions"
	Author:  "Nenad Rakocevic"
	File: 	 %integer.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
	}
]

integer: context [
	verbose: 0

	get*: func [										;-- unboxing integer value from stack
		return: [integer!]
		/local
			int [red-integer!]
	][
		int: as red-integer! stack/arguments
		assert TYPE_OF(int) = TYPE_INTEGER
		int/value
	]

	get-any*: func [									;-- special get* variant for SWITCH
		return: [integer!]
		/local
			int [red-integer!]
	][
		int: as red-integer! stack/arguments
		either TYPE_OF(int) = TYPE_INTEGER [int/value][0] ;-- accept NONE values
	]

	get: func [											;-- unboxing integer value
		value	[red-value!]
		return: [integer!]
		/local
			int [red-integer!]
	][
		assert TYPE_OF(value) = TYPE_INTEGER
		int: as red-integer! value
		int/value
	]

	box: func [
		value	[integer!]
		return: [red-integer!]
		/local
			int [red-integer!]
	][
		int: as red-integer! stack/arguments
		int/header: TYPE_INTEGER
		int/value: value
		int
	]

	form-signed: func [									;@@ replace with sprintf() call?
		i 		[integer!]
		return: [c-string!]
		/local
			s	[c-string!]
			c 	[integer!]
			n 	[logic!]
	][
		s: "-0000000000"								;-- 11 bytes wide
		if zero? i [									;-- zero special case
			s/11: #"0"
			return s + 10
		]
		if i = -2147483648 [							;-- min integer special case
			return "-2147483648"
		]
		n: negative? i
		if n [i: negate i]
		c: 11
		while [i <> 0][
			s/c: #"0" + (i // 10)
			i: i / 10
			c: c - 1
		]
		if n [s/c: #"-" c: c - 1]
		s + c
	]

	do-math: func [
		type	  [math-op!]
		return:	  [red-integer!]
		/local
			left  [red-integer!]
			right [red-integer!]
	][
		left: as red-integer! stack/arguments
		right: left + 1

		assert any [									;@@ replace by typeset check when possible
			TYPE_OF(left) = TYPE_INTEGER
			TYPE_OF(left) = TYPE_CHAR
		]
		assert any [
			TYPE_OF(right) = TYPE_INTEGER
			TYPE_OF(right) = TYPE_CHAR
		]

		left/value: switch type [
			OP_ADD [left/value + right/value]
			OP_SUB [left/value - right/value]
			OP_MUL [left/value * right/value]
			OP_DIV [left/value / right/value]
			OP_REM [left/value % right/value]
			OP_AND [left/value and right/value]
			OP_OR  [left/value or right/value]
			OP_XOR [left/value xor right/value]
		]
		left
	]

	load-in: func [
		blk	  	[red-block!]
		value 	[integer!]
		/local
			int [red-integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/load-in"]]

		int: as red-integer! ALLOC_TAIL(blk)
		int/header: TYPE_INTEGER
		int/value: value
	]

	push: func [
		value	[integer!]
		return: [red-integer!]
		/local
			int [red-integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/push"]]

		int: as red-integer! stack/push*
		int/header: TYPE_INTEGER
		int/value: value
		int
	]

	;-- Actions --

	make: func [
		proto	 [red-value!]
		spec	 [red-value!]
		return:	 [red-integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/make"]]

		switch TYPE_OF(spec) [
			TYPE_INTEGER [
				as red-integer! spec
			]
			default [
				--NOT_IMPLEMENTED--
				as red-integer! spec					;@@ just for making it compilable
			]
		]
	]

	form: func [
		int		   [red-integer!]
		buffer	   [red-string!]
		arg		   [red-value!]
		part 	   [integer!]
		return:    [integer!]
		/local
			formed [c-string!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/form"]]

		formed: form-signed int/value
		string/concatenate-literal buffer formed
		part - length? formed							;@@ optimize by removing length?
	]

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

		form int buffer arg part
	]

	compare: func [
		value1    [red-integer!]						;-- first operand
		value2    [red-integer!]						;-- second operand
		op	      [integer!]							;-- type of comparison
		return:   [logic!]
		/local
			char  [red-char!]
			left  [integer!]
			right [integer!]
			res	  [logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/compare"]]

		left: value1/value

		switch TYPE_OF(value2) [
			TYPE_INTEGER [
				right: value2/value
			]
			TYPE_CHAR [
				char: as red-char! value2				;@@ could be optimized as integer! and char!
				right: char/value						;@@ structures are overlapping exactly
			]
			default [RETURN_COMPARE_OTHER]
		]
		switch op [
			COMP_EQUAL 			[res: left = right]
			COMP_NOT_EQUAL 		[res: left <> right]
			COMP_STRICT_EQUAL	[res: all [TYPE_OF(value2) = TYPE_INTEGER left = right]]
			COMP_LESSER			[res: left <  right]
			COMP_LESSER_EQUAL	[res: left <= right]
			COMP_GREATER		[res: left >  right]
			COMP_GREATER_EQUAL	[res: left >= right]
		]
		res
	]

	complement: func [
		int		[red-integer!]
		return:	[red-value!]
	][
		int/value: not int/value
		as red-value! int
	]

	remainder: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/remainder"]]
		as red-value! do-math OP_REM
	]

	absolute: func [
		return: [red-integer!]
		/local
			int	  [red-integer!]
			value [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/absolute"]]

		int: as red-integer! stack/arguments
		value: int/value

		if value = -2147483648 [
			print-line "*** Math Error: integer overflow on ABSOLUTE"
		]
		if negative? value [int/value: 0 - value]
		int 											;-- re-use argument slot for return value
	]

	add: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/add"]]
		as red-value! do-math OP_ADD
	]

	divide: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/divide"]]
		as red-value! do-math OP_DIV
	]

	multiply: func [return:	[red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/multiply"]]
		as red-value! do-math OP_MUL
	]

	subtract: func [return:	[red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/subtract"]]
		as red-value! do-math OP_SUB
	]

	and~: func [return:	[red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/and~"]]
		as red-value! do-math OP_AND
	]

	or~: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/or~"]]
		as red-value! do-math OP_OR
	]

	xor~: func [return:	[red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/xor~"]]
		as red-value! do-math OP_XOR
	]

	negate: func [
		return: [red-integer!]
		/local
			int [red-integer!]
	][
		int: as red-integer! stack/arguments
		int/value: 0 - int/value
		int 											;-- re-use argument slot for return value
	]

	int-power: func [
		base	[integer!]
		exp		[integer!]
		return: [integer!]
		/local
			res  [integer!]
			neg? [logic!]
	][
		res: 1
		neg?: false

		if exp < 0 [neg?: true exp: 0 - exp]
		while [exp <> 0][
			if as logic! exp and 1 [res: res * base]
			exp: exp >> 1
			base: base * base
		]
		either neg? [1 / res][res]
	]

	power: func [
		return:	 [red-integer!]
		/local
			base [red-integer!]
			exp  [red-integer!]
	][
		base: as red-integer! stack/arguments
		exp: base + 1
		base/value: int-power base/value exp/value
		base
	]

	even?: func [
		int		[red-integer!]
		return: [logic!]
	][
		not as-logic int/value and 1
	]

	odd?: func [
		int		[red-integer!]
		return: [logic!]
	][
		as-logic int/value and 1
	]

	init: does [
		datatype/register [
			TYPE_INTEGER
			TYPE_VALUE
			"integer!"
			;-- General actions --
			:make
			null			;random
			null			;reflect
			null			;to
			:form
			:mold
			null			;get-path
			null			;set-path
			:compare
			;-- Scalar actions --
			:absolute
			:add
			:divide
			:multiply
			:negate
			:power
			:remainder
			null			;round
			:subtract
			:even?
			:odd?
			;-- Bitwise actions --
			:and~
			:complement
			:or~
			: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:   "Integer! datatype runtime functions"
	Author:  "Nenad Rakocevic"
	File: 	 %integer.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
	}
]

integer: context [
	verbose: 0

	get*: func [										;-- unboxing integer value from stack
		return: [integer!]
		/local
			int [red-integer!]
	][
		int: as red-integer! stack/arguments
		assert TYPE_OF(int) = TYPE_INTEGER
		int/value
	]

	get-any*: func [									;-- special get* variant for SWITCH
		return: [integer!]
		/local
			int [red-integer!]
	][
		int: as red-integer! stack/arguments
		either TYPE_OF(int) = TYPE_INTEGER [int/value][0] ;-- accept NONE values
	]

	get: func [											;-- unboxing integer value
		value	[red-value!]
		return: [integer!]
		/local
			int [red-integer!]
	][
		assert TYPE_OF(value) = TYPE_INTEGER
		int: as red-integer! value
		int/value
	]

	box: func [
		value	[integer!]
		return: [red-integer!]
		/local
			int [red-integer!]
	][
		int: as red-integer! stack/arguments
		int/header: TYPE_INTEGER
		int/value: value
		int
	]

	form-signed: func [									;@@ replace with sprintf() call?
		i 		[integer!]
		return: [c-string!]
		/local
			s	[c-string!]
			c 	[integer!]
			n 	[logic!]
	][
		s: "-0000000000"								;-- 11 bytes wide
		if zero? i [									;-- zero special case
			s/11: #"0"
			return s + 10
		]
		if i = -2147483648 [							;-- min integer special case
			return "-2147483648"
		]
		n: negative? i
		if n [i: negate i]
		c: 11
		while [i <> 0][
			s/c: #"0" + (i // 10)
			i: i / 10
			c: c - 1
		]
		if n [s/c: #"-" c: c - 1]
		s + c
	]

	do-math: func [
		type	  [integer!]
		return:	  [red-integer!]
		/local
			left  [red-integer!]
			right [red-integer!]
	][
		left: as red-integer! stack/arguments
		right: left + 1

		assert any [									;@@ replace by typeset check when possible
			TYPE_OF(left) = TYPE_INTEGER
			TYPE_OF(left) = TYPE_CHAR
		]
		assert any [
			TYPE_OF(right) = TYPE_INTEGER
			TYPE_OF(right) = TYPE_CHAR
		]

		left/value: switch type [
			OP_ADD [left/value + right/value]
			OP_SUB [left/value - right/value]
			OP_MUL [left/value * right/value]
			OP_DIV [left/value / right/value]
			OP_REM [left/value % right/value]
			OP_AND [left/value and right/value]
			OP_OR  [left/value or right/value]
			OP_XOR [left/value xor right/value]
		]
		left
	]

	load-in: func [
		blk	  	[red-block!]
		value 	[integer!]
		/local
			int [red-integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/load-in"]]

		int: as red-integer! ALLOC_TAIL(blk)
		int/header: TYPE_INTEGER
		int/value: value
	]

	push: func [
		value	[integer!]
		return: [red-integer!]
		/local
			int [red-integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/push"]]

		int: as red-integer! stack/push*
		int/header: TYPE_INTEGER
		int/value: value
		int
	]

	;-- Actions --

	make: func [
		proto	 [red-value!]
		spec	 [red-value!]
		return:	 [red-integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/make"]]

		switch TYPE_OF(spec) [
			TYPE_INTEGER [
				as red-integer! spec
			]
			default [
				--NOT_IMPLEMENTED--
				as red-integer! spec					;@@ just for making it compilable
			]
		]
	]

	form: func [
		int		   [red-integer!]
		buffer	   [red-string!]
		arg		   [red-value!]
		part 	   [integer!]
		return:    [integer!]
		/local
			formed [c-string!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/form"]]

		formed: form-signed int/value
		string/concatenate-literal buffer formed
		part - length? formed							;@@ optimize by removing length?
	]

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

		form int buffer arg part
	]

	compare: func [
		value1    [red-integer!]						;-- first operand
		value2    [red-integer!]						;-- second operand
		op	      [integer!]							;-- type of comparison
		return:   [logic!]
		/local
			char  [red-char!]
			left  [integer!]
			right [integer!]
			res	  [logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/compare"]]

		left: value1/value

		switch TYPE_OF(value2) [
			TYPE_INTEGER [
				right: value2/value
			]
			TYPE_CHAR [
				char: as red-char! value2				;@@ could be optimized as integer! and char!
				right: char/value						;@@ structures are overlapping exactly
			]
			default [RETURN_COMPARE_OTHER]
		]
		switch op [
			COMP_EQUAL 			[res: left = right]
			COMP_NOT_EQUAL 		[res: left <> right]
			COMP_STRICT_EQUAL	[res: all [TYPE_OF(value2) = TYPE_INTEGER left = right]]
			COMP_LESSER			[res: left <  right]
			COMP_LESSER_EQUAL	[res: left <= right]
			COMP_GREATER		[res: left >  right]
			COMP_GREATER_EQUAL	[res: left >= right]
		]
		res
	]

	complement: func [
		int		[red-integer!]
		return:	[red-value!]
	][
		int/value: not int/value
		as red-value! int
	]

	remainder: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/remainder"]]
		as red-value! do-math OP_REM
	]

	absolute: func [
		return: [red-integer!]
		/local
			int [red-integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/absolute"]]
		int: as red-integer! stack/arguments
		if negative? int/value [int/value: 0 - int/value]
		int 											;-- re-use argument slot for return value
	]

	add: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/add"]]
		as red-value! do-math OP_ADD
	]

	divide: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/divide"]]
		as red-value! do-math OP_DIV
	]

	multiply: func [return:	[red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/multiply"]]
		as red-value! do-math OP_MUL
	]

	subtract: func [return:	[red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/subtract"]]
		as red-value! do-math OP_SUB
	]

	and~: func [return:	[red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/and~"]]
		as red-value! do-math OP_AND
	]

	or~: func [return:	[red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/or~"]]
		as red-value! do-math OP_OR
	]

	xor~: func [return:	[red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/xor~"]]
		as red-value! do-math OP_XOR
	]

	negate: func [
		return: [red-integer!]
		/local
			int [red-integer!]
	][
		int: as red-integer! stack/arguments
		int/value: 0 - int/value
		int 											;-- re-use argument slot for return value
	]

	int-power: func [
		base	[integer!]
		exp		[integer!]
		return: [integer!]
		/local
			res  [integer!]
			neg? [logic!]
	][
		res: 1
		neg?: false

		if exp < 0 [neg?: true exp: 0 - exp]
		while [exp <> 0][
			if as logic! exp and 1 [res: res * base]
			exp: exp >> 1
			base: base * base
		]
		either neg? [1 / res][res]
	]

	power: func [
		return:	 [red-integer!]
		/local
			base [red-integer!]
			exp  [red-integer!]
	][
		base: as red-integer! stack/arguments
		exp: base + 1
		base/value: int-power base/value exp/value
		base
	]

	even?: func [
		int		[red-integer!]
		return: [logic!]
	][
		not as-logic int/value and 1
	]

	odd?: func [
		int		[red-integer!]
		return: [logic!]
	][
		as-logic int/value and 1
	]

	init: does [
		datatype/register [
			TYPE_INTEGER
			TYPE_VALUE
			"integer!"
			;-- General actions --
			:make
			null			;random
			null			;reflect
			null			;to
			:form
			:mold
			null			;get-path
			null			;set-path
			:compare
			;-- Scalar actions --
			:absolute
			:add
			:divide
			:multiply
			:negate
			:power
			:remainder
			null			;round
			:subtract
			:even?
			:odd?
			;-- Bitwise actions --
			:and~
			:complement
			:or~
			: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
		]
	]
]