test.finw

(use* core)
(use* varvara)

(use std)
(use alloc)
(use vec)

// When calling a noreturn function, a raw jump should be used rather than
// a normal call (pushing onto the return stack)
(test lang_goto_for_noreturn_calls [
	.System/rst dei 2 /
	#noreturn (word _ (U8 -- ) [
		.System/rst dei 2 /
		swap - (should eq 0)
		halt
	])
	_
])

(test lang_continue_basic [
	10 (until [ 0= ]  [ 1- dup 2 mod 0= (when [ continue ]) dup print-dec ]) drop
	(should stdout-eq "97531")
	10 (while [ 0<> ] [ 1- dup 2 mod 0= (when [ continue ]) dup print-dec ]) drop
	(should stdout-eq "97531")
])

(test lang_break_basic [
	10 (until [ 0= ]  [ 1- dup 5 = (when [ break ]) dup print-dec ]) drop
	(should stdout-eq "9876")
	10 (while [ 0<> ] [ 1- dup 5 = (when [ break ]) dup print-dec ]) drop
	(should stdout-eq "9876")
])

(test lang_Omit [
	(struct Fo [foo U8] [bar U16] [baz [U8]])
	(sizeof (Omit Fo baz)) (should eq 3)
])

(test lang_array_sizeof [
	(sizeof @[@Opaque])  (should eq 2)
	(sizeof [@Opaque 1]) (should eq 2)
	(sizeof [@Opaque 2]) (should eq 4)
	(sizeof [U8 2])      (should eq 2)
	(sizeof @[U8 2])     (should eq 2)
	(sizeof [@U8 2])     (should eq 4)
	(sizeof [U8 100])    (should eq 100)
	(sizeof [@U8 100])   (should eq 200)

	(struct Fee [fi U8] [fo [U16 2]] [fum @[Char8]])
	(sizeof Fee)         (should eq 7)
])

(test lang_decl_scoping [
	(word foobar [ 1 ])
	(word baz [
		(word foobar [ 2 ])
		foobar
	])
	foobar (should eq 1)
	baz    (should eq 2)
])

(test lang_type_scoping [
	(struct A [foo U8])
	(word baz [
		(struct A [foo U16] [bar U16] [baz U8])
		(sizeof A)
	])
	(sizeof A)  (should eq 1)
	baz         (should eq 5)
])

(test lang_stack_structs [
	(struct A [ foo U8 ])
	(struct B [ foo U16 ])
	(struct C [ foo U8 ] [ bar U8 ])

	0x24 (make A) :foo (should eq 0x24)

	1 2 3 0x24s (make B) drop (should eq 3)
	drop drop

	1 2 3 4 (make C) drop (should eq 2) (should eq 1)
	3 4 (make C) :foo (should eq 4)
	3 4 (make C) :bar (should eq 3)

	1 2 (make C) 3 4 (make C) swap :foo (should eq 2)
	drop
])

(test lang_monomorphic_var_static_alloc [
	(word variable (Type -- @$0) [
		(let _S $0)
		@_S
	])
	
	(of variable U8)  (as @U16)
	(of variable U16) (should neq)

	(of variable @U8) (as @U16)
	(of variable U16) (should neq)

	8 (of variable U8) <-
	(of variable U8) -> (should eq 8)

])

(test lang_inline [
	#inline (word a ( -- U8 ) [ 1 ])
	a (should eq 1)

	//#inline (word b ( U16 -- U16 U16 ) [ 1s swap ])
	//2s b (should eq 2s) (should eq 1s)
	//(r [ 2s b ]) (asm "sr" .Op/Osth) (asm "sr" .Op/Osth)
		//(should eq 2s) (should eq 1s)
])

(test lang_inline_w_early_ret [
	#inline (word a ( -- ) [ return ])
	2 a 3 (should eq 3) (should eq 2)
	4 a 5 (should eq 5) (should eq 4)
])

(test lang_inline_w_inlined_labels [
	#inline (word b ( U8 -- U8 ) [ 1 = (when [9 return] [8 return]) ])
	#inline (word a ( U8 -- U8 ) [ 0 = (when [3 return] [1 b return]) ])

	0 a (should eq 3)
	1 a (should eq 9)
])

(test lang_r_blk [
	(word a (         -- U8 U8 U8           ) [ 1 2 3             ])
	(word b (U8 U8 U8 -- U8       |    -- U8) [ move + (r copy) * ])
	(word c (U8       -- U8       | U8 -- U8) [ (r copy) *        ])

	(r [a b c]) (should eq 3)
	(r move)    (should eq 27)
])

(test lang_enums [
	(enum Foo U8 a [b 99] c [d 88])
	.Foo/a .Foo/c (should neq)
	.Foo/b (as U8) (should eq 99)
	.Foo/d (as U8) (should eq 88)
])

(test lang_getindex [
	(let array [U8] "Day will come again!")

	@array    :0   -> (should eq 'D)
	0 @array  :    -> (should eq 'D)
	0s @array :    -> (should eq 'D)
	@array 0  :    -> (should eq 'D)
	@array 0s :    -> (should eq 'D)

	@array     :18 -> (should eq 'n)
	18 @array  :   -> (should eq 'n)
	18s @array :   -> (should eq 'n)
	@array 18  :   -> (should eq 'n)
	@array 18s :   -> (should eq 'n)
])

(test lang_cond_no_cond_arity [
	(word dostuff (U8 -- ) [
		(cond
			[ 0 = ] [ "0" print-string nl ]
			[ 1 = ] [ "1" print-string nl ]
			[ 2 = ] [ "2" print-string nl ]
			[ 3 = ] [ "3" print-string nl ]
			[ 4 = ] [ "4" print-string nl ]
			[ "???" print-string nl ]
		)
		drop
	])
	0 dostuff 1 dostuff 2 dostuff 3 dostuff 4 dostuff 5 dostuff
	(should stdout-eq "0\n1\n2\n3\n4\n???\n")
])

(test lang_proper_folding [
	#no-inline (word foo (-- U8) [ 1 ])
	#no-inline (word bar (-- U8) [ 2 ])
	[ (-- U8) foo ] do (should eq 1)
	[ (-- U8) bar ] do (should eq 2)
])