'OHRRPGCE - RELOADbasic testcases
'(C) Copyright 1997-2020 James Paige, Ralph Versteegen, and the OHRRPGCE Developers
'Dual licensed under the GNU GPL v2+ and MIT Licenses. Read LICENSE.txt for terms and disclaimer of liability.

#include "testing.bi"
#include "common_base.bi"

declare function otherFileTests(byval node as nodeptr) as integer
declare function testAddingNodeNames1() as integer

dim shared doc as DocPtr, doc2 as DocPtr

sub sink(i as integer)
end sub

'Dump a RELOAD doc, for debugging
sub printTree(byval doc as DocPtr)
	dim fh as integer = freefile
	open cons for output as fh
	serializeXML(doc, fh)
	close fh
end sub



startTest(createDocument)
	doc = CreateDocument()
	if doc = null then fail

	dim nod as NodePtr = CreateNode(doc, "root")
	
	if nod = 0 then fail
	
	SetRootNode(doc, nod)
	
	if DocumentRoot(doc) <> nod then fail
endTest

startTest(testBasicReading)
	dim nod as nodeptr = SetChildNode(DocumentRoot(doc), "helper")
	SetContent(nod, 100)

	AppendChildNode(nod, "@attr1", "fish")
	SetChildNode(nod, "int", 12345)
	SetChildNode(nod, "int_like", "54321")
	SetChildNode(nod, "float", 1234.5678)
	SetChildNode(nod, "string", "1 2 3 4 5 6 7 8 9 0")
	SetChildNode(nod, "null")
	
	if nod."int" <> 12345 then fail
	if nod."int".integer <> 12345 then fail
	if nod."int".int <> 12345 then fail
	if nod."int_like" <> 54321 then fail
	if nod."float".float <> 1234.5678 then fail
	if nod."string".string <> "1 2 3 4 5 6 7 8 9 0" then fail
	if nod."string".str <> "1 2 3 4 5 6 7 8 9 0" then fail
	if not nod."null".exists then fail
	if not nod."int".bool then fail
endTest

startTest(testDimParsing)
	dim var1 as integer, var2 as integer ptr vector
	'FIXME: this line compiles only with --careful
	'dim as nodeptr root = DocumentRoot(doc), helper = root."helper".ptr
	dim as nodeptr root = DocumentRoot(doc)
	dim as nodeptr helper = root."helper".ptr
	dim byref helper_alias as nodeptr = helper
	dim byref as nodeptr helper_alias2 = helper, root_alias = root

	if root <> root_alias then fail
	if helper <> helper_alias then fail
	if root_alias."helper" <> 100 then fail
	if helper_alias."int" <> 12345 then fail
	if helper_alias2."int" <> 12345 then fail

	dim nod as reload.NodePtr = root   'Test reload namespace handled OK
	if nod."helper" <> 100 then fail
endTest

startTest(testNestedNodes)
	dim nod1 as NodePtr
	dim nod2 as NodePtr
	nod1 = SetChildNode(DocumentRoot(doc), "party")
	AppendChildNode(nod1, "foo", 0)
	AppendChildNode(nod1, "bar", 0)
	AppendChildNode(nod1, "baz", 0)
	nod1 = AppendChildNode(nod1, "slot", 3)
	nod1 = SetChildNode(nod1, "stats")
	nod2 = AppendChildNode(nod1, "stat", 0)
	AppendChildNode(nod1, "stat", 1)
	SetChildNode(nod2, "max", 100)
	SetChildNode(nod2, "cur", 95)
	
	dim root as Node ptr = DocumentRoot(doc)
	nod1 = root."party"."slot"."stats"."stat"."max".ptr
	if NodeName(nod1) <> "max" then fail
	if nod1..name <> "max" then fail
	if nod1..int <> 100 then fail
	withnode root."party"."slot"."stats"."stat" as stat
		if stat."max".name <> "max" then fail
		if stat."max" <> 100 then fail
		if stat."max".integer <> 100 then fail
	end withnode

	withnode root."party" as party
		withnode party."slot" as slot
			withnode slot."stats" as stats
				withnode stats."stat" as stat
					if stat."max".name <> "max" then fail
					if stat."max" <> 100 then fail
					if stat."max".integer <> 100 then fail
				end withnode
			end withnode
		end withnode
	end withnode
endTest

startTest(testMissingNodes)
	dim root as Node ptr = DocumentRoot(doc)
	
	if root."!@#".exists then fail
	if root."!@#".bool then fail
	if root."party"."   ".exists then fail
	if root."party"."   ".ptr <> NULL then fail

	'check default defaults
	if root."not here".integer <> 0 then fail
	if root."not here".string <> "" then fail
	if root."not here".float <> 0.0 then fail
	if root."not here"."foo".ptr <> NULL then fail
	if root."not here"."foo".exists <> 0 then fail
	if root."not here".bool <> 0 then fail
	if root."not here".zstring <> NULL then fail
	if root."not here".zstringsize <> 0 then fail
	if root."not here".name <> "" then fail

	'check defaults
	if root."not here".default(-1).integer <> -1 then fail
	if root."not here".default("dd").string <> "dd" then fail
	if root."not here".default(3.141).float <> 3.141 then fail
	if root."not here"."foo".default(root).ptr <> root then fail
	if root."not here".default(2).bool <> 2 then fail
	if root."not here".default(@"blarg").zstring <> @"blarg" then fail
	if root."not here".default(3).zstringsize <> 3 then fail
	if root."not here".default("n").name <> "n" then fail
endTest

startTest(testNodeZeroSpec)
	dim root as Node ptr = DocumentRoot(doc)
	dim partyslot as Node ptr = root."party"."slot".ptr
	dim nullnode as Node ptr = root."not here".ptr

	if partyslot..integer <> 3 then fail
	if partyslot..name <> "slot" then fail

	'check default defaults
	if nullnode..integer <> 0 then fail
	if nullnode..string <> "" then fail
	if nullnode..float <> 0.0 then fail
	if nullnode..bool <> 0 then fail
	if nullnode..zstring <> NULL then fail
	if nullnode..zstringsize <> 0 then fail
	if nullnode..name <> "" then fail

	'check defaults
	if nullnode..default(-1) <> -1 then fail
	if nullnode..default("dd").string <> "dd" then fail
	if nullnode..default(3.141).float <> 3.141 then fail
	if nullnode..default(2).bool <> 2 then fail
	if nullnode..default(@"blarg").zstring <> @"blarg" then fail
	if nullnode..default(3).zstringsize <> 3 then fail
	if nullnode..default("n").name <> "n" then fail
endTest

extern unexpected_warns as integer
dim unexpected_warns as integer
dim shared bad_warning as integer

sub count_unexpected_warnings (msg as string)
	if instr(lcase(msg), "unexpected") then
		unexpected_warns += 1
	else
		debug msg
		bad_warning += 1
	end if
end sub

startTest(testReadNode)
	# warn_func = count_unexpected_warnings
	dim root as Node ptr = DocumentRoot(doc)
	dim nod1 as Node ptr = AppendChildNode(root, "readnode")
	for i as integer = 0 to 9
		if i mod 3 = 0 then
			AppendChildNode(nod1, "four of these", i)
		else
			AppendChildNode(nod1, "six of those", i)
		end if
		if i = 6 then
			DIM nod2 as Node ptr = AppendChildNode(nod1, "something else", 12.3)
			AppendChildNode(nod2, "A", 1)
			AppendChildNode(nod2, "a", 100.4)
			AppendChildNode(nod2, "A", 2)
			DIM nod3 as Node ptr = AppendChildNode(nod2, "c", "C")
			AppendChildNode(nod3, "child1", 1234)
			AppendChildNode(nod3, "child2", 4321)
		end if
	next
	
	dim as integer sum1, sum2, sum3, Asum, should_happen
	readnode nod1
		sum1 += nod1."four of these".default(-100)
		sum2 += nod1."six of those".default(-100)
		readnode nod1."something else" as something
			withnode something."c".required as foo
				should_happen = YES
				if NodeName(something) <> "something else" then fail
			end withnode
			Asum += something."A"
			Asum += something."a"
		end readnode
		sum3 += nod1."none of that"
	end readnode
	if sum1 <> 18 then fail
	if sum2 <> 27 then fail
	if sum3 <> 0 then fail
	if Asum <> 103 then fail
	if should_happen = NO then fail
	if bad_warning then fail
	if unexpected_warns <> 0 then fail

	sum1 = 0
	sum2 = 0
	Asum = 0

	' Test continue readnode, exit readnode
	readnode nod1
		sum1 += nod1."four of these"
		sum2 += nod1."six of those" : if sum2 > 12 then exit readnode
		withnode nod1."something else" as something
			Asum += something."A"
			if something."a" then continue readnode
			Asum += 100
			fail
		end withnode
	end readnode
	if sum1 <> 9 then fail
	if sum2 <> 19 then fail
	if Asum <> 1 then fail

	sum1 = 0
	sum2 = 0
	Asum = 0

	readnode root."readnode" as parent
		sum1 += parent."four of these"
		sum2 += parent."six of those"
	end readnode
	if sum1 <> 18 then fail
	if sum2 <> 27 then fail
	if bad_warning then fail
	if unexpected_warns <> 1 then fail
	unexpected_warns = 0

	sum1 = 0

	readnode root."readnode"."something else"."c" as c
		sum1 += c."child1"
		sum1 += c."child2"
	end readnode
	if sum1 <> 5555 then fail
	if bad_warning then fail
	if unexpected_warns <> 0 then fail
endTest

startTest(testIgnore)
	# warn_func = count_unexpected_warnings
	dim root as Node ptr = DocumentRoot(doc)

	readnode root
	end readnode
	if bad_warning then fail
	if unexpected_warns <> 3 then fail
	unexpected_warns = 0

	readnode root
		root."party".ignore
	end readnode
	if bad_warning then fail
	if unexpected_warns <> 2 then fail
	unexpected_warns = 0

	readnode root, ignoreall
		sink root."party".exists
	end readnode
	if bad_warning then fail
	if unexpected_warns <> 0 then fail
endTest

dim shared as integer set_warn, set_error

sub warning(foo as string)
	set_warn = YES
end sub

sub throwerror(foo as string)
	set_error = YES
end sub

function error_out(byval root as NodePtr) as integer
	# error_func = throwerror
	print root."party"."slot"."not here".required.string
	return 1  'OK
end function

startTest(testWarnRequire)
	#warn_func = warning
	# error_func = throwerror

	dim root as Node ptr = DocumentRoot(doc)
	sink root."blarg"
	if set_warn then fail
	sink root."blarg".warn
	if set_warn = NO then fail
	set_warn = NO

	dim madeit as integer
	withnode root."not 'ere".warn as dummy
		if dummy <> NULL then fail
		madeit = YES
	end withnode
	if madeit = NO then fail
	if set_warn = NO then fail
	set_warn = NO

	'dim shouldnt_happen as integer
	dim should_happen as integer
	readnode root
		sink root."not a node" : fail
		sink root."also not".default(0) : should_happen = YES
	end readnode
	if set_warn = NO then fail
	set_warn = NO
	if should_happen = NO then fail
	should_happen = NO

	readnode root, default
		sink root."not a node" : should_happen = YES
	end readnode
	if set_warn = NO then fail
	set_warn = NO
	if should_happen = NO then fail
	should_happen = NO

	readnode root, default
		if root."neither.".string.default("4.5") <> "4.5" then fail : end if : should_happen = YES
	end readnode
	if set_warn = NO then fail
	set_warn = NO
	if should_happen = NO then fail
	should_happen = NO

	readnode root, ignoreall
		sink root."not a node" : fail
	end readnode
	if set_warn then fail

	if error_out(root) <> 0 then fail
	if set_error = NO then fail
endTest

type UDT
	dummy as integer
	declare function a_method cdecl (nod as NodePtr) as integer
end type

function UDT.a_method cdecl (nod as NodePtr) as integer
	if nod."helper" <> 100 then return 0
	return 1
end function

startTest(testMethodsAndArguments)
	dim obj as UDT
	if obj.a_method(DocumentRoot(doc)) <> 1 then fail
endTest

startTest(testMoreReadNodeDefaulting)
	dim root as Node ptr = DocumentRoot(doc)
	root = AppendChildNode(root, "more defaulting")
	#warn_func = warning
	set_warn = NO

	for i as integer = 0 to 1
		if i = 1 then root = NULL

		dim as integer should_be_zero = -1
		readnode root
			sink root."not a node" : fail
			sink cint(root."not a node2".ptr) : fail
			sink root."not a node3".bool : fail
			should_be_zero = root."not a node4".exists   'exists is special
		end readnode
		if set_warn then fail
		if should_be_zero <> 0 then fail
	next
endtest

startTest(testNestedDefaulting)
	dim as integer sum1, sum2
	dim root as node ptr = DocumentRoot(doc)
	
	readnode root, ignoreall
		readnode root."readnode" as rnode
			rnode."four of these".ignore
			rnode."six of those".ignore
			readnode rnode."something else"."c" as c, default
				withnode c."not here" as dummy
					sum2 += 1  'should happen
				end withnode
				readnode c."not present" as notp
					sum2 += notp."foo".default(100)
					withnode notp."bar" as dummy
						sum2 -= -100000  'shouldn't happen
					end withnode
				end readnode
				sum1 += c."child1"
				c."child2".ignore
			end readnode
			readnode rnode."not here" as dummy, default
				sum2 += dummy."foo".default(-1000)  'shouldn't happen
			end readnode
			readnode rnode."also not here" as dummy
				sum2 += dummy."foo".default(-10000)  'shouldn't happen
			end readnode
		end readnode
	end readnode
	if sum1 <> 1234 then fail
	if sum2 <> 101 then fail
endTest

dim shared num_warnings as integer = 0

sub count_warnings(msg as string)
	num_warnings += 1
end sub

startTest(testLoadArray1)
	'printTree(doc)

	dim as NodePtr root = DocumentRoot(doc), nod1, nod2
	nod1 = AppendChildNode(root, "loadarray_test")
	for i as integer = -2 to 6 step 2
		SetKeyValueNode(nod1, "key", i, i * i)
	next
	AppendChildNode(nod1, "dummy", 42)
	SetKeyValueNode(nod1, "key", 20, 400)

	'# warn_func = debug
	# warn_func = count_warnings
	num_warnings = 0

	dim buf(-2 to 6) as integer, i as integer
	readnode nod1
		nod1."dummy".ignore
		loadarray buf($i) = 1+nod1."key"[$i]."int".default(-44)+1
	end readnode

	if num_warnings <> 1 then fail
	num_warnings = 0

	for i as integer = lbound(buf) to ubound(buf)
		if i mod 2 = 0 then
			if buf(i) <> i * i + 2 then fail
		else
			if buf(i) <> -44 + 2 then fail
		end if
	next

	'Test nonexistent children default correctly
	'(Note: there's no way to tell between the "dummy"[$i] not existing, and the "doesn't exist" being missing)

	readnode nod1, ignoreall
		loadarray buf($i) = nod1."dummy"[$i]."doesn't exist"
	end readnode

	if num_warnings <> 1 then fail
	num_warnings = 0

	for i as integer = lbound(buf) to ubound(buf)
		if buf(i) <> 0 then fail
	next

	readnode nod1, ignoreall
		loadarray buf($i) = nod1."key"[$i].exists
	end readnode

	for i as integer = lbound(buf) to ubound(buf)
		if i mod 2 = 0 then
			if buf(i) <> YES then fail
		else
			if buf(i) <> NO then fail
		end if
	next

	'This is somewhat useless, but is meant to work
	readnode nod1, ignoreall
		loadarray buf($i) = nod1."key"[$i].default(-4444)
	end readnode

	for i as integer = lbound(buf) to ubound(buf)
		if i mod 2 = 0 then
			if buf(i) <> i then fail
		else
			if buf(i) <> -4444 then fail
		end if
	next

endTest

type NodeHolder
	root as Node ptr
	root2 as NodePtr
	child as Node ptr
end type

startTest(testDeclareNodeptr)
	dim hold as NodeHolder
	declare as nodeptr hold.root, hold.child
	hold.root = DocumentRoot(doc)

	AppendChildNode(hold.root, "child", 300)
	if hold.root."child" <> 300 then fail
	dim sum as integer = 0
	readnode hold.root, ignoreall
		sum += hold.root."child"
	end readnode

	with hold
		declare as node ptr .root
		if .root."child" <> 300 then fail
	end with

	AppendChildNode(hold.root."child".ptr, "x", 10)
	readnode hold.root."child" as c
		sum += c."x"
	end readnode
	if sum <> 310 then fail

	hold.child = hold.root."child".ptr
	if hold.child..integer <> 300 then fail
endTest

startTest(testMixedDocuments)
	# warn_func = count_unexpected_warnings
	doc2 = CreateDocument()
	if doc2 = null then fail

	dim hold as NodeHolder
	declare as nodeptr hold.root, hold.root2

	hold.root = DocumentRoot(doc)

	hold.root2 = CreateNode(doc2, "foo")
	if hold.root2 = 0 then fail
	SetRootNode(doc2, hold.root2)

	AppendChildNode(hold.root2, "child2", 3001)
	AppendChildNode(hold.root2, "child1", 3002)
	dim as node ptr n = FirstChild(hold.root2), n2
	AppendChildNode(n, "party", 4001)
	AppendChildNode(n, "", 4002)

	if hold.root."helper" <> 100 then fail
	if hold.root2."child1" <> 3002 then fail

	withnode hold.root2."child2" as ch
		if ch."party" <> 4001 then fail
		n2 = ch
	end withnode
	if n2."party" <> 4001 then fail

	readnode hold.root2
		hold.root2."helper".ignore
	end readnode
	if unexpected_warns <> 2 then fail
	unexpected_warns = 0
	if bad_warning then fail

	dim sum as integer
	readnode hold.root2."child2" as dummy
		sum += dummy.""
	end readnode
	if sum <> 4002 then fail
	if unexpected_warns <> 1 then fail
	unexpected_warns = 0
	if bad_warning then fail

	sum = 0
	readnode hold.root."helper" as dummy
		sum += dummy."int"
	end readnode
	if sum <> 12345 then fail
	if unexpected_warns <> 5 then fail
	unexpected_warns = 0
	if bad_warning then fail
endTest

function splitContext(byval nod as NodePtr) as integer
	# warn_func = count_unexpected_warnings
	unexpected_warns = 0

	if nod."sharedname" <> 10001 then fail
	readnode nod, default
		nod."sharedname".ignore
		nod."_nested".ignore
		' don't mention uniquename
		if nod."foo".exists = NO then fail
		if nod."bar".exists then fail
	end readnode
	if unexpected_warns <> 1 then fail
end function

startTest(testMixedSourceFiles)
	dim root as NodePtr = DocumentRoot(doc)
	dim as NodePtr nod = AppendChildNode(root, "mixed files"), nod2

	AppendChildNode(nod, "foo", "fg")
	AppendChildNode(AppendChildNode(nod, "_nested", 1002), "_nested2", 1001)

	if otherFileTests(root) then return 1  'fail

	if splitContext(nod) then return 1  'fail
endTest

'This tests an implementation detail of RB, checking (valgrind required) whether reads
'occur off the end of the document's nameIndexTable if additional names are added
'BuildNameIndexTable
startTest(testAddingNodeNames)
	'This test is in a different file because name indices are shared across all functions
	'in a file
	return testAddingNodeNames1()
endTest

startTest(cleanup)
	FreeDocument(doc)
	doc = 0
	FreeDocument(doc2)
	doc2 = 0
	passed
endTest

print "All passed."
