REBOL [
	Title:  "Rebcode Check" 
	Author: "Carl" 
	Needs:  [core 2.7.0]
	Type:   'test
	Purpose: {Basic opcode tests.}
]

; Very simple (too simple) opcode verification test.

;probe system/internal/rebcodes for list of opcodes

bar: "-------------------------------"
print "Testing..."

time: func [b /local start] [
	start: now/precise
	do b
	print ["Time:" difference now/precise start]
]

blk: [1 2 3]

img: make image! [2x2]
img/1: 255.0.0.0
img/2: 0.255.0.0
img/3: 0.0.255.0
img/4: 0.0.0.255

adds: rebcode [a b] [
	add.i a b
	return a
]

rc: rebcode ["Test Code" /local i d f r s count] [

	; Checks all opcodes (other than ones that would exit the function)

	repeat count 100'000 [

;		?? count

		set test "basic control flow"

		set i 1
		eq.i i 1
		braf fail
		brat continue
		print "Should not print!"
		label continue

		set test "integer math"

		add.i i 1
		eq.i i 2
		braf fail

		mul.i i 10
		eq.i i 20
		braf fail

		div.i i 2
		eq.i i 10
		braf fail

		rem.i i 3
		eq.i i 1
		braf fail

		set i 10
		neg.i i
		eq.i i -10
		braf fail

		set test "integer compare"

		abs.i i	; i: 10
		eq.i i 10
		braf fail

		min.i i 100
		eq.i i 10
		braf fail

		max.i i 100 ; i: 100
		eq.i i 100
		braf fail

		neq.i i 101
		braf fail

		gt.i i 10
		braf fail

		gteq.i i 10
		braf fail

		gteq.i i 10
		braf fail

		glt.i i 99 101
		braf fail

		glte.i i 100 101
		braf fail

		set test "decimal math"

		set d 1.0
		add.d d 1.0
		eq.d d 2.0
		braf fail

		sub.d d 1.0
		eq.d d 1.0
		braf fail

		mul.d d 10.0
		eq.d d 10.0
		braf fail

		div.d d 10.0
		eq.d d 1.0
		braf fail

		set.d d 1.0
		neg.d d
		eq.d d -1.0
		braf fail

		abs.d d
		eq.d d 1.0
		braf fail

		min.d d 0.5
		eq.d d 0.5
		braf fail

		max.d d 10.0
		eq.d d 10.0
		braf fail

		set test "decimal comparison"

		set.d d 10.0
		neq.d d 10.0
		brat fail

		gt.d d 1.0
		braf fail

		lt.d d 100.0
		braf fail

		gteq.d d 1.0
		braf fail

		lteq.d d 100.0
		braf fail

		glt.d d 9.9999 10.0001
		braf fail

		glt.d d 9.9999 10.0
		brat fail

		glte.d d 9.9999 10.0
		braf fail

		set test "bitwise ops"

		set.i i 9
		and i 1
		eq.i i 1
		braf fail

		or i 8
		eq.i i 9
		braf fail

		xor i 6
		eq.i i 15
		braf fail

		set.i i 1
		lsl i 2
		eq.i i 4
		braf fail

		lsr i 2
		eq.i i 1
		braf fail

		set.i i 65536
		rotl i 16
		eq.i i 1
		braf fail

		rotr i 16
		eq.i i 65536
		braf fail

		set i -1
		cmpl i
		eq.i i 0
		braf fail

		set test "instrinsic functions"

		set i 10.0
		to-int i
		eq.i i 10
		braf fail

		set d 10
		to-int d
		eq.i i 10
		braf fail

		set d 5
		to-dec d
		eq.d d 5.0
		braf fail

		set d 5.0
		to-dec d
		eq.d d 5.0
		braf fail

		;-- NOT logic opcode
		set i 0
		eq.i i 1
		gett f
		eq.i f false
		braf fail
		not f
		eq.i f true
		braf fail

		set.i i 10
		randz i
		lt.i i 10
		braf fail

		set.d d 100.0
		sqrt d
		eq.d d 10.0
		braf fail

		set d 1.0
		exp d
		log-e d
		eq.d d 1.0
		braf fail

		set d 10.0
		log-10 d
		eq.d d 1.0
		braf fail

		set d 1.0
		cos d
		acos d
		eq.d d 1.0
		braf fail

		sin d
		asin d
		eq.d d 1.0
		braf fail

		tan d
		atan d
		eq.d d 1.0
		braf fail

		set test "series"

		do s [copy "abcde"]
		length? i s
		eq.i i 5
		braf fail

		next s ; test length with offset
		length? i s
		eq.i i 4
		braf fail
		head s

		index? i s
		eq.i i 1
		braf fail

		next s ; test pick with offset
		pick i s 2
		eq.i i 99
		braf fail
		head s

		poke s 3 100
		pick i s 3
		eq.i i 100
		braf fail

		change s 100 1
		pick i s 1
		eq.i i 100
		braf fail

		set test "series traverse"

		skip s 2
		index? i s
		eq.i i 3
		braf fail

		next s
		index? i s
		eq.i i 4
		braf fail

		back s
		index? i s
		eq.i i 3
		braf fail

		head s
		index? i s
		eq.i i 1
		braf fail

		tail s
		index? i s
		eq.i i 6
		braf fail

		tail? s
		braf fail

		head? s
		brat fail

		past? s
		brat fail

		value? s
		braf fail

		set test "Control and related functions"

		do r [1 + 2]
		eq.i r 3
		braf fail

		set r true
		set.i i 0
;		ift [eq i i breakt seti i 1] ; test break
		eq.i i 0
		braf fail

		set.i i 1
		eq.i i 1
		ift [set.i i 0]
		eq.i i 0
		braf fail

		set.i i 1
		eq.i i 1
		iff [set.i i 0]
		eq.i i 1
		braf fail

		set.i i 1
		eq.i i 1
		either [set.i i 0][set.i i -1]
		eq.i i 0
		braf fail

		set.i i 1
		loop 5 [add.i i 1]
		eq.i i 6
		braf fail

		set.i i 0
		repeat n 5 [add.i i n]
		eq.i i 15
		braf fail

		set.i i 0
		repeatz n 5 [add.i i n]
		eq.i i 10
		braf fail

		set.i i 5
		until [

			sub.i i 1
			lteq.i i 0
		]
		eq.i i 0
		braf fail

		set.i i 5
		while [gt.i i 0] [sub.i i 1]
		eq.i i 0
		braf fail

		set test "tuple access"

		set t 10.20.30.40
		pick i t 3
		eq.i i 30
		braf fail
		poke t 2 200
		pick i t 2
		eq.i i 200
		braf fail

		set test "pair access"
		set t 10x20
		pick i t 2
		eq.i i 20
		braf fail
		poke t 1 200
		pick i t 1
		eq.i i 200
		braf fail

		set test "bswap"
		set i 65536
		bswap i
		eq.i i 256
		braf fail

		set.i i -2071756159
		bswap i
		eq.i i -2122153084
		braf fail

		set test "sign extend"
		set i 200
		ext8 i
		eq.i i -56
		braf fail
		set i 65500
		ext16 i
		eq.i i -36
		braf fail

		set test "Other"
		;-- Check EQ flag functions
		set i 0
		eq.i i 0
		gett f   ; save eq flag in f
		eq.i f true
		braf fail
		sett f   ; restore eq flag from f
		braf fail

		;-- Getting indirect word:
		do r [a: 10 b: 'a]
		getw i a
		eq.i i 10
		getw i b
		eq.i i 10
		braf fail

		setw b 20
		getw i a
		eq.i i 20
		getw i b
		eq.i i 20
		braf fail

		;-- Pick and poke on images:
		pick i img 3
		eq.i i 255
		braf fail

		poke img 2 12345678
		pick i img 2
		eq.i i 12345678
		braf fail

		;-- Pick and poke on blocks:
		pick i blk 2
		eq.i i 2
		braf fail

		poke blk 3 4
		pick i blk 3
		eq.i i 4
		braf fail

		;-- Change on block:
		head blk
		next blk
		next blk
		change blk 10 1
		head blk
		pick i blk 3
		eq.i i 10
		braf fail

		;-- copy:
		set ss "str"
		next ss
		copy s ss -1
		length? i s
		eq.i i 2
		braf fail

		;-- Remove and clear:
		copy s "string" -1
		skip s 2
		remove s 2
		head s
		length? i s
		eq.i i 4
		braf fail

		skip s 2
		clear s
		head s
		length? i s
		eq.i i 2
		braf fail

		skip s 2
		insert s "abc" -1
		head s
		length? i s
		eq.i i 5
		braf fail

		insert s 50 1
		length? i s
		eq.i i 6
		braf fail
		pick i s 1
		eq.i i 50
		braf fail

		copy b [1 2] -1
		insert b [3 4] -1
		pick i b 2
		eq.i i 4
		braf fail
		length? i b
		eq.i i 4
		braf fail

		insert b 123 1
		pick i b 1
		eq.i i 123
		length? i b
		eq.i i 5
		braf fail

		;-- Test apply
		apply r adds [1 2]
		eq.i r 3
		braf fail

		apply r length? ["ab"]
		eq.i r 2
		braf fail

		comment "test comment"
		comment [test comment]

		bra here

		label fail
		print ["Error:" test]
		do r [halt]

		label here
	]
	print "tests passed"
	set s "done"
	return s
]

if any [
	not rebcode? :rc
	not any-function? :rc
	not block? first :rc
	not block? second :rc
	not block? third :rc
][
	print "Invalid REBCODE interface."
	halt
]

time [print rc]
halt