'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 print "..."; : 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."