FIX: issue #1132 (Math ops on pairs do not work with prefix actions)

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

;; Warning: do not define any function of any kind before MAKE definition

make: make action! [[									;--	this one works!	;-)
		"Returns a new value made from a spec for that value's type"
		type	 [any-type!] "The datatype or a prototype value"
		spec	 [any-type!] "The specification	of the new value"
		return:  [any-type!] "Returns the specified datatype"
	]
	#get-definition ACT_MAKE
]

random: make action! [[
		"Returns a random value of the same datatype; or shuffles series"
		value	"Maximum value of result (modified when series)"
		/seed   "Restart or randomize"
		/secure "TBD: Returns a cryptographically secure random number"
		/only	"Pick a random value from a series"
		return:	[any-type!]
	]
	#get-definition ACT_RANDOM
]

reflect: make action! [[
		"Returns internal details about a value via reflection"
		value	[any-type!]
		field 	[word!] "spec, body, words, etc. Each datatype defines its own reflectors"
	]
	#get-definition ACT_REFLECT
]

to: make action! [[
		"Converts to a specified datatype"
		type	[any-type!] "The datatype or example value"
		spec	[any-type!] "The attributes of the new value"
	]
	#get-definition ACT_TO
]

form: make action! [[
		"Returns a user-friendly string representation of a value"
		value	  [any-type!]
		/part "Limit the length of the result"
			limit [integer!]
		return:	  [string!]
	]
	#get-definition ACT_FORM
]

mold: make action! [[
		"Returns a source format string representation of a value"
		value	  [any-type!]
		/only "Exclude outer brackets if value is a block"
		/all  "TBD: Return value in loadable format"
		/flat "TBD: Exclude all indentation"
		/part "Limit the length of the result"
			limit [integer!]
		return:	  [string!]
	]
	#get-definition ACT_MOLD
]

;-- Scalar actions --

absolute: make action! [[
		"Returns the non-negative value"
		value	 [number! pair!]
		return:  [number! pair!]
	]
	#get-definition ACT_ABSOLUTE
]

add: make action! [[
		"Returns the sum of the two values"
		value1	 [number! char! pair!]
		value2	 [number! char! pair!]
		return:  [number! char! pair!]
	]
	#get-definition ACT_ADD
]

divide: make action! [[
		"Returns the quotient of two values"
		value1	 [number! char! pair!] "The dividend (numerator)"
		value2	 [number! char! pair!] "The divisor (denominator)"
		return:  [number! char! pair!]
	]
	#get-definition ACT_DIVIDE
]

multiply: make action! [[
		"Returns the product of two values"
		value1	 [number! char! pair!]
		value2	 [number! char! pair!]
		return:  [number! char! pair!]
	]
	#get-definition ACT_MULTIPLY
]

negate: make action! [[
		"Returns the opposite (additive inverse) value"
		number 	 [number! bitset! pair!]
		return:  [number! bitset! pair!]
	]
	#get-definition ACT_NEGATE
]

power: make action! [[
		"Returns a number raised to a given power (exponent)"
		number	 [number!] "Base value"
		exponent [number!] "The power (index) to raise the base value by"
		return:	 [number!]
	]
	#get-definition ACT_POWER
]

remainder: make action! [[
		"Returns what is left over when one value is divided by another"
		value1 	 [number! char! pair!]
		value2 	 [number! char! pair!]
		return:  [number! char! pair!]
	]
	#get-definition ACT_REMAINDER
]

modulo: func [
	"Compute a nonnegative remainder of A divided by B"
	a		[number! pair!]
	b		[number! pair!]
	return: [number! pair!]
	/local r
][
	b: absolute b
    all [0 > r: a % b r: r + b]
    a: absolute a
    either all [a + r = (a + b) 0 < r + r - b] [r - b] [r]
]

round: make action! [[
		"Returns the nearest integer. Halves round up (away from zero) by default"
		n		[number!]
		/to		"Return the nearest multiple of the scale parameter"
		scale	[number!] "Must be a non-zero value"
		/even		"Halves round toward even results"
		/down		"Round toward zero, ignoring discarded digits. (truncate)"
		/half-down	"Halves round toward zero"
		/floor		"Round in negative direction"
		/ceiling	"Round in positive direction"
		/half-ceiling "Halves round in positive direction"
	]
	#get-definition ACT_ROUND
]

subtract: make action! [[
		"Returns the difference between two values"
		value1	 [number! char! pair!]
		value2	 [number! char! pair!]
		return:  [number! char! pair!]
	]
	#get-definition ACT_SUBTRACT
]

even?: make action! [[
		"Returns true if the number is evenly divisible by 2"
		number 	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_EVEN?
]

odd?: make action! [[
		"Returns true if the number has a remainder of 1 when divided by 2"
		number 	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_ODD?
]

;-- Bitwise actions --

and~: make action! [[
		"Returns the first value ANDed with the second"
		value1	[logic! integer! char! bitset! typeset! pair!]
		value2	[logic! integer! char! bitset! typeset! pair!]
		return:	[logic! integer! char! bitset! typeset! pair!]
	]
	#get-definition ACT_AND~
]

complement: make action! [[
		"Returns the opposite (complementing) value of the input value"
		value	[logic! integer! bitset! typeset!]
		return: [logic! integer! bitset! typeset!]
	]
	#get-definition ACT_COMPLEMENT
]

or~: make action! [[
		"Returns the first value ORed with the second"
		value1	[logic! integer! char! bitset! typeset! pair!]
		value2	[logic! integer! char! bitset! typeset! pair!]
		return:	[logic! integer! char! bitset! typeset! pair!]
	]
	#get-definition ACT_OR~
]

xor~: make action! [[
		"Returns the first value exclusive ORed with the second"
		value1	[logic! integer! char! bitset! typeset! pair!]
		value2	[logic! integer! char! bitset! typeset! pair!]
		return:	[logic! integer! char! bitset! typeset! pair!]
	]
	#get-definition ACT_XOR~
]

;-- Series actions --

append: make action! [[
		"Inserts value(s) at series tail; returns series head"
		series	   [series! bitset!]
		value	   [any-type!]
		/part "Limit the number of values inserted"
			length [number! series!]
		/only "Insert block types as single values (overrides /part)"
		/dup  "Duplicate the inserted values"
			count  [number!]
		return:    [series! bitset!]
	]
	#get-definition ACT_APPEND
]

at: make action! [[
		"Returns a series at a given index"
		series	 [series!]
		index 	 [integer!]
		return:  [series!]
	]
	#get-definition ACT_AT
]

back: make action! [[
		"Returns a series at the previous index"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_BACK
]

;change

clear: make action! [[
		"Removes series values from current index to tail; returns new tail"
		series	 [series! bitset!]
		return:  [series! bitset!]
	]
	#get-definition ACT_CLEAR
]

copy: make action! [[
		"Returns a copy of a non-scalar value"
		value	 [series! any-object! bitset!]
		/part	 "Limit the length of the result"
			length [number! series!]
		/deep	 "Copy nested values"
		/types	 "Copy only specific types of non-scalar values"
			kind [datatype!]
		return:  [series! any-object! bitset!]
	]
	#get-definition ACT_COPY
]

find: make action! [[
		"Returns the series where a value is found, or NONE"
		series	 [series! bitset! typeset! any-object! none!]
		value 	 [any-type!]
		/part "Limit the length of the search"
			length [number! series!]
		/only "Treat a series search value as a single value"
		/case "Perform a case-sensitive search"
		/any  "TBD: Use * and ? wildcards in string searches"
		/with "TBD: Use custom wildcards in place of * and ?"
			wild [string!]
		/skip "Treat the series as fixed size records"
			size [integer!]
		/last "Find the last occurrence of value, from the tail"
		/reverse "Find the last occurrence of value, from the current index"
		/tail "Return the tail of the match found, rather than the head"
		/match "Match at current index only and return tail of match"
	]
	#get-definition ACT_FIND
]

head: make action! [[
		"Returns a series at its first index"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_HEAD
]

head?: make action! [[
		"Returns true if a series is at its first index"
		series	 [series!]
		return:  [logic!]
	]
	#get-definition ACT_HEAD?
]

index?: make action! [[
		"Returns the current series index, relative to the head"
		series	 [series!]
		return:  [integer!]
	]
	#get-definition ACT_INDEX?
]

insert: make action! [[
		"Inserts value(s) at series index; returns series head"
		series	   [series! bitset!]
		value	   [any-type!]
		/part "Limit the number of values inserted"
			length [number! series!]
		/only "Insert block types as single values (overrides /part)"
		/dup  "Duplicate the inserted values"
			count  [number!]
		return:    [series! bitset!]
	]
	#get-definition ACT_INSERT
]

length?: make action! [[
		"Returns the number of values in the series, from the current index to the tail"
		series	 [series! bitset!]
		return:  [integer!]
	]
	#get-definition ACT_LENGTH?
]

next: make action! [[
		"Returns a series at the next index"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_NEXT
]

pick: make action! [[
		"Returns the series value at a given index"
		series	 [series! bitset!]
		index 	 [integer! logic! char!]
		return:  [any-type!]
	]
	#get-definition ACT_PICK
]

poke: make action! [[
		"Replaces the series value at a given index, and returns the new value"
		series	 [series! bitset!]
		index 	 [integer! char! logic! block!]
		value 	 [any-type!]
		return:  [series! bitset!]
	]
	#get-definition ACT_POKE
]

remove: make action! [[
		"Returns the series at the same index after removing a value"
		series	 [series! bitset! none!]
		/part "Removes a number of values, or values up to the given series index"
			length [number! char! series!]
		return:  [series! bitset! none!]
	]
	#get-definition ACT_REMOVE
]

reverse: make action! [[
		"Reverses the order of elements; returns at same position"
		series	 [series!]
		/part "Limits to a given length or position"
			length [number! series!]
		return:  [series!]
	]
	#get-definition ACT_REVERSE
]

select: make action! [[
		"Find a value in a series and return the next value, or NONE"
		series	 [series! any-object! none!]
		value 	 [any-type!]
		/part "Limit the length of the search"
			length [number! series!]
		/only "Treat a series search value as a single value"
		/case "Perform a case-sensitive search"
		/any  "TBD: Use * and ? wildcards in string searches"
		/with "TBD: Use custom wildcards in place of * and ?"
			wild [string!]
		/skip "Treat the series as fixed size records"
			size [integer!]
		/last "Find the last occurrence of value, from the tail"
		/reverse "Find the last occurrence of value, from the current index"
		return:  [any-type!]
	]
	#get-definition ACT_SELECT
]

sort: make action! [[
		"Sorts a series (modified); default sort order is ascending"
		series	 [series!]
		/case "Perform a case-sensitive sort"
		/skip "Treat the series as fixed size records"
			size [integer!]
		/compare "Comparator offset, block or function"
			comparator [integer! block! any-function!]
		/part "Sort only part of a series"
			length [number! series!]
		/all "Compare all fields"
		/reverse "Reverse sort order"
		/stable "Stable sorting"
		return:  [series!]
	]
	#get-definition ACT_SORT
]

skip: make action! [[
		"Returns the series relative to the current index"
		series	 [series!]
		offset 	 [integer!]
		return:  [series!]
	]
	#get-definition ACT_SKIP
]

swap: make action! [[
		"Swaps elements between two series or the same series"
		series1  [series!]
		series2  [series!]
		return:  [series!]
	]
	#get-definition ACT_SWAP
]

tail: make action! [[
		"Returns a series at the index after its last value"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_TAIL
]

tail?: make action! [[
		"Returns true if a series is past its last value"
		series	 [series!]
		return:  [logic!]
	]
	#get-definition ACT_TAIL?
]

take: make action! [[
		"Removes and returns one or more elements"
		series	 [series! none!]
		/part	 "Specifies a length or end position"
			length [number! series!]
		/deep	 "Copy nested values"
		/last	 "Take it from the tail end"
	]
	#get-definition ACT_TAKE
]

trim: make action! [[
		"Removes space from a string or NONE from a block or object"
		series	[series! object! error!]
		/head	"Removes only from the head"
		/tail	"Removes only from the tail"
		/auto	"Auto indents lines relative to first line"
		/lines	"Removes all line breaks and extra spaces"
		/all	"Removes all whitespace"
		/with	"Same as /all, but removes characters in 'str'"
			str [char! string! integer!]
	]
	#get-definition ACT_TRIM
]

;-- I/O actions --

;create
;close
;delete
;modify
;open
;open?
;query
;read
;rename
;update
;write

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

;; Warning: do not define any function of any kind before MAKE definition

make: make action! [[									;--	this one works!	;-)
		"Returns a new value made from a spec for that value's type"
		type	 [any-type!] "The datatype or a prototype value"
		spec	 [any-type!] "The specification	of the new value"
		return:  [any-type!] "Returns the specified datatype"
	]
	#get-definition ACT_MAKE
]

random: make action! [[
		"Returns a random value of the same datatype; or shuffles series"
		value	"Maximum value of result (modified when series)"
		/seed   "Restart or randomize"
		/secure "TBD: Returns a cryptographically secure random number"
		/only	"Pick a random value from a series"
		return:	[any-type!]
	]
	#get-definition ACT_RANDOM
]

reflect: make action! [[
		"Returns internal details about a value via reflection"
		value	[any-type!]
		field 	[word!] "spec, body, words, etc. Each datatype defines its own reflectors"
	]
	#get-definition ACT_REFLECT
]

to: make action! [[
		"Converts to a specified datatype"
		type	[any-type!] "The datatype or example value"
		spec	[any-type!] "The attributes of the new value"
	]
	#get-definition ACT_TO
]

form: make action! [[
		"Returns a user-friendly string representation of a value"
		value	  [any-type!]
		/part "Limit the length of the result"
			limit [integer!]
		return:	  [string!]
	]
	#get-definition ACT_FORM
]

mold: make action! [[
		"Returns a source format string representation of a value"
		value	  [any-type!]
		/only "Exclude outer brackets if value is a block"
		/all  "TBD: Return value in loadable format"
		/flat "TBD: Exclude all indentation"
		/part "Limit the length of the result"
			limit [integer!]
		return:	  [string!]
	]
	#get-definition ACT_MOLD
]

;-- Scalar actions --

absolute: make action! [[
		"Returns the non-negative value"
		value	 [number!]
		return:  [number!]
	]
	#get-definition ACT_ABSOLUTE
]

add: make action! [[
		"Returns the sum of the two values"
		value1	 [number! char!]
		value2	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_ADD
]

divide: make action! [[
		"Returns the quotient of two values"
		value1	 [number! char!] "The dividend (numerator)"
		value2	 [number! char!] "The divisor (denominator)"
		return:  [number! char!]
	]
	#get-definition ACT_DIVIDE
]

multiply: make action! [[
		"Returns the product of two values"
		value1	 [number! char!]
		value2	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_MULTIPLY
]

negate: make action! [[
		"Returns the opposite (additive inverse) value"
		number 	 [number! bitset!]
		return:  [number! bitset!]
	]
	#get-definition ACT_NEGATE
]

power: make action! [[
		"Returns a number raised to a given power (exponent)"
		number	 [number!] "Base value"
		exponent [number!] "The power (index) to raise the base value by"
		return:	 [number!]
	]
	#get-definition ACT_POWER
]

remainder: make action! [[
		"Returns what is left over when one value is divided by another"
		value1 	 [number! char!]
		value2 	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_REMAINDER
]

modulo: func [
	"Compute a nonnegative remainder of A divided by B"
	a		[number!]
	b		[number!]
	return: [number!]
	/local r
][
	b: absolute b
    all [0 > r: a % b r: r + b]
    a: absolute a
    either all [a + r = (a + b) 0 < r + r - b] [r - b] [r]
]

round: make action! [[
		"Returns the nearest integer. Halves round up (away from zero) by default"
		n		[number!]
		/to		"Return the nearest multiple of the scale parameter"
		scale	[number!] "Must be a non-zero value"
		/even		"Halves round toward even results"
		/down		"Round toward zero, ignoring discarded digits. (truncate)"
		/half-down	"Halves round toward zero"
		/floor		"Round in negative direction"
		/ceiling	"Round in positive direction"
		/half-ceiling "Halves round in positive direction"
	]
	#get-definition ACT_ROUND
]

subtract: make action! [[
		"Returns the difference between two values"
		value1	 [number! char!]
		value2	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_SUBTRACT
]

even?: make action! [[
		"Returns true if the number is evenly divisible by 2"
		number 	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_EVEN?
]

odd?: make action! [[
		"Returns true if the number has a remainder of 1 when divided by 2"
		number 	 [number! char!]
		return:  [number! char!]
	]
	#get-definition ACT_ODD?
]

;-- Bitwise actions --

and~: make action! [[
		"Returns the first value ANDed with the second"
		value1	[logic! integer! char! bitset! typeset!]
		value2	[logic! integer! char! bitset! typeset!]
		return:	[logic! integer! char! bitset! typeset!]
	]
	#get-definition ACT_AND~
]

complement: make action! [[
		"Returns the opposite (complementing) value of the input value"
		value	[logic! integer! bitset! typeset!]
		return: [logic! integer! bitset! typeset!]
	]
	#get-definition ACT_COMPLEMENT
]

or~: make action! [[
		"Returns the first value ORed with the second"
		value1	[logic! integer! char! bitset! typeset!]
		value2	[logic! integer! char! bitset! typeset!]
		return:	[logic! integer! char! bitset! typeset!]
	]
	#get-definition ACT_OR~
]

xor~: make action! [[
		"Returns the first value exclusive ORed with the second"
		value1	[logic! integer! char! bitset! typeset!]
		value2	[logic! integer! char! bitset! typeset!]
		return:	[logic! integer! char! bitset! typeset!]
	]
	#get-definition ACT_XOR~
]

;-- Series actions --

append: make action! [[
		"Inserts value(s) at series tail; returns series head"
		series	   [series! bitset!]
		value	   [any-type!]
		/part "Limit the number of values inserted"
			length [number! series!]
		/only "Insert block types as single values (overrides /part)"
		/dup  "Duplicate the inserted values"
			count  [number!]
		return:    [series! bitset!]
	]
	#get-definition ACT_APPEND
]

at: make action! [[
		"Returns a series at a given index"
		series	 [series!]
		index 	 [integer!]
		return:  [series!]
	]
	#get-definition ACT_AT
]

back: make action! [[
		"Returns a series at the previous index"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_BACK
]

;change

clear: make action! [[
		"Removes series values from current index to tail; returns new tail"
		series	 [series! bitset!]
		return:  [series! bitset!]
	]
	#get-definition ACT_CLEAR
]

copy: make action! [[
		"Returns a copy of a non-scalar value"
		value	 [series! any-object! bitset!]
		/part	 "Limit the length of the result"
			length [number! series!]
		/deep	 "Copy nested values"
		/types	 "Copy only specific types of non-scalar values"
			kind [datatype!]
		return:  [series! any-object! bitset!]
	]
	#get-definition ACT_COPY
]

find: make action! [[
		"Returns the series where a value is found, or NONE"
		series	 [series! bitset! typeset! any-object! none!]
		value 	 [any-type!]
		/part "Limit the length of the search"
			length [number! series!]
		/only "Treat a series search value as a single value"
		/case "Perform a case-sensitive search"
		/any  "TBD: Use * and ? wildcards in string searches"
		/with "TBD: Use custom wildcards in place of * and ?"
			wild [string!]
		/skip "Treat the series as fixed size records"
			size [integer!]
		/last "Find the last occurrence of value, from the tail"
		/reverse "Find the last occurrence of value, from the current index"
		/tail "Return the tail of the match found, rather than the head"
		/match "Match at current index only and return tail of match"
	]
	#get-definition ACT_FIND
]

head: make action! [[
		"Returns a series at its first index"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_HEAD
]

head?: make action! [[
		"Returns true if a series is at its first index"
		series	 [series!]
		return:  [logic!]
	]
	#get-definition ACT_HEAD?
]

index?: make action! [[
		"Returns the current series index, relative to the head"
		series	 [series!]
		return:  [integer!]
	]
	#get-definition ACT_INDEX?
]

insert: make action! [[
		"Inserts value(s) at series index; returns series head"
		series	   [series! bitset!]
		value	   [any-type!]
		/part "Limit the number of values inserted"
			length [number! series!]
		/only "Insert block types as single values (overrides /part)"
		/dup  "Duplicate the inserted values"
			count  [number!]
		return:    [series! bitset!]
	]
	#get-definition ACT_INSERT
]

length?: make action! [[
		"Returns the number of values in the series, from the current index to the tail"
		series	 [series! bitset!]
		return:  [integer!]
	]
	#get-definition ACT_LENGTH?
]

next: make action! [[
		"Returns a series at the next index"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_NEXT
]

pick: make action! [[
		"Returns the series value at a given index"
		series	 [series! bitset!]
		index 	 [integer! logic! char!]
		return:  [any-type!]
	]
	#get-definition ACT_PICK
]

poke: make action! [[
		"Replaces the series value at a given index, and returns the new value"
		series	 [series! bitset!]
		index 	 [integer! char! logic! block!]
		value 	 [any-type!]
		return:  [series! bitset!]
	]
	#get-definition ACT_POKE
]

remove: make action! [[
		"Returns the series at the same index after removing a value"
		series	 [series! bitset! none!]
		/part "Removes a number of values, or values up to the given series index"
			length [number! char! series!]
		return:  [series! bitset! none!]
	]
	#get-definition ACT_REMOVE
]

reverse: make action! [[
		"Reverses the order of elements; returns at same position"
		series	 [series!]
		/part "Limits to a given length or position"
			length [number! series!]
		return:  [series!]
	]
	#get-definition ACT_REVERSE
]

select: make action! [[
		"Find a value in a series and return the next value, or NONE"
		series	 [series! any-object! none!]
		value 	 [any-type!]
		/part "Limit the length of the search"
			length [number! series!]
		/only "Treat a series search value as a single value"
		/case "Perform a case-sensitive search"
		/any  "TBD: Use * and ? wildcards in string searches"
		/with "TBD: Use custom wildcards in place of * and ?"
			wild [string!]
		/skip "Treat the series as fixed size records"
			size [integer!]
		/last "Find the last occurrence of value, from the tail"
		/reverse "Find the last occurrence of value, from the current index"
		return:  [any-type!]
	]
	#get-definition ACT_SELECT
]

sort: make action! [[
		"Sorts a series (modified); default sort order is ascending"
		series	 [series!]
		/case "Perform a case-sensitive sort"
		/skip "Treat the series as fixed size records"
			size [integer!]
		/compare "Comparator offset, block or function"
			comparator [integer! block! any-function!]
		/part "Sort only part of a series"
			length [number! series!]
		/all "Compare all fields"
		/reverse "Reverse sort order"
		/stable "Stable sorting"
		return:  [series!]
	]
	#get-definition ACT_SORT
]

skip: make action! [[
		"Returns the series relative to the current index"
		series	 [series!]
		offset 	 [integer!]
		return:  [series!]
	]
	#get-definition ACT_SKIP
]

swap: make action! [[
		"Swaps elements between two series or the same series"
		series1  [series!]
		series2  [series!]
		return:  [series!]
	]
	#get-definition ACT_SWAP
]

tail: make action! [[
		"Returns a series at the index after its last value"
		series	 [series!]
		return:  [series!]
	]
	#get-definition ACT_TAIL
]

tail?: make action! [[
		"Returns true if a series is past its last value"
		series	 [series!]
		return:  [logic!]
	]
	#get-definition ACT_TAIL?
]

take: make action! [[
		"Removes and returns one or more elements"
		series	 [series! none!]
		/part	 "Specifies a length or end position"
			length [number! series!]
		/deep	 "Copy nested values"
		/last	 "Take it from the tail end"
	]
	#get-definition ACT_TAKE
]

trim: make action! [[
		"Removes space from a string or NONE from a block or object"
		series	[series! object! error!]
		/head	"Removes only from the head"
		/tail	"Removes only from the tail"
		/auto	"Auto indents lines relative to first line"
		/lines	"Removes all line breaks and extra spaces"
		/all	"Removes all whitespace"
		/with	"Same as /all, but removes characters in 'str'"
			str [char! string! integer!]
	]
	#get-definition ACT_TRIM
]

;-- I/O actions --

;create
;close
;delete
;modify
;open
;open?
;query
;read
;rename
;update
;write


TESTS: fixed unset! tests.

TESTS: fixed unset! tests.

Red [
	Title:   "Red type? test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %type-test.red
	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~~~ "type?"

===start-group=== "unevaluated literals"
	--test-- "type?ul-1"
	--assert integer! = type? first [1]
	--test-- "type?ul-2"
	--assert char! = type? first [#"a"]
	--test-- "type?ul-3"
	--assert block! = type? first [[]]
	--test-- "type?ul-4"
	--assert get-word! = type? first [:b]
	--test-- "type?ul-5"
	--assert logic! = type? first [#[true]]
	--test-- "type?ul-6"
	--assert issue! = type? first [#1]
	--test-- "type?ul-7"
	--assert none! = type? first [#[none]]
	--test-- "type?ul-8"
	--assert paren! = type? first [(1)]
	--test-- "type?ul-9"
	--assert set-word! = type? first [b:]
	--test-- "type?ul-10"
	--assert string! = type? first ["1234566789"]
	;--test-- "type?ul-11"
	;--assert unset! = type? first [prin ""]
	--test-- "type?ul-12"
	--assert word! = type? first [a]
	--test-- "type?ul-13"
	--assert lit-word! = type? first ['a]
===end-group===

===start-group=== "word value"
	--test-- "type?wv-1"
		value: 1
	--assert integer! = type? value
	--test-- "type?wv-2"
		value: #"a"
	--assert char! = type? value
	--test-- "type?wv-3"
		value: [a b c d]
	--assert block! = type? value
	--test-- "type?wv-4"
		value: true
	--assert logic! = type? value
	--test-- "type?wv-5"
		value: #123456789
	--assert issue! = type? value
	--test-- "type?wv-6"
		value: none
	--assert none! = type? value
	--test-- "type?wv-7"
		value: first [("a b c d")]
	--assert paren! = type? value
	--test-- "type?wv-8"
		value: first [a:]
	--assert set-word! = type? value
	--test-- "type?wv-9"
		value: "Hello Nenad"
	--assert string! = type? value
	--test-- "type?wv-10"
		set/any 'value print ""
	--assert unset! = type? get/any 'value
	--test-- "type?wv-11"
		value: 'a
	--assert word! = type? value
	--test-- "type?wv-12"
		value: first ['a]
	--assert word! = type? value
===end-group===

===start-group=== "get word value"
	--test-- "type?gwv-1"
		value: 1
	--assert integer! = type? :value
	--test-- "type?gwv-2"
		value: #"a"
	--assert char! = type? :value
	--test-- "type?gwv-3"
		value: [a b c d]
	--assert block! = type? :value
	--test-- "type?gwv-4"
		value: first [:g]
	--assert get-word! = type? :value
	--test-- "type?gwv-5"
		value: true
	--assert logic! = type? :value
	--test-- "type?gwv-6"
		value: #123456789
	--assert issue! = type? :value
	--test-- "type?gwv-7"
		value: none
	--assert none! = type? :value
	--test-- "type?gwv-8"
		value: first [("abcd")]
	--assert paren! = type? :value
	--test-- "type?gwv-9"
		value: first [a: ]
	--assert set-word! = type? :value
	--test-- "type?gwv-10"
		value: "Hello Nenad"
	--assert string! = type? :value
	--test-- "type?gwv-11"
	  set/any 'value print ""
	--assert unset! = type? get/any 'value
	--test-- "type?gwv-12"
		value: 'a
	--assert word! = type? :value
	--test-- "type?gwv-13"
		value: first ['a]
	--assert lit-word! = type? :value
===end-group===

~~~end-file~~~

Red [
	Title:   "Red type? test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %type-test.red
	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~~~ "type?"

===start-group=== "unevaluated literals"
	--test-- "type?ul-1"
	--assert integer! = type? first [1]
	--test-- "type?ul-2"
	--assert char! = type? first [#"a"]
	--test-- "type?ul-3"
	--assert block! = type? first [[]]
	--test-- "type?ul-4"
	--assert get-word! = type? first [:b]
	--test-- "type?ul-5"
	--assert logic! = type? first [#[true]]
	--test-- "type?ul-6"
	--assert issue! = type? first [#1]
	--test-- "type?ul-7"
	--assert none! = type? first [#[none]]
	--test-- "type?ul-8"
	--assert paren! = type? first [(1)]
	--test-- "type?ul-9"
	--assert set-word! = type? first [b:]
	--test-- "type?ul-10"
	--assert string! = type? first ["1234566789"]
	;--test-- "type?ul-11"
	;--assert unset! = type? first [#[unset!]]
	--test-- "type?ul-12"
	--assert word! = type? first [a]
	--test-- "type?ul-13"
	--assert lit-word! = type? first ['a]
===end-group===

===start-group=== "word value"
	--test-- "type?wv-1"
		value: 1
	--assert integer! = type? value
	--test-- "type?wv-2"
		value: #"a"
	--assert char! = type? value
	--test-- "type?wv-3"
		value: [a b c d]
	--assert block! = type? value
	--test-- "type?wv-4"
		value: true
	--assert logic! = type? value
	--test-- "type?wv-5"
		value: #123456789
	--assert issue! = type? value
	--test-- "type?wv-6"
		value: none
	--assert none! = type? value
	--test-- "type?wv-7"
		value: first [("a b c d")]
	--assert paren! = type? value
	--test-- "type?wv-8"
		value: first [a:]
	--assert set-word! = type? value
	--test-- "type?wv-9"
		value: "Hello Nenad"
	--assert string! = type? value
	--test-- "type?wv-10"
		value: print ""
	--assert unset! = type? value
	--test-- "type?wv-11"
		value: 'a
	--assert word! = type? value
	--test-- "type?wv-12"
		value: first ['a]
	--assert word! = type? value
===end-group===

===start-group=== "get word value"
	--test-- "type?gwv-1"
		value: 1
	--assert integer! = type? :value
	--test-- "type?gwv-2"
		value: #"a"
	--assert char! = type? :value
	--test-- "type?gwv-3"
		value: [a b c d]
	--assert block! = type? :value
	--test-- "type?gwv-4"
		value: first [:g]
	--assert get-word! = type? :value
	--test-- "type?gwv-5"
		value: true
	--assert logic! = type? :value
	--test-- "type?gwv-6"
		value: #123456789
	--assert issue! = type? :value
	--test-- "type?gwv-7"
		value: none
	--assert none! = type? :value
	--test-- "type?gwv-8"
		value: first [("abcd")]
	--assert paren! = type? :value
	--test-- "type?gwv-9"
		value: first [a: ]
	--assert set-word! = type? :value
	--test-- "type?gwv-10"
		value: "Hello Nenad"
	--assert string! = type? :value
	--test-- "type?gwv-11"
	  set/any 'value print ""
	--assert unset! = type? get/any 'value
	--test-- "type?gwv-12"
		value: 'a
	--assert word! = type? :value
	--test-- "type?gwv-13"
		value: first ['a]
	--assert lit-word! = type? :value
===end-group===

~~~end-file~~~


TESTS: added dynamic method calls tests.

Red [
	Title:   "Red/System object! datatype test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %object-test.red
	Version: "0.1.0"
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2014 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~~~ "object"

===start-group=== "basic tests"

	--test-- "basic-1"
		obj1: context []
		--assert "make object! []" = mold obj1

	--test-- "basic-2"
		obj2: object []
		--assert "make object! []" = mold obj2

	--test-- "basic-3"
		obj3: make object! []
		--assert "make object! []" = mold obj3

	--test-- "basic-4"
		blk: []
		obj4: object blk
		--assert "make object! []" = mold obj4

	--test-- "basic-5"
		obj5: object [
			a: 123
			show: does [a + 1]
			reset: does [a: none]
			--assert show = 124
			--assert a = 123
		]
		--assert obj5/show = 124
		obj5/reset
		--assert none? obj5/a

	--test-- "basic-6"
		obj5/a: 456
		--assert obj5/a = 456

	--test-- "basic-7"
		--assert find obj5 'a
		--assert not find obj5 'z
		--assert 456 = select obj5 'a
		--assert none? select obj5 'z

	--test-- "basic-8"
		obj8: context [
			b: 123
			a: object [
				b: 456
				double: does [b * 2]
				set-b: does [b: 'hello]
			]
		]
		--assert obj8/b = 123
		--assert obj8/a/b = 456
		--assert obj8/a/double = 912
		obj8/a/set-b
		--assert obj8/a/b = 'hello

	--test-- "basic-9"
		obj8/a/b: 'red
		--assert obj8/a/b = 'red

	--test-- "basic-10"
		obj10: object [
			a: 1
			b: 2
			inc: func [i /with a][b: i + either with [a][b]]
			sub: context [
				a: 3
				b: 4
				inc: func [i /with a][b: i + either with [a][b]]
			]
		]
		--assert 12 = obj10/inc 10
		--assert obj10/b = 12

		--assert 14 = obj10/sub/inc 10
		--assert obj10/sub/b = 14

	--test-- "basic-11"
		--assert 30 = obj10/inc/with 10 20
		--assert obj10/b = 30

		--assert 50 = obj10/sub/inc/with 10 40
		--assert obj10/sub/b = 50

	--test-- "basic-12"
		blk: [a: 99]
		obj12: object blk
		--assert obj12/a = 99

===end-group===

===start-group=== "Comparison tests"

	--test-- "comp-1"  --assert 	(context [])	 = (context [])
	--test-- "comp-2"  --assert not (context [a: 1]) = (context [])
	--test-- "comp-3"  --assert 	(context [a: 1]) = (context [a: 1])
	--test-- "comp-4"  --assert not (context [a: 1]) = (context [a: 2])
	--test-- "comp-5"  --assert 	(context [a: 1]) < (context [a: 2])
	--test-- "comp-6"  --assert not (context [a: 1]) >= (context [a: 2])
	--test-- "comp-7"  --assert 	(context [a: 2]) < (context [a: 1 b: none])

	--test-- "comp-8"
		obj:  context [a: 123]
		obj2: context [a: 123]
		--assert obj = obj2
		--assert not same? obj obj2
		--assert same? obj obj

===start-group=== "SELF test"

===end-group===

===start-group=== "simple object tests"

	--test-- "simple object 1"
		so1-a: 0
		so1-o: make object! [so1-a: 1]
		--assert so1-a = 0
		--assert so1-o/so1-a = 1

	--test-- "simple object 2"
		so2-s: "0"
		so2-o: make object! [so2-s: "1"]
		--assert so2-s = "0"
		--assert so2-o/so2-s = "1"

	--test-- "simple object 3"
		so3-s: "0"
		so3-i: 0
		so3-l: true
		so3-c: #"a"
		so3-b: [a b c]
		so3-f: func [][0]
		so3-bs: charset #"^(00)"
		so3-o: make object! [
			so3-s: "1"
			so3-i: 1
			so3-l: false
			so3-c: #"b"
			so3-b: [a b d]
			so3-f: func [][1]
			so3-bs: charset #"^(01)"
		]
		--assert so3-s = "0"
		--assert so3-o/so3-s = "1"
		--assert so3-i = 0
		--assert so3-o/so3-i = 1
		--assert so3-l = true
		--assert so3-o/so3-l = false
		--assert so3-c = #"a"
		--assert so3-o/so3-c = #"b"
		--assert so3-b = [a b c]
		--assert so3-o/so3-b = [a b d]
		--assert so3-f = 0
		--assert so3-o/so3-f = 1
		--assert "make bitset! #{80}" = mold so3-bs
		--assert "make bitset! #{40}" = mold so3-o/so3-bs

===end-group===

===start-group=== "nested objects"

	--test-- "no1"
		no1-o: make object! [o: make object! [i: 1] ]
		--assert no1-o/o/i = 1

	--test-- "no2"
		no2-o1: make object! [
			o2: make object! [
				i: 1
			]
		]
		--assert no2-o1/o2/i = 1

	--test-- "no3"
		no3-o1: make object! [
			o2: make object! [
			o3: make object! [
			o4: make object! [
				i: 1
			]]]
		]
		--assert no3-o1/o2/o3/o4/i = 1

	--test-- "no4"
		no4-o1: make object! [
			o2: make object! [
			o3: make object! [
			o4: make object! [
			o5: make object! [
			o6: make object! [
			o7: make object! [
				i: 1
			]]]]]]
		]
		--assert no4-o1/o2/o3/o4/o5/o6/o7/i = 1

	--test-- "no5"
		no5-o1: make object! [
			o2: make object! [
			o3: make object! [
			o4: make object! [
			o5: make object! [
			o6: make object! [
			o7: make object! [
			o8: make object! [
			o9: make object! [
			o10: make object! [
			o11: make object! [
			o12: make object! [
			o13: make object! [
			o14: make object! [
			o15: make object! [
				i: 1
			]]]]]]]]]]]]]]
		]
		--assert no5-o1/o2/o3/o4/o5/o6/o7/o8/o9/o10/o11/o12/o13/o14/o15/i = 1

	--test-- "no6 issue #928"
		no6-o: make object! [
			a: 1
			o: make object! [
				b: 2
				f: does [a]
				]
			]
		--assert 1 = no6-o/o/f

===end-group===

===start-group=== "object prototype tests"

	--test-- "op1"
		op1-o1: make object! [i: 1]
		op1-o2: make op1-o1 []
		--assert op1-o2/i = 1

	--test-- "op2"
		op2-o1: make object! [i: 1]
		op2-o2: make op2-o1 [i: 2]
		--assert op2-o2/i = 2
		--assert op2-o1/i = 1

	--test-- "op3"
		op3-o1: make object! [i: 1]
		op3-o2: make op3-o1 [i: 2 j: 3]
		--assert op3-o2/i = 2
		--assert op3-o2/j = 3

===end-group===

===start-group=== "object initialisation processing"

	--test-- "oip1"
		oip1-i: 1
		oip1-o: make object! [
			i: oip1-i
		]
		--assert 1 = oip1-o/i

	--test-- "oip2"
		oip2-i: 1
		oip2-o: make object! [
			i: either oip2-i = 1 [2] [3]
		]
		--assert 2 = oip2-o/i

	--test-- "oip3"
		oip3-i: 1
		oip3-o: make object! [
			i: 0
			set 'oip3-i 2
		]
		--assert 2 = oip3-i

	--test-- "oip4"
		oip4-o: make object! [
			i: 0
			set 'oip4-i 3
		]
		--assert 3 = oip4-i

===end-group===

===start-group=== "inheritance"

	--test-- "inherit-1"
		proto: context [
			a: 123
			get-a: does [a]
		]
		new: make proto [a: 99]
		--assert new/a = 99
		--assert new/get-a = 99
		--assert proto/a = 123
		--assert proto/get-a = 123

	--test-- "inherit-2"
		new/a: 456
		--assert new/get-a = 456
		proto/a: 759
		--assert proto/a = 759
		--assert new/get-a = 456

	--test-- "inherit-3"
		newnew: make new [
			reset: does [a: none]
		]
		--assert newnew/a = 456
		newnew/reset
		--assert none? newnew/a
		--assert new/a = 456
		--assert proto/a = 759

	--test-- "inherit-4"
		base: context [
			v: 0
			foo: does [v]
		]

		i: 0
		list: []
		loop 2 [
			bb: make base [v: i]
			--assert bb/foo = i
			append list bb
			i: i + 1
		]
		--assert object? list/1
		--assert list/1/v = 0
		--assert list/2/v = 1

	--test-- "inherit-5"
		base5: context [
			b: 123
			get-b: does [b]
			a: object [
				b: 456
				double: does [b * 2]
				set-b: func [/with v] [b: either with [v]['hello]]
			]
		]
		proto5: context [
			b: 999
			value: 71
			foo: does [b + value]
		]
		new: make base5 proto5
		--assert object? new
		--assert new/b = 999
		--assert new/value = 71
		--assert new/a/b = 456
		--assert base5/b = 123

	--test-- "inherit-6"
		--assert new/get-b = 999
		--assert new/a/double = 912
		--assert new/a/set-b/with 10
		--assert new/a/b = 10
		--assert new/b = 999
		--assert base5/b = 123
		--assert new/a/double = 20
		--assert base5/a/double = 20

	--test-- "inherit-7"
		--assert same? new/a base5/a

	--test-- "inherit-8"
		--assert new/foo = 1070

	--test-- "inherit-9"
		base9: context [
			v: 123456
			show: does [v]
		]
		i: 100
		list: []
		loop 3 [
			new9: make base9 [v: i]
			--assert new9/v = i
			--assert new9/show = i
			append list new9
			i: i + 1
		]
		--assert base9/v = 123456
		--assert list/1/v = 100
		--assert list/2/v = 101
		--assert list/3/v = 102

===end-group===

===start-group=== "dynamic invocation"

	--test-- "dyn-1"
		d: context [
			value: 998
		    f: does [value]
		]
		h: :d/f
		--assert h = 998
		d/value: 123
		--assert 123 = do [h]

	--test-- "dyn-2"
		f: func [/local z][
		    z: object [
		        a: 1
		        g: func [/with b /local c][c: 10 either with [a + b + 10][a * 2]]
		        j: func [i][i + 1]
		    ]
	    	z
		]
		o: make f [a: 3]
		--assert 46 = o/j 45
		--assert 101 = o/j 100

	--test-- "dyn-3"
		--assert 52 = o/j o/j 50

	--test-- "dyn-4"
		--assert 33 = o/g/with 20
		--assert 59 = o/g/with o/j 45

	--test-- "dyn-5"
		--assert 12 = o/j z: 5 + 6
		--assert  z = 11

	--test-- "dyn-6"
		--assert [17] = reduce [o/j o/j z: 5 + 10]
		--assert z = 15

	--test-- "dyn-7"
		repeat c 1 [
			if yes [
				--assert 52 = o/j o/j 50
				--assert 59 = o/g/with o/j 45
				--assert [22] = reduce [o/j o/j z: 5 + 15]
				--assert z = 20
			]
		]

	--test-- "dyn-8"
		o2: context [zz: none]				;-- test renaming a statically compiled object

		f: does [
		    make object! [
		        a: 1
		        g: does [a]
		    ]
		]
		o2: f
		--assert 1 = o2/g

~~~end-file~~~

Red [
	Title:   "Red/System object! datatype test script"
	Author:  "Nenad Rakocevic & Peter W A Wood"
	File: 	 %object-test.red
	Version: "0.1.0"
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2014 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~~~ "object"

===start-group=== "basic tests"

	--test-- "basic-1"
		obj1: context []
		--assert "make object! []" = mold obj1

	--test-- "basic-2"
		obj2: object []
		--assert "make object! []" = mold obj2

	--test-- "basic-3"
		obj3: make object! []
		--assert "make object! []" = mold obj3

	--test-- "basic-4"
		blk: []
		obj4: object blk
		--assert "make object! []" = mold obj4

	--test-- "basic-5"
		obj5: object [
			a: 123
			show: does [a + 1]
			reset: does [a: none]
			--assert show = 124
			--assert a = 123
		]
		--assert obj5/show = 124
		obj5/reset
		--assert none? obj5/a

	--test-- "basic-6"
		obj5/a: 456
		--assert obj5/a = 456

	--test-- "basic-7"
		--assert find obj5 'a
		--assert not find obj5 'z
		--assert 456 = select obj5 'a
		--assert none? select obj5 'z

	--test-- "basic-8"
		obj8: context [
			b: 123
			a: object [
				b: 456
				double: does [b * 2]
				set-b: does [b: 'hello]
			]
		]
		--assert obj8/b = 123
		--assert obj8/a/b = 456
		--assert obj8/a/double = 912
		obj8/a/set-b
		--assert obj8/a/b = 'hello

	--test-- "basic-9"
		obj8/a/b: 'red
		--assert obj8/a/b = 'red

	--test-- "basic-10"
		obj10: object [
			a: 1
			b: 2
			inc: func [i /with a][b: i + either with [a][b]]
			sub: context [
				a: 3
				b: 4
				inc: func [i /with a][b: i + either with [a][b]]
			]
		]
		--assert 12 = obj10/inc 10
		--assert obj10/b = 12

		--assert 14 = obj10/sub/inc 10
		--assert obj10/sub/b = 14

	--test-- "basic-11"
		--assert 30 = obj10/inc/with 10 20
		--assert obj10/b = 30

		--assert 50 = obj10/sub/inc/with 10 40
		--assert obj10/sub/b = 50

	--test-- "basic-12"
		blk: [a: 99]
		obj12: object blk
		--assert obj12/a = 99

===end-group===

===start-group=== "Comparison tests"

	--test-- "comp-1"  --assert 	(context [])	 = (context [])
	--test-- "comp-2"  --assert not (context [a: 1]) = (context [])
	--test-- "comp-3"  --assert 	(context [a: 1]) = (context [a: 1])
	--test-- "comp-4"  --assert not (context [a: 1]) = (context [a: 2])
	--test-- "comp-5"  --assert 	(context [a: 1]) < (context [a: 2])
	--test-- "comp-6"  --assert not (context [a: 1]) >= (context [a: 2])
	--test-- "comp-7"  --assert 	(context [a: 2]) < (context [a: 1 b: none])

	--test-- "comp-8"
		obj:  context [a: 123]
		obj2: context [a: 123]
		--assert obj = obj2
		--assert not same? obj obj2
		--assert same? obj obj

===start-group=== "SELF test"

===end-group===

===start-group=== "simple object tests"

	--test-- "simple object 1"
		so1-a: 0
		so1-o: make object! [so1-a: 1]
		--assert so1-a = 0
		--assert so1-o/so1-a = 1

	--test-- "simple object 2"
		so2-s: "0"
		so2-o: make object! [so2-s: "1"]
		--assert so2-s = "0"
		--assert so2-o/so2-s = "1"

	--test-- "simple object 3"
		so3-s: "0"
		so3-i: 0
		so3-l: true
		so3-c: #"a"
		so3-b: [a b c]
		so3-f: func [][0]
		so3-bs: charset #"^(00)"
		so3-o: make object! [
			so3-s: "1"
			so3-i: 1
			so3-l: false
			so3-c: #"b"
			so3-b: [a b d]
			so3-f: func [][1]
			so3-bs: charset #"^(01)"
		]
		--assert so3-s = "0"
		--assert so3-o/so3-s = "1"
		--assert so3-i = 0
		--assert so3-o/so3-i = 1
		--assert so3-l = true
		--assert so3-o/so3-l = false
		--assert so3-c = #"a"
		--assert so3-o/so3-c = #"b"
		--assert so3-b = [a b c]
		--assert so3-o/so3-b = [a b d]
		--assert so3-f = 0
		--assert so3-o/so3-f = 1
		--assert "make bitset! #{80}" = mold so3-bs
		--assert "make bitset! #{40}" = mold so3-o/so3-bs

===end-group===

===start-group=== "nested objects"

	--test-- "no1"
		no1-o: make object! [o: make object! [i: 1] ]
		--assert no1-o/o/i = 1

	--test-- "no2"
		no2-o1: make object! [
			o2: make object! [
				i: 1
			]
		]
		--assert no2-o1/o2/i = 1

	--test-- "no3"
		no3-o1: make object! [
			o2: make object! [
			o3: make object! [
			o4: make object! [
				i: 1
			]]]
		]
		--assert no3-o1/o2/o3/o4/i = 1

	--test-- "no4"
		no4-o1: make object! [
			o2: make object! [
			o3: make object! [
			o4: make object! [
			o5: make object! [
			o6: make object! [
			o7: make object! [
				i: 1
			]]]]]]
		]
		--assert no4-o1/o2/o3/o4/o5/o6/o7/i = 1

	--test-- "no5"
		no5-o1: make object! [
			o2: make object! [
			o3: make object! [
			o4: make object! [
			o5: make object! [
			o6: make object! [
			o7: make object! [
			o8: make object! [
			o9: make object! [
			o10: make object! [
			o11: make object! [
			o12: make object! [
			o13: make object! [
			o14: make object! [
			o15: make object! [
				i: 1
			]]]]]]]]]]]]]]
		]
		--assert no5-o1/o2/o3/o4/o5/o6/o7/o8/o9/o10/o11/o12/o13/o14/o15/i = 1

	--test-- "no6 issue #928"
		no6-o: make object! [
			a: 1
			o: make object! [
				b: 2
				f: does [a]
				]
			]
		--assert 1 = no6-o/o/f

===end-group===

===start-group=== "object prototype tests"

	--test-- "op1"
		op1-o1: make object! [i: 1]
		op1-o2: make op1-o1 []
		--assert op1-o2/i = 1

	--test-- "op2"
		op2-o1: make object! [i: 1]
		op2-o2: make op2-o1 [i: 2]
		--assert op2-o2/i = 2
		--assert op2-o1/i = 1

	--test-- "op3"
		op3-o1: make object! [i: 1]
		op3-o2: make op3-o1 [i: 2 j: 3]
		--assert op3-o2/i = 2
		--assert op3-o2/j = 3

===end-group===

===start-group=== "object initialisation processing"

	--test-- "oip1"
		oip1-i: 1
		oip1-o: make object! [
			i: oip1-i
		]
		--assert 1 = oip1-o/i

	--test-- "oip2"
		oip2-i: 1
		oip2-o: make object! [
			i: either oip2-i = 1 [2] [3]
		]
		--assert 2 = oip2-o/i

	--test-- "oip3"
		oip3-i: 1
		oip3-o: make object! [
			i: 0
			set 'oip3-i 2
		]
		--assert 2 = oip3-i

	--test-- "oip4"
		oip4-o: make object! [
			i: 0
			set 'oip4-i 3
		]
		--assert 3 = oip4-i

===end-group===

===start-group=== "inheritance"

	--test-- "inherit-1"
		proto: context [
			a: 123
			get-a: does [a]
		]
		new: make proto [a: 99]
		--assert new/a = 99
		--assert new/get-a = 99
		--assert proto/a = 123
		--assert proto/get-a = 123

	--test-- "inherit-2"
		new/a: 456
		--assert new/get-a = 456
		proto/a: 759
		--assert proto/a = 759
		--assert new/get-a = 456

	--test-- "inherit-3"
		newnew: make new [
			reset: does [a: none]
		]
		--assert newnew/a = 456
		newnew/reset
		--assert none? newnew/a
		--assert new/a = 456
		--assert proto/a = 759

	--test-- "inherit-4"
		base: context [
			v: 0
			foo: does [v]
		]

		i: 0
		list: []
		loop 2 [
			bb: make base [v: i]
			--assert bb/foo = i
			append list bb
			i: i + 1
		]
		--assert object? list/1
		--assert list/1/v = 0
		--assert list/2/v = 1

	--test-- "inherit-5"
		base5: context [
			b: 123
			get-b: does [b]
			a: object [
				b: 456
				double: does [b * 2]
				set-b: func [/with v] [b: either with [v]['hello]]
			]
		]
		proto5: context [
			b: 999
			value: 71
			foo: does [b + value]
		]
		new: make base5 proto5
		--assert object? new
		--assert new/b = 999
		--assert new/value = 71
		--assert new/a/b = 456
		--assert base5/b = 123

	--test-- "inherit-6"
		--assert new/get-b = 999
		--assert new/a/double = 912
		--assert new/a/set-b/with 10
		--assert new/a/b = 10
		--assert new/b = 999
		--assert base5/b = 123
		--assert new/a/double = 20
		--assert base5/a/double = 20

	--test-- "inherit-7"
		--assert same? new/a base5/a

	--test-- "inherit-8"
		--assert new/foo = 1070

	--test-- "inherit-9"
		base9: context [
			v: 123456
			show: does [v]
		]
		i: 100
		list: []
		loop 3 [
			new9: make base9 [v: i]
			--assert new9/v = i
			--assert new9/show = i
			append list new9
			i: i + 1
		]
		--assert base9/v = 123456
		--assert list/1/v = 100
		--assert list/2/v = 101
		--assert list/3/v = 102

===end-group===

===start-group=== "dynamic invocation"

	d: context [
		value: 998
	    f: does [value]
	]
	h: :d/f
	--assert h = 998
	d/value: 123
	--assert 123 = do [h]

~~~end-file~~~


FIX: partial fix for #1127 (Make the error message grammatically correct)

Red [
	Title:	"Console help functions"
	Author:	["Ingo Hohmann" "Nenad Rakocevic"]
	File:	%help.red
	Tabs:	4
	Rights:	"Copyright (C) 2014 Ingo Hohmann, 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
	}
]

help: func [
	"Display helping information about words and other values"
	'word [any-type!] "Word you are looking for"
	/local func-name desc spec tab tab4 tab8 type start attributes info fun w ref block w1 w2 value
][
	tab: tab4: "    "
	tab8: "        "

	case [
		unset? :word [									;-- HELP with no arguments
			print {Use HELP or ? to see built-in info:

    help insert
    ? insert

To see all words of a specific datatype:

    ? native!
    ? function!
    ? datatype!

Other useful functions:

    ?? - display a variable and its value
    probe - print a value (molded)
    source func - show source code of func
    what - show a list of known functions
    about - display version number and build date
    q or quit - leave the Red console
}
			exit
		]
		all [word? word datatype? get :word] [			;-- HELP <datatype!>
			type: get :word
			foreach w system/words [
				if type = type? get w [
					case [
						any [function? get w native? get w action? get w op? get w routine? get w][
							prin [tab w]
							spec: spec-of get w

							either any [
								string? desc: spec/1
								string? desc: spec/2	;-- attributes block case
							][
								print ["^-=> " desc]
							][
								prin lf
							]
						]
						datatype? get w [
							print [tab :w]
						]
						'else [
							print [tab :w "^-: " mold get w]
						]
					]
				]
			]
			exit
		]
		string? word [
			foreach w system/words [
				if any [function? get w native? get w action? get w op? get w routine? get w][
					spec: spec-of get w
					if any [find form w word find form spec word] [
						prin [tab w]

						either any [
							string? desc: spec/1
							string? desc: spec/2		;-- attributes block case
						][
							print ["^-=> " desc]
						][
							prin lf
						]
					]
				]
			]
			exit
		]
	]

	func-name: :word

	argument-rule: [
		set word [word! | lit-word! | get-word!]
		(prin [tab mold :word])
		opt [set type block!  (prin [#" " mold type])]
		opt [set info string! (prin [" =>" append form info dot])]
		(prin lf)
	]

	case [
		unset? get/any :word [
			print ["Word" :word "is not defined"]
		]
		all [
			any [word? func-name path? func-name]
			fun: get func-name
			any [action? :fun function? :fun native? :fun op? :fun routine? :fun]
		][
			prin ["^/USAGE:^/" tab ]

			parse spec-of :fun [
				start: [									;-- 1st pass
					any [block! | string! ]
					opt [set w [word! | lit-word! | get-word!] (either op? :fun [prin [mold w func-name]][prin [func-name mold w]])]
					any [
						/local to end
						| set w [word! | lit-word! | get-word!] (prin [" " w])
						| set w refinement! (prin [" " mold w])
						| skip
					]
				]

				:start										;-- 2nd pass
				opt [set attributes block! (prin ["^/^/ATTRIBUTES:^/" tab mold attributes])]
				opt [set info string! (print ["^/^/DESCRIPTION:^/" tab append form info dot lf tab func-name "is of type:" mold type? :fun])]

				(print "^/ARGUMENTS:")
				any [argument-rule]; (prin lf)]

				(print "^/REFINEMENTS:")
				any [
					/local [
						to ahead set-word! 'return set block block!
						(print ["^/RETURN:^/" mold block])
						| to end
					]
					| [
						set ref refinement! (prin [tab mold ref])
						opt [set info string! (prin [" =>" append form info dot])]
						(tab: tab8 prin lf)
						any [argument-rule]
						(tab: tab4)
					]
				]
			]
		]
		all [any [word? word path? word] object? get word][
			prin #"`"
			prin form word
			print "` is an object! of value:"

			foreach w words-of get word [
				value: get/any in get word w

				desc: case [
					object? :value  [words-of value]
					find [op! action! native! function! routine!] type?/word :value [
						spec: spec-of :value
						if string? spec/1 [spec: spec/1]
						spec
					]
					'else [:value]
				]

				desc: either string? desc [copy/part desc 47][mold/part/flat desc 47]

				if 47 = length? desc [					;-- optimized for width = 78
					clear skip tail desc -3
					append desc "..."
				]
				print [
					tab
					pad form/part w 16 16
					pad mold type? get/any w 9
					desc
				]
			]
		]
		'else [
			value: get :word
			print [
				word "is a"
				mold type? :value
				"of value:"
				mold either path? :value [get :value][:value]
			]
		]
	]
	exit												;-- return unset value
]

?: :help

what: function [
	"Lists all functions, or words of a given type"
][
	foreach w system/words [
		if any [function? get w native? get w action? get w op? get w routine? get w][
			prin pad form w 15
			spec: spec-of get w

			either any [
				string? desc: spec/1
				string? desc: spec/2					;-- attributes block case
			][
				print [#":" desc]
			][
				prin lf
			]
		]
	]
	exit												;-- return unset value
]

source: function [
	"Print the source of a function"
	'func-name [any-word!] "The name of the function"
][
	print either function? get func-name [
		[append mold func-name #":" mold get func-name]
	][
		type: mold type? get func-name
		a: pick ["an" "a"] make logic! find "aeiou" type/1
		["Sorry," func-name "is" a type "so no source is available"]
	]
]

about: function [
	"Print Red version information"
][
	print ["Red" system/version #"-" system/build]
]

Red [
	Title:	"Console help functions"
	Author:	["Ingo Hohmann" "Nenad Rakocevic"]
	File:	%help.red
	Tabs:	4
	Rights:	"Copyright (C) 2014 Ingo Hohmann, 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
	}
]

help: func [
	"Display helping information about words and other values"
	'word [any-type!] "Word you are looking for"
	/local func-name desc spec tab tab4 tab8 type start attributes info fun w ref block w1 w2 value
][
	tab: tab4: "    "
	tab8: "        "

	case [
		unset? :word [									;-- HELP with no arguments
			print {Use HELP or ? to see built-in info:

    help insert
    ? insert

To see all words of a specific datatype:

    ? native!
    ? function!
    ? datatype!

Other useful functions:

    ?? - display a variable and its value
    probe - print a value (molded)
    source func - show source code of func
    what - show a list of known functions
    about - display version number and build date
    q or quit - leave the Red console
}
			exit
		]
		all [word? word datatype? get :word] [			;-- HELP <datatype!>
			type: get :word
			foreach w system/words [
				if type = type? get w [
					case [
						any [function? get w native? get w action? get w op? get w routine? get w][
							prin [tab w]
							spec: spec-of get w

							either any [
								string? desc: spec/1
								string? desc: spec/2	;-- attributes block case
							][
								print ["^-=> " desc]
							][
								prin lf
							]
						]
						datatype? get w [
							print [tab :w]
						]
						'else [
							print [tab :w "^-: " mold get w]
						]
					]
				]
			]
			exit
		]
		string? word [
			foreach w system/words [
				if any [function? get w native? get w action? get w op? get w routine? get w][
					spec: spec-of get w
					if any [find form w word find form spec word] [
						prin [tab w]

						either any [
							string? desc: spec/1
							string? desc: spec/2		;-- attributes block case
						][
							print ["^-=> " desc]
						][
							prin lf
						]
					]
				]
			]
			exit
		]
	]

	func-name: :word

	argument-rule: [
		set word [word! | lit-word! | get-word!]
		(prin [tab mold :word])
		opt [set type block!  (prin [#" " mold type])]
		opt [set info string! (prin [" =>" append form info dot])]
		(prin lf)
	]

	case [
		unset? get/any :word [
			print ["Word" :word "is not defined"]
		]
		all [
			any [word? func-name path? func-name]
			fun: get func-name
			any [action? :fun function? :fun native? :fun op? :fun routine? :fun]
		][
			prin ["^/USAGE:^/" tab ]

			parse spec-of :fun [
				start: [									;-- 1st pass
					any [block! | string! ]
					opt [set w [word! | lit-word! | get-word!] (either op? :fun [prin [mold w func-name]][prin [func-name mold w]])]
					any [
						/local to end
						| set w [word! | lit-word! | get-word!] (prin [" " w])
						| set w refinement! (prin [" " mold w])
						| skip
					]
				]

				:start										;-- 2nd pass
				opt [set attributes block! (prin ["^/^/ATTRIBUTES:^/" tab mold attributes])]
				opt [set info string! (print ["^/^/DESCRIPTION:^/" tab append form info dot lf tab func-name "is of type:" mold type? :fun])]

				(print "^/ARGUMENTS:")
				any [argument-rule]; (prin lf)]

				(print "^/REFINEMENTS:")
				any [
					/local [
						to ahead set-word! 'return set block block!
						(print ["^/RETURN:^/" mold block])
						| to end
					]
					| [
						set ref refinement! (prin [tab mold ref])
						opt [set info string! (prin [" =>" append form info dot])]
						(tab: tab8 prin lf)
						any [argument-rule]
						(tab: tab4)
					]
				]
			]
		]
		all [any [word? word path? word] object? get word][
			prin #"`"
			prin form word
			print "` is an object! of value:"

			foreach w words-of get word [
				value: get/any in get word w

				desc: case [
					object? :value  [words-of value]
					find [op! action! native! function! routine!] type?/word :value [
						spec: spec-of :value
						if string? spec/1 [spec: spec/1]
						spec
					]
					'else [:value]
				]

				desc: either string? desc [copy/part desc 47][mold/part/flat desc 47]

				if 47 = length? desc [					;-- optimized for width = 78
					clear skip tail desc -3
					append desc "..."
				]
				print [
					tab
					pad form/part w 16 16
					pad mold type? get/any w 9
					desc
				]
			]
		]
		'else [
			value: get :word
			print [
				word "is a"
				mold type? :value
				"of value:"
				mold either path? :value [get :value][:value]
			]
		]
	]
	exit												;-- return unset value
]

?: :help

what: function [
	"Lists all functions, or words of a given type"
][
	foreach w system/words [
		if any [function? get w native? get w action? get w op? get w routine? get w][
			prin pad form w 15
			spec: spec-of get w

			either any [
				string? desc: spec/1
				string? desc: spec/2					;-- attributes block case
			][
				print [#":" desc]
			][
				prin lf
			]
		]
	]
	exit												;-- return unset value
]

source: function [
	"Print the source of a function"
	'func-name [any-word!] "The name of the function"
][
	print either function? get func-name [
		[append mold func-name #":" mold get func-name]
	][
		["Sorry," func-name "is a" mold type? get func-name "so no source is available"]
	]
]

about: function [
	"Print Red version information"
][
	print ["Red" system/version #"-" system/build]
]


TESTS: test `issue #222` in float-test now requires an almost-equal comparison to pass on ARM.

Red/System [
	Title:   "Red/System integer! datatype tests"
	Author:  "Peter W A Wood, Nenad Rakocevic"
	File: 	 %float-test.reds
	Version: 0.1.0
	Rights:  "Copyright (C) 2012 Peter W A Wood, Nenad Rakocevic. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/origin/BSD-3-License.txt"
]

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

~~~start-file~~~ "float"

===start-group=== "float assignment"
  --test-- "float-1"
    f: 100.0
  --assert f = 100.0
  --test-- "float-2"
    f: 1.222090944E+33
  --assert f = 1.222090944E+33
  --test-- "float-3"
    f: 9.99999E-45
  --assert f = 9.99999E-45
  --test-- "float-4"
    f: 1.0
    f1: f
  --assert f1 = 1.0
===end-group===

===start-group=== "float argument to external function"

	#import [
		LIBM-file cdecl [
			sin: "sin" [
				x 		[float!]
				return: [float!]
			]
			cos: "cos" [
				x 		[float!]
				return: [float!]
			]
		]
	]
	pi: 3.14159265358979

	--test-- "float-ext-1"
	--assert -1.0 = cos pi

	--test-- "float-ext-2"
	--assertf~= 0.0 sin pi	1E-10	; not working, because of rounding error.

	--test-- "float-ext-3"
	--assert -1.0 = cos 3.14159265358979

===end-group===

===start-group=== "float function arguments"
    ff: func [
      fff     [float!]
      ffg     [float!]
      return: [integer!]
      /local
      ffl [float!]
    ][
       ffl: fff
       if ffl <> fff [return 1]
       ffl: ffg
       if ffl <> ffg [return 2]
       1
    ]

  --test-- "float-func-args-1"
  --assert 1 = ff 1.0 2.0

  --test-- "float-func-args-2"
  --assert 1 = ff 1.222090944E+33 9.99999E-45

===end-group===

===start-group=== "float locals"

	local-float: func [n [float!] return: [float!] /local p][p: n p]

	--test-- "float-loc-1"
	pi: local-float 3.14159265358979
	--assert pi = 3.14159265358979
	--assert -1.0 = cos pi
	--assert -1.0 = local-float cos pi

	--test-- "float-loc-2"
	f: local-float pi
	--assert pi = local-float f

	--test-- "float-loc-3"
	local-float2: func [n [float!] return: [float!] /local p][p: n local-float p]

	pi: local-float2 3.14159265358979
	--assert -1.0 = local-float2 cos pi
	f: local-float2 pi
	--assert pi = local-float2 f

	--test-- "float-loc-4"
	local-float3: func [n [float!] return: [float!] /local p [float!]][p: n local-float p]

	pi: local-float3 3.14159265358979
	--assert -1.0 = local-float3 cos pi
	f: local-float3 pi
	--assert pi = local-float3 f

	--test-- "float-loc-5"
	local-float4: func [n [float!] return: [float!] /local r p][p: n p]
	--assert -1.0 = local-float4 cos pi
	f: local-float4 pi
	--assert pi = local-float4 f

	--test-- "float-loc-6"
	local-float5: func [n [float!] return: [float!] /local r p][p: n local-float p]
	--assert -1.0 = local-float5 cos pi
	f: local-float5 pi
	--assert pi = local-float5 f

===end-group===

===start-group=== "float function return"

    ff1: func [
      ff1i      [integer!]
      return:   [float!]
    ][
      switch ff1i [
        1 [1.0]
        2 [1.222090944E+33]
        3 [9.99999E-45]
      ]
    ]
  --test-- "float return 1"
  --assert 1.0 = ff1 1
  --test-- "float return 2"
  --assert 1.222090944E+33 = ff1 2
  --test-- "float return 3"
  --assert 9.99999E-45 = ff1 3

===end-group===

===start-group=== "float members in struct"

  --test-- "float-struct-1"
    sf1: declare struct! [
      a   [float!]
    ]
  --assert 0.0 = sf1/a

  --test-- "float-struct-2"
    sf2: declare struct! [
      a   [float!]
    ]
    sf1/a: 1.222090944E+33
  --assert 1.222090944E+33 = sf1/a

    sf3: declare struct! [
      a   [float!]
      b   [float!]
    ]

  --test-- "float-struct-3"
    sf3/a: 1.222090944E+33
    sf3/b: 9.99999E-45

  --assert 1.222090944E+33 = sf3/a
  --assert 9.99999E-45 = sf3/b

  --test-- "float-struct-4"
    sf4: declare struct! [
      c   [byte!]
      a   [float!]
      l   [logic!]
      b   [float!]
    ]
    sf4/a: 1.222090944E+33
    sf4/b: 9.99999E-45
  --assert 1.222090944E+33 = sf4/a
  --assert 9.99999E-45 = sf4/b

  --test-- "float-struct-5"
  sf5: declare struct! [f [float!] i [integer!]]

  sf5/i: 1234567890
  sf5/f: 3.14159265358979
  --assert sf5/i = 1234567890
  --assert sf5/f = pi

  --test-- "float-struct-6"
  sf6: declare struct! [i [integer!] f [float!]]

  sf6/i: 1234567890
  sf6/f: 3.14159265358979
  --assert sf6/i = 1234567890
  --assert sf6/f = pi

===end-group===

===start-group=== "float pointers"

  --test-- "float-point-1"
  pi: 3.14159265358979
  p: declare pointer! [float!]
  p/value: 3.14159265358979
  --assert pi = p/value

 ;TBD: add more float pointer tests in %pointer-test.reds.

===end-group===

===start-group=== "expressions with returned float values"

    fe1: function [
      return: [float!]
    ][
      1.0
    ]
    fe2: function [
      return: [float!]
    ][
      2.0
    ]

  --test-- "ewrfv0"
  --assertf~= 1.0 (fe1 * 1.0) 0.1E-13

  --test-- "ewrfv1"
  --assertf~= 1.0 (1.0 * fe1) 0.1E-13

  --test-- "ewrfv2"
  --assertf~= 0.5 (fe1 / fe2) 0.1E-13

===end-group===

 ===start-group=== "float arguments to typed functions"
    fatf1: function [
      [typed]
      count [integer!]
      list [typed-float!]
      return: [float!]
      /local
        a [float!]
    ][
      a: as float! list/value
      a
    ]

    fatf2: function [
      [typed]
      count [integer!]
      list [typed-float!]
      return: [float!]
      /local
        a [float!]
        b [float!]
    ][
      a: as float! list/value
      list: list + 1
      b: as float! list/value
      a + b
    ]

  --test-- "fatf-1"
  --assert 2.0 = fatf1 2.0

  --test-- "fatf-2"
  --assert 2.0 = fatf1 1.0 + fatf1 1.0

  --test-- "fatf-3"
  --assert 3.0 = fatf2 [1.0 2.0]

===end-group===

===start-group=== "calculations"

	fcfoo: func [a [float!] return: [float!]][a]

	fcptr: declare struct! [a [float!]]
	fcptr/a: 3.0

	fc2: 3.0

	--test-- "fc-1"
	fc1: 2.0
	fc1: fc1 / (fc1 - 1.0)
	--assertf~= 2.0 fc1 0.1E-13

	--test-- "fc-2"
	--assert 5.0 - 3.0 = 2.0							;-- imm/imm

	--test-- "fc-3"
	--assert 5.0 - fc2 = 2.0							;-- imm/ref

	--test-- "fc-4"
	--assert 5.0 - (fcfoo 3.0) = 2.0					;-- imm/reg(block!)

	--test-- "fc-5"
	--assertf~= 5.0 - fcptr/a 2.0 1E-10					;-- imm/reg(path!)

	--test-- "fc-6"
	--assert fc2 - 5.0 = -2.0							;-- ref/imm

	--test-- "fc-7"
	--assert fc2 - (fcfoo 5.0) = -2.0					;-- ref/reg(block!)

	--test-- "fc-8"
	--assert fc2 - fcptr/a = 0.0						;-- ref/reg(path!)

	--test-- "fc-9"
	--assertf~= (fcfoo 5.0) - 3.0 2.0 1E-10				;-- reg(block!)/imm

	--test-- "fc-10"
	--assert (fcfoo 5.0) - (fcfoo 3.0) = 2.0			;-- reg(block!)/reg(block!)

	--test-- "fc-11"
	--assert (fcfoo 5.0) - fcptr/a = 2.0				;-- reg(block!)/reg(path!)

	--test-- "fc-12"
	--assert fcptr/a - (fcfoo 5.0) = 2.0				;-- reg(path!)/reg(block!)

===end-group===

===start-group=== "various regression tests from bugtracker"

	--test-- "issue #227"
	t: 2.2
	ss: declare struct! [v [float!]]
	ss/v: 2.0
	--assertf~= t - ss/v 0.2 1E-10

	--test-- "issue #226"
	number: 10
	array: declare pointer! [byte!]
	array: as byte-ptr! :number
	value: as integer! array/value
	--assert (10 * as integer! array/value) = 100

	--test-- "issue #225"
	j: 1.0
	f: 1.0
	data: declare pointer! [float!]
	data: :f
	while [j < 10.0][
		data/value: j
		j
		j: j + 1.0
	]
	--assertf~= j 10.0 1E-10

	--test-- "issues #223"
	a: as pointer! [float!] allocate 10 * size? float!
	i: 1
	f: 1.0
	while [i <= 10][
		f: f * 0.8
		;print [f lf]
		a/i: f
		i: i + 1
	]
	--assert i = 11

	--test-- "issue #222"
	s: declare struct! [value [float!]]
	s/value: 1.0
	a: as pointer! [float!] allocate 100 * size? float!
	a/1: s/value    ; value must be in struct!
	a/1: s/value    ; must be done twice
	1.0 + 1.0          ; must be followed by an expression
	if true [a/1: s/value]
	--assertf~= a/1 1.0 1E-10

	--test-- "issue #221"
	x: -1.0
	y: either x < 0.0 [0.0 - x][x]
	--assert y = 1.0

	fabs: func [x [float!] return: [float!] ][
	    either x < 0.0 [0.0 - x][x]
	]
	--assert 3.14 = fabs -3.14

===end-group===

~~~end-file~~~

Red/System [
	Title:   "Red/System integer! datatype tests"
	Author:  "Peter W A Wood, Nenad Rakocevic"
	File: 	 %float-test.reds
	Version: 0.1.0
	Rights:  "Copyright (C) 2012 Peter W A Wood, Nenad Rakocevic. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/origin/BSD-3-License.txt"
]

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

~~~start-file~~~ "float"

===start-group=== "float assignment"
  --test-- "float-1"
    f: 100.0
  --assert f = 100.0
  --test-- "float-2"
    f: 1.222090944E+33
  --assert f = 1.222090944E+33
  --test-- "float-3"
    f: 9.99999E-45
  --assert f = 9.99999E-45
  --test-- "float-4"
    f: 1.0
    f1: f
  --assert f1 = 1.0
===end-group===

===start-group=== "float argument to external function"

	#import [
		LIBM-file cdecl [
			sin: "sin" [
				x 		[float!]
				return: [float!]
			]
			cos: "cos" [
				x 		[float!]
				return: [float!]
			]
		]
	]
	pi: 3.14159265358979

	--test-- "float-ext-1"
	--assert -1.0 = cos pi

	--test-- "float-ext-2"
	--assertf~= 0.0 sin pi	1E-10	; not working, because of rounding error.

	--test-- "float-ext-3"
	--assert -1.0 = cos 3.14159265358979

===end-group===

===start-group=== "float function arguments"
    ff: func [
      fff     [float!]
      ffg     [float!]
      return: [integer!]
      /local
      ffl [float!]
    ][
       ffl: fff
       if ffl <> fff [return 1]
       ffl: ffg
       if ffl <> ffg [return 2]
       1
    ]

  --test-- "float-func-args-1"
  --assert 1 = ff 1.0 2.0

  --test-- "float-func-args-2"
  --assert 1 = ff 1.222090944E+33 9.99999E-45

===end-group===

===start-group=== "float locals"

	local-float: func [n [float!] return: [float!] /local p][p: n p]

	--test-- "float-loc-1"
	pi: local-float 3.14159265358979
	--assert pi = 3.14159265358979
	--assert -1.0 = cos pi
	--assert -1.0 = local-float cos pi

	--test-- "float-loc-2"
	f: local-float pi
	--assert pi = local-float f

	--test-- "float-loc-3"
	local-float2: func [n [float!] return: [float!] /local p][p: n local-float p]

	pi: local-float2 3.14159265358979
	--assert -1.0 = local-float2 cos pi
	f: local-float2 pi
	--assert pi = local-float2 f

	--test-- "float-loc-4"
	local-float3: func [n [float!] return: [float!] /local p [float!]][p: n local-float p]

	pi: local-float3 3.14159265358979
	--assert -1.0 = local-float3 cos pi
	f: local-float3 pi
	--assert pi = local-float3 f

	--test-- "float-loc-5"
	local-float4: func [n [float!] return: [float!] /local r p][p: n p]
	--assert -1.0 = local-float4 cos pi
	f: local-float4 pi
	--assert pi = local-float4 f

	--test-- "float-loc-6"
	local-float5: func [n [float!] return: [float!] /local r p][p: n local-float p]
	--assert -1.0 = local-float5 cos pi
	f: local-float5 pi
	--assert pi = local-float5 f

===end-group===

===start-group=== "float function return"

    ff1: func [
      ff1i      [integer!]
      return:   [float!]
    ][
      switch ff1i [
        1 [1.0]
        2 [1.222090944E+33]
        3 [9.99999E-45]
      ]
    ]
  --test-- "float return 1"
  --assert 1.0 = ff1 1
  --test-- "float return 2"
  --assert 1.222090944E+33 = ff1 2
  --test-- "float return 3"
  --assert 9.99999E-45 = ff1 3

===end-group===

===start-group=== "float members in struct"

  --test-- "float-struct-1"
    sf1: declare struct! [
      a   [float!]
    ]
  --assert 0.0 = sf1/a

  --test-- "float-struct-2"
    sf2: declare struct! [
      a   [float!]
    ]
    sf1/a: 1.222090944E+33
  --assert 1.222090944E+33 = sf1/a

    sf3: declare struct! [
      a   [float!]
      b   [float!]
    ]

  --test-- "float-struct-3"
    sf3/a: 1.222090944E+33
    sf3/b: 9.99999E-45

  --assert 1.222090944E+33 = sf3/a
  --assert 9.99999E-45 = sf3/b

  --test-- "float-struct-4"
    sf4: declare struct! [
      c   [byte!]
      a   [float!]
      l   [logic!]
      b   [float!]
    ]
    sf4/a: 1.222090944E+33
    sf4/b: 9.99999E-45
  --assert 1.222090944E+33 = sf4/a
  --assert 9.99999E-45 = sf4/b

  --test-- "float-struct-5"
  sf5: declare struct! [f [float!] i [integer!]]

  sf5/i: 1234567890
  sf5/f: 3.14159265358979
  --assert sf5/i = 1234567890
  --assert sf5/f = pi

  --test-- "float-struct-6"
  sf6: declare struct! [i [integer!] f [float!]]

  sf6/i: 1234567890
  sf6/f: 3.14159265358979
  --assert sf6/i = 1234567890
  --assert sf6/f = pi

===end-group===

===start-group=== "float pointers"

  --test-- "float-point-1"
  pi: 3.14159265358979
  p: declare pointer! [float!]
  p/value: 3.14159265358979
  --assert pi = p/value

 ;TBD: add more float pointer tests in %pointer-test.reds.

===end-group===

===start-group=== "expressions with returned float values"

    fe1: function [
      return: [float!]
    ][
      1.0
    ]
    fe2: function [
      return: [float!]
    ][
      2.0
    ]

  --test-- "ewrfv0"
  --assertf~= 1.0 (fe1 * 1.0) 0.1E-13

  --test-- "ewrfv1"
  --assertf~= 1.0 (1.0 * fe1) 0.1E-13

  --test-- "ewrfv2"
  --assertf~= 0.5 (fe1 / fe2) 0.1E-13

===end-group===

 ===start-group=== "float arguments to typed functions"
    fatf1: function [
      [typed]
      count [integer!]
      list [typed-float!]
      return: [float!]
      /local
        a [float!]
    ][
      a: as float! list/value
      a
    ]

    fatf2: function [
      [typed]
      count [integer!]
      list [typed-float!]
      return: [float!]
      /local
        a [float!]
        b [float!]
    ][
      a: as float! list/value
      list: list + 1
      b: as float! list/value
      a + b
    ]

  --test-- "fatf-1"
  --assert 2.0 = fatf1 2.0

  --test-- "fatf-2"
  --assert 2.0 = fatf1 1.0 + fatf1 1.0

  --test-- "fatf-3"
  --assert 3.0 = fatf2 [1.0 2.0]

===end-group===

===start-group=== "calculations"

	fcfoo: func [a [float!] return: [float!]][a]

	fcptr: declare struct! [a [float!]]
	fcptr/a: 3.0

	fc2: 3.0

	--test-- "fc-1"
	fc1: 2.0
	fc1: fc1 / (fc1 - 1.0)
	--assertf~= 2.0 fc1 0.1E-13

	--test-- "fc-2"
	--assert 5.0 - 3.0 = 2.0							;-- imm/imm

	--test-- "fc-3"
	--assert 5.0 - fc2 = 2.0							;-- imm/ref

	--test-- "fc-4"
	--assert 5.0 - (fcfoo 3.0) = 2.0					;-- imm/reg(block!)

	--test-- "fc-5"
	--assertf~= 5.0 - fcptr/a 2.0 1E-10					;-- imm/reg(path!)

	--test-- "fc-6"
	--assert fc2 - 5.0 = -2.0							;-- ref/imm

	--test-- "fc-7"
	--assert fc2 - (fcfoo 5.0) = -2.0					;-- ref/reg(block!)

	--test-- "fc-8"
	--assert fc2 - fcptr/a = 0.0						;-- ref/reg(path!)

	--test-- "fc-9"
	--assertf~= (fcfoo 5.0) - 3.0 2.0 1E-10				;-- reg(block!)/imm

	--test-- "fc-10"
	--assert (fcfoo 5.0) - (fcfoo 3.0) = 2.0			;-- reg(block!)/reg(block!)

	--test-- "fc-11"
	--assert (fcfoo 5.0) - fcptr/a = 2.0				;-- reg(block!)/reg(path!)

	--test-- "fc-12"
	--assert fcptr/a - (fcfoo 5.0) = 2.0				;-- reg(path!)/reg(block!)

===end-group===

===start-group=== "various regression tests from bugtracker"

	--test-- "issue #227"
	t: 2.2
	ss: declare struct! [v [float!]]
	ss/v: 2.0
	--assertf~= t - ss/v 0.2 1E-10

	--test-- "issue #226"
	number: 10
	array: declare pointer! [byte!]
	array: as byte-ptr! :number
	value: as integer! array/value
	--assert (10 * as integer! array/value) = 100

	--test-- "issue #225"
	j: 1.0
	f: 1.0
	data: declare pointer! [float!]
	data: :f
	while [j < 10.0][
		data/value: j
		j
		j: j + 1.0
	]
	--assertf~= j 10.0 1E-10

	--test-- "issues #223"
	a: as pointer! [float!] allocate 10 * size? float!
	i: 1
	f: 1.0
	while [i <= 10][
		f: f * 0.8
		;print [f lf]
		a/i: f
		i: i + 1
	]
	--assert i = 11

	--test-- "issue #222"
	s: declare struct! [value [float!]]
	s/value: 1.0
	a: as pointer! [float!] allocate 100 * size? float!
	a/1: s/value    ; value must be in struct!
	a/1: s/value    ; must be done twice
	1.0 + 1.0          ; must be followed by an expression
	if true [a/1: s/value]
	--assert a/1 = 1.0

	--test-- "issue #221"
	x: -1.0
	y: either x < 0.0 [0.0 - x][x]
	--assert y = 1.0

	fabs: func [x [float!] return: [float!] ][
	    either x < 0.0 [0.0 - x][x]
	]
	--assert 3.14 = fabs -3.14

===end-group===

~~~end-file~~~


FIX: symbol base index off by one in dump-symbols debugging function.

Red/System [
	Title:   "Red runtime debugging functions"
	Author:  "Nenad Rakocevic"
	File: 	 %debug-tools.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
	}
]

;-------------------------------------------
;-- Memory stats
;-------------------------------------------
memory-info: func [
	blk		[red-block!]
	verbose [integer!]						;-- stat verbosity level (1, 2 or 3)
	/local
		n-frame s-frame b-frame free-nodes base list nodes series bigs
][
	assert all [1 <= verbose verbose <= 3]

;-- Node frames stats --
	nodes: block/make-in blk 8
	n-frame: memory/n-head

	while [n-frame <> null][
		if verbose >= 2 [
			free-nodes: (as-integer (n-frame/top - n-frame/bottom) + 1) / 4
			list: block/make-in nodes 8
			integer/load-in list n-frame/nodes - free-nodes
			integer/load-in list free-nodes
			integer/load-in list n-frame/nodes
		]
		n-frame: n-frame/next
	]

;-- Series frames stats --
	series: block/make-in blk 8
	s-frame: memory/s-head

	while [s-frame <> null][
		if verbose >= 2 [
			base: (as byte-ptr! s-frame) + size? series-frame!
			list: block/make-in series 8
			integer/load-in list as-integer s-frame/tail - as byte-ptr! s-frame/heap
			integer/load-in list as-integer (as byte-ptr! s-frame/heap) - base
			integer/load-in list  as-integer s-frame/tail - base
		]
		s-frame: s-frame/next
	]

;-- Big frames stats --
	bigs: block/make-in blk 8
	b-frame: memory/b-head

	while [b-frame <> null][
		if verbose >= 2 [
			integer/load-in bigs b-frame/size
		]
		b-frame: b-frame/next
	]
]

;===========================================
;== Debugging functions
;===========================================

#if debug? = yes [

	dump-globals: func [
		/local sym-table val-table len s symbol value w sym val syms i
	][
		sym-table: global-ctx/symbols
		val-table: global-ctx/values

		s: as series! sym-table/value
		len: (as-integer s/tail - s/offset) >> 4
		symbol: s/offset

		s: as series! val-table/value
		value: s/offset

		s: GET_BUFFER(symbols)
		syms: as red-symbol! s/offset

		print-line "Global Context"
		print-line "--------------"
		i: 0
		until [
			w: as red-word! symbol + i
			sym: syms + w/symbol - 1
			val: value + i
			print-line [i ": " sym/cache "^- : " TYPE_OF(val)]
			i: i + 1
			i + 1 = len
		]
	]

	;-------------------------------------------
	;-- Print usage stats about a given frame
	;-------------------------------------------
	frame-stats: func [
		free	[integer!]
		used	[integer!]
		total	[integer!]
		/local percent
	][
		assert free + used = total
		percent: 100 * used / total
		if all [not zero? used zero? percent][percent: 1]

		print [
			"used = " used "/" total " ("  percent "%), "
			"free = " free "/" total " (" 100 - percent "%)" lf
		]
	]

	;-------------------------------------------
	;-- List series buffer allocated in a given series frame
	;-------------------------------------------
	list-series-buffers: func [
		frame	[series-frame!]
		/local series alt? size block count head tail
	][
		count: 1
		series: as series-buffer! (as byte-ptr! frame) + size? series-frame!
		until [
			head: as-integer ((as byte-ptr! series/offset) - (as byte-ptr! series) - size? series-buffer!)
			tail: as-integer ((as byte-ptr! series/tail) - (as byte-ptr! series) - size? series-buffer!)
			print [
				" - " series
				": size = "	series/size
				", offset pos = " head ", tail pos = " tail
				"    "
			]
			if series/flags and flag-ins-head <> 0 [print "H"]
			if series/flags and flag-ins-tail <> 0 [print "T"]
			print lf
			count: count + 1

			series: as series-buffer! (as byte-ptr! series) + series/size + size? series-buffer!
			series >= frame/heap
		]
		assert series = frame/heap
	]

	;-------------------------------------------
	;-- Displays total frames count
	;-------------------------------------------
	print-frames-count: func [count [integer!] /local s][
		s: either count > 1 ["s^/"][newline]
		print ["^/    " count " frame" s lf]
	]

	;-------------------------------------------
	;-- Dump memory statistics on screen
	;-------------------------------------------
	memory-stats: func [
		verbose [integer!]						;-- stat verbosity level (1, 2 or 3)
		/local count n-frame s-frame b-frame free-nodes base
	][
		assert all [1 <= verbose verbose <= 3]

		print [lf "====== Red Memory Stats ======" lf]

	;-- Node frames stats --
		count: 0
		n-frame: memory/n-head

		print [lf "-- Node frames --" lf]
		while [n-frame <> null][
			if verbose >= 2 [
				print ["#" count + 1 ": "]
				free-nodes: (as-integer (n-frame/top - n-frame/bottom) + 1) / 4
				frame-stats
					free-nodes
					n-frame/nodes - free-nodes
					n-frame/nodes
			]
			count: count + 1
			n-frame: n-frame/next
		]
		print-frames-count count

	;-- Series frames stats --
		count: 0
		s-frame: memory/s-head

		print ["-- Series frames --" lf]
		while [s-frame <> null][
			if verbose >= 2 [
				print ["#" count + 1 ": "]
				base: (as byte-ptr! s-frame) + size? series-frame!
				frame-stats
					as-integer s-frame/tail - as byte-ptr! s-frame/heap
					as-integer (as byte-ptr! s-frame/heap) - base
					as-integer s-frame/tail - base
				if verbose >= 3 [
					list-series-buffers s-frame
				]
			]
			count: count + 1
			s-frame: s-frame/next
		]
		print-frames-count count

	;-- Big frames stats --
		count: 0
		b-frame: memory/b-head

		print ["-- Big frames --" lf]
		while [b-frame <> null][
			if verbose >= 2 [
				print ["#" count + 1 ": "]
				prin-int b-frame/size
			]
			count: count + 1
			b-frame: b-frame/next
		]
		print-frames-count count

		print [
			"Total memory used: " memory/total " bytes" lf
			"==============================" lf
		]
	]

	;-------------------------------------------
	;-- Dump memory layout of a given series frame
	;-------------------------------------------
	dump-series-frame: func [
		frame	[series-frame!]
		/local series alt? size block
	][
		series: as series-buffer! (as byte-ptr! frame) + size? series-frame!

		print [lf "=== Series layout for frame: <" frame "h>" lf]

		alt?: no
		until [
			block: either zero? (series/flags and series-in-use) [
				"."
			][
				alt?: not alt?
				either alt? ["x"]["o"]
			]

			size: series/size / 16
			until [
				print block
				size: size - 1
				zero? size
			]

			series: as series-buffer! (as byte-ptr! series) + series/size + size? series-buffer!
			series >= frame/heap
		]
		assert series = frame/heap
		print lf
	]

]

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

;-------------------------------------------
;-- Memory stats
;-------------------------------------------
memory-info: func [
	blk		[red-block!]
	verbose [integer!]						;-- stat verbosity level (1, 2 or 3)
	/local
		n-frame s-frame b-frame free-nodes base list nodes series bigs
][
	assert all [1 <= verbose verbose <= 3]

;-- Node frames stats --
	nodes: block/make-in blk 8
	n-frame: memory/n-head

	while [n-frame <> null][
		if verbose >= 2 [
			free-nodes: (as-integer (n-frame/top - n-frame/bottom) + 1) / 4
			list: block/make-in nodes 8
			integer/load-in list n-frame/nodes - free-nodes
			integer/load-in list free-nodes
			integer/load-in list n-frame/nodes
		]
		n-frame: n-frame/next
	]

;-- Series frames stats --
	series: block/make-in blk 8
	s-frame: memory/s-head

	while [s-frame <> null][
		if verbose >= 2 [
			base: (as byte-ptr! s-frame) + size? series-frame!
			list: block/make-in series 8
			integer/load-in list as-integer s-frame/tail - as byte-ptr! s-frame/heap
			integer/load-in list as-integer (as byte-ptr! s-frame/heap) - base
			integer/load-in list  as-integer s-frame/tail - base
		]
		s-frame: s-frame/next
	]

;-- Big frames stats --
	bigs: block/make-in blk 8
	b-frame: memory/b-head

	while [b-frame <> null][
		if verbose >= 2 [
			integer/load-in bigs b-frame/size
		]
		b-frame: b-frame/next
	]
]

;===========================================
;== Debugging functions
;===========================================

#if debug? = yes [

	dump-globals: func [
		/local sym-table val-table len s symbol value w sym val syms i
	][
		sym-table: global-ctx/symbols
		val-table: global-ctx/values

		s: as series! sym-table/value
		len: (as-integer s/tail - s/offset) >> 4
		symbol: s/offset

		s: as series! val-table/value
		value: s/offset

		s: GET_BUFFER(symbols)
		syms: as red-symbol! s/offset

		print-line "Global Context"
		print-line "--------------"
		i: 0
		until [
			w: as red-word! symbol + i
			sym: syms + w/symbol
			val: value + i
			print-line [i ": " sym/cache "^- : " TYPE_OF(val)]
			i: i + 1
			i + 1 = len
		]
	]

	;-------------------------------------------
	;-- Print usage stats about a given frame
	;-------------------------------------------
	frame-stats: func [
		free	[integer!]
		used	[integer!]
		total	[integer!]
		/local percent
	][
		assert free + used = total
		percent: 100 * used / total
		if all [not zero? used zero? percent][percent: 1]

		print [
			"used = " used "/" total " ("  percent "%), "
			"free = " free "/" total " (" 100 - percent "%)" lf
		]
	]

	;-------------------------------------------
	;-- List series buffer allocated in a given series frame
	;-------------------------------------------
	list-series-buffers: func [
		frame	[series-frame!]
		/local series alt? size block count head tail
	][
		count: 1
		series: as series-buffer! (as byte-ptr! frame) + size? series-frame!
		until [
			head: as-integer ((as byte-ptr! series/offset) - (as byte-ptr! series) - size? series-buffer!)
			tail: as-integer ((as byte-ptr! series/tail) - (as byte-ptr! series) - size? series-buffer!)
			print [
				" - " series
				": size = "	series/size
				", offset pos = " head ", tail pos = " tail
				"    "
			]
			if series/flags and flag-ins-head <> 0 [print "H"]
			if series/flags and flag-ins-tail <> 0 [print "T"]
			print lf
			count: count + 1

			series: as series-buffer! (as byte-ptr! series) + series/size + size? series-buffer!
			series >= frame/heap
		]
		assert series = frame/heap
	]

	;-------------------------------------------
	;-- Displays total frames count
	;-------------------------------------------
	print-frames-count: func [count [integer!] /local s][
		s: either count > 1 ["s^/"][newline]
		print ["^/    " count " frame" s lf]
	]

	;-------------------------------------------
	;-- Dump memory statistics on screen
	;-------------------------------------------
	memory-stats: func [
		verbose [integer!]						;-- stat verbosity level (1, 2 or 3)
		/local count n-frame s-frame b-frame free-nodes base
	][
		assert all [1 <= verbose verbose <= 3]

		print [lf "====== Red Memory Stats ======" lf]

	;-- Node frames stats --
		count: 0
		n-frame: memory/n-head

		print [lf "-- Node frames --" lf]
		while [n-frame <> null][
			if verbose >= 2 [
				print ["#" count + 1 ": "]
				free-nodes: (as-integer (n-frame/top - n-frame/bottom) + 1) / 4
				frame-stats
					free-nodes
					n-frame/nodes - free-nodes
					n-frame/nodes
			]
			count: count + 1
			n-frame: n-frame/next
		]
		print-frames-count count

	;-- Series frames stats --
		count: 0
		s-frame: memory/s-head

		print ["-- Series frames --" lf]
		while [s-frame <> null][
			if verbose >= 2 [
				print ["#" count + 1 ": "]
				base: (as byte-ptr! s-frame) + size? series-frame!
				frame-stats
					as-integer s-frame/tail - as byte-ptr! s-frame/heap
					as-integer (as byte-ptr! s-frame/heap) - base
					as-integer s-frame/tail - base
				if verbose >= 3 [
					list-series-buffers s-frame
				]
			]
			count: count + 1
			s-frame: s-frame/next
		]
		print-frames-count count

	;-- Big frames stats --
		count: 0
		b-frame: memory/b-head

		print ["-- Big frames --" lf]
		while [b-frame <> null][
			if verbose >= 2 [
				print ["#" count + 1 ": "]
				prin-int b-frame/size
			]
			count: count + 1
			b-frame: b-frame/next
		]
		print-frames-count count

		print [
			"Total memory used: " memory/total " bytes" lf
			"==============================" lf
		]
	]

	;-------------------------------------------
	;-- Dump memory layout of a given series frame
	;-------------------------------------------
	dump-series-frame: func [
		frame	[series-frame!]
		/local series alt? size block
	][
		series: as series-buffer! (as byte-ptr! frame) + size? series-frame!

		print [lf "=== Series layout for frame: <" frame "h>" lf]

		alt?: no
		until [
			block: either zero? (series/flags and series-in-use) [
				"."
			][
				alt?: not alt?
				either alt? ["x"]["o"]
			]

			size: series/size / 16
			until [
				print block
				size: size - 1
				zero? size
			]

			series: as series-buffer! (as byte-ptr! series) + series/size + size? series-buffer!
			series >= frame/heap
		]
		assert series = frame/heap
		print lf
	]

]


FIX: cleaned up test "nested ifs inside a function with many return points"

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

~~~start-file~~~ "conditional"

  --test-- "nested ifs inside a function with many return points"
    ;; a bug was fixed that caused this code to raise a segmentation error
    ;; the test waa passing until the lines marked ;###### were added
    scan-utf-8: func [
      str [c-string!]
      return: [integer!]
      /local
        i [integer!]
    ][
      i: 1
      until [
        if str/1 > #"^(7F)" [
          if #"^(C0)" = str/1 [return i]
          if #"^(C1)" = str/1 [return i]
          if #"^(F4)" < str/1 [return i]
          if str/1 < #"^(E0)" [
             if str/2 < #"^(80)" [return i]
             if str/2 > #"^(BF)" [return i]
             if str/3 <> null-char [
               i: i + 1
               str: str + 1
             ]
          ]
        ]
        i: i + 1
        str: str + 1
        str/1 = null-char
      ]
      0
    ]
  --assert 0 = scan-utf-8 "a"
  --assert 0 = scan-utf-8 "a very straightforward string"

  --test-- "simple if"
    i: 0
    if true [i: 1]
  --assert i = 1

  --test-- "nested if"
    i: 0
    if true [
      if true [
        i: 1
      ]
    ]
  --assert i = 1

  --test-- "double nested if"
    i: 0
    if true [
      if true [
        if true [
          i: 1
        ]
      ]
    ]
  --assert i = 1

  --test-- "triple nested if"
    i: 0
    if true [
      if true [
        if true [
          if true [
            i: 1
          ]
        ]
      ]
    ]
  --assert i = 1

  --test-- "byte nested if"
    ct-byte: #"^(C0)"
    i: 0
    if #"^(7F)" < ct-byte [
      if ct-byte < #"^(FE)" [
        if #"^(A5)" < ct-byte [
          if ct-byte = #"^(C0)" [
            i: 1
          ]
        ]
      ]
    ]
  --assert i = 1

  --test-- "byte nested if inside function"
    ct-byte-nested: func [
      b [byte!]
      return: [integer!]
    ][
      if b > #"^(7F)" [
        if #"^(C0)" = b [return 1]
        if #"^(C1)" = b [return 2]
        if #"^(F4)" < b [return 3]
        if b < #"^(E0)" [
          if b < #"^(D0)" [return 4]
          if b > #"^(CF)" [return 5]
        ]
      ]
      0
    ]
  --assert 0 = ct-byte-nested #"^(00)"
  --assert 1 = ct-byte-nested #"^(C0)"
  --assert 2 = ct-byte-nested #"^(C1)"
  --assert 3 = ct-byte-nested #"^(F9)"
  --assert 4 = ct-byte-nested #"^(C5)"
  --assert 5 = ct-byte-nested #"^(D1)"

~~~end-file~~~

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

~~~start-file~~~ "conditional"

  --test-- "nested ifs inside a function with many return points"
    ;; a bug was fixed that caused this code to raise a segmentation error
    ;; the test waa passing until the lines marked ;###### were added
    scan-utf-8: func [
      str [c-string!]
      return: [integer!]
      /local
        i [integer!]
    ][
      i: 1
      until [
        if str/1 > #"^(7F)" [
          print "here"                      ;; remove this line when test passes
          if #"^(C0)" = str/1 [return i]
          if #"^(C1)" = str/1 [return i]
          if #"^(F4)" < str/1 [return i]
          if str/1 < #"^(E0)" [
             if str/2 < #"^(80)" [return i]
             if str/2 > #"^(BF)" [return i]      ;######
             if str/3 <> null-char [             ;######
               i: i + 1                          ;######
               str: str + 1                      ;######
             ]                                   ;######
          ]
        ]
        i: i + 1
        str: str + 1
        str/1 = null-char
      ]
      0
    ]
  --assert 0 = scan-utf-8 "a"
  --assert 0 = scan-utf-8 "a very straightforward string"

  --test-- "simple if"
    i: 0
    if true [i: 1]
  --assert i = 1

  --test-- "nested if"
    i: 0
    if true [
      if true [
        i: 1
      ]
    ]
  --assert i = 1

  --test-- "double nested if"
    i: 0
    if true [
      if true [
        if true [
          i: 1
        ]
      ]
    ]
  --assert i = 1

  --test-- "triple nested if"
    i: 0
    if true [
      if true [
        if true [
          if true [
            i: 1
          ]
        ]
      ]
    ]
  --assert i = 1

  --test-- "byte nested if"
    ct-byte: #"^(C0)"
    i: 0
    if #"^(7F)" < ct-byte [
      if ct-byte < #"^(FE)" [
        if #"^(A5)" < ct-byte [
          if ct-byte = #"^(C0)" [
            i: 1
          ]
        ]
      ]
    ]
  --assert i = 1

  --test-- "byte nested if inside function"
    ct-byte-nested: func [
      b [byte!]
      return: [integer!]
    ][
      if b > #"^(7F)" [
        if #"^(C0)" = b [return 1]
        if #"^(C1)" = b [return 2]
        if #"^(F4)" < b [return 3]
        if b < #"^(E0)" [
          if b < #"^(D0)" [return 4]
          if b > #"^(CF)" [return 5]
        ]
      ]
      0
    ]
  --assert 0 = ct-byte-nested #"^(00)"
  --assert 1 = ct-byte-nested #"^(C0)"
  --assert 2 = ct-byte-nested #"^(C1)"
  --assert 3 = ct-byte-nested #"^(F9)"
  --assert 4 = ct-byte-nested #"^(C5)"
  --assert 5 = ct-byte-nested #"^(D1)"

~~~end-file~~~