HLIB3 Tree Update

[Theo Gottwald]

In tests the HLIB3 - original Tree functions fail.

Because i use it, i have corrrected the WsLnTre.inc

Code Select Expand

#INCLUDE THIS ONCE
#INCLUDE ONCE "..\HLib3\HLib.inc"
#INCLUDE ONCE "..\HLib3\List\SsLst.inc"
#INCLUDE ONCE "..\HLib3\List\WsLst.inc"
#INCLUDE ONCE "..\HLib3\List\LnLst.inc"

'++
    '----------------------------------------------------------------------------------------
    ' Corrected and tested
    'WString/Long ~ Tree Container
    '   - also called: Tree/Map/Dictionary/Associative Array
    '   - AVL Self-Balanced Binary Tree
    '   - one-to-one relationship
    '   - Key/Value data structure
    '   - Values stored/retrieved/removed using unique lookup Key
    '   - Keys must be unique
    '   - no limit on Key length
    '   - use WsLnTreComparison() to change how Keys compared
    '   - Value replaced if Key exist unless DontReplace = True
    '   - Tree always stays in Key order
    '   - Tree may be traversed forward/backward in Key order
    '   - Tree is self-balanced to maintain shortest average path to each Key
    '
    '   - use MultiTree for one-to-many relationship
    '
    '   container accessed with handle
    '   handle protected by hash tag
    '   h = WsLnTreNew() 'get handle for new container
    '   h = WsLnTreFinal(h) 'free handle before it goes out of scope
    '----------------------------------------------------------------------------------------
'--


MACRO WsLnTreNodeTag = 1320870834
MACRO WsLnTreTag = -212996673
TYPE WsLnTreNode
    tag AS LONG
    P AS WsLnTreNode PTR
    L AS WsLnTreNode PTR
    R AS WsLnTreNode PTR
    HL AS WORD
    HR AS WORD
    K AS LONG
    V AS LONG
END TYPE
TYPE WsLnTre
    tag AS LONG
    count AS LONG
    root AS WsLnTreNode PTR
    compareCB AS LONG
    collation AS WsStr PTR
END TYPE

FUNCTION WsLnTreNew() AS LONG
    'allocate new container - return handle
    LOCAL p AS WsLnTre PTR
    ERR = 0
    p = MemAlloc(SIZEOF(@p))
    ExitF(p=0, LibErrM)
    @p.tag = WsLnTreTag
    @p.compareCB = CODEPTR(WsCompare)
    @p.collation = WsNew() : IF ERR THEN EXIT FUNCTION
    FUNCTION = p
END FUNCTION

FUNCTION WsLnTreFinal(BYVAL pTree AS WsLnTre PTR) AS LONG
    'free allocated container - return null
    IF pTree THEN
        ExitF(@pTree.tag<>WsLnTreTag, LibErrH)
        @pTree.collation = WsFinal(@pTree.collation)
        WsLnTreClear pTree
        MemFree(pTree)
    END IF
END FUNCTION

FUNCTION WsLnTreValidate(BYVAL pTree AS WsLnTre PTR) AS LONG
    'True/False if valid handle for this container
    IF pTree AND @pTree.tag = WsLnTreTag THEN FUNCTION = @pTree.tag
END FUNCTION

SUB WsLnTreComparison(BYVAL pTree AS WsLnTre PTR, BYVAL compareUCase AS LONG, BYVAL collationSequence AS WSTRING)
    'set how WStrings compared
    'default = case ignored
    'if collationSequence WString provided then
    '   WStrings are compared using the order of the collation sequence WString
    '   collation WString must be 65536 characters
    'else if compareUCase = True then
    '   WStrings compared UCase
    ExitS(pTree=0 OR @pTree.tag<>WsLnTreTag, LibErrH)
    @pTree.compareCB = CODEPTR(WsCompare)
    WsClear @pTree.collation
    IF LEN(collationSequence) THEN
        ExitS(LEN(collationSequence)<>65536, LibErrS)
        WsSet @pTree.collation, collationSequence : IF ERR THEN EXIT SUB
        @pTree.compareCB = CODEPTR(WsCompareCollate)
    ELSEIF compareUCase THEN
        @pTree.compareCB = CODEPTR(WsCompareUCase)
    END IF
END SUB

SUB WsLnTreClear(BYVAL pTree AS WsLnTre PTR)
    'delete all data
    LOCAL i AS LONG
    LOCAL pNode AS WsLnTreNode PTR
    LOCAL nodes() AS LONG
    ExitS(pTree=0 OR @pTree.tag<>WsLnTreTag, LibErrH)
    IF @pTree.count THEN
        REDIM nodes(1 TO @pTree.count)
        i = 0
        pNode = WsLnTreFirst(pTree)
        WHILE pNode
            INCR i
            nodes(i) = pNode
            pNode = WsLnTreNext(pNode)
        WEND
        FOR i = 1 TO @pTree.count
            WsLnTreFreeNode(pTree, nodes(i))
        NEXT i
    END IF
    @pTree.count = 0
    @pTree.root = 0
END SUB

FUNCTION WsLnTreCount(BYVAL pTree AS WsLnTre PTR) AS LONG
    'get item count
    IF pTree THEN FUNCTION = @pTree.count
END FUNCTION

SUB WsLnTreSet(BYVAL pTree AS WsLnTre PTR, BYREF key AS WSTRING, BYVAL value AS LONG, OPT BYVAL DontReplace AS LONG)
    'add Key/Value to tree - Value replaced if Key exist unless DontReplace = True
    LOCAL compare, temp AS LONG
    LOCAL n AS WsLnTreNode PTR
    ERR = 0
    ExitS(pTree=0 OR @pTree.tag<>WsLnTreTag, LibErrH)
    temp = WsSetNew(key) : IF ERR THEN EXIT SUB
    IF @pTree.root THEN
        n = @pTree.root
        WHILE 1
            CALL DWORD @pTree.compareCB USING WsCompareCB(temp, @n.K, @pTree.collation) TO compare
            IF compare > 0 THEN
                IF @n.R THEN
                    n = @n.R
                ELSE
                    @n.R = WsLnTreAllocNode(pTree) : IF ERR THEN EXIT SUB
                    @n.@R.P = n
                    WsSet @n.@R.K, key
                    @n.@R.V = value
                    WsLnTreBalanceBranch pTree, n
                    EXIT LOOP
                END IF
            ELSEIF compare < 0 THEN
                IF @n.L THEN
                    n = @n.L
                ELSE
                    @n.L = WsLnTreAllocNode(pTree) : IF ERR THEN EXIT SUB
                    @n.@L.P = n
                    WsSet @n.@L.K, key
                    @n.@L.V = value
                    WsLnTreBalanceBranch pTree, n
                    EXIT LOOP
                END IF
            ELSE
                IF ISFALSE DontReplace THEN @n.V = value
                EXIT LOOP
            END IF
        WEND
    ELSE
        @pTree.root = WsLnTreAllocNode(pTree) : IF ERR THEN EXIT SUB
        WsSet @pTree.@root.K, key
        @pTree.@root.V = value
        @pTree.count = 1
    END IF
    temp = WsFinal(temp)
END SUB

FUNCTION WsLnTreGet(BYVAL pTree AS WsLnTre PTR, BYREF key AS WSTRING) AS LONG
    'get Key's associated Value
    LOCAL compare, temp AS LONG
    LOCAL n AS WsLnTreNode PTR
    ERR = 0
    ExitF(pTree=0 OR @pTree.tag<>WsLnTreTag, LibErrH)
    temp = WsSetNew(key) : IF ERR THEN EXIT FUNCTION
    n = @pTree.root
    WHILE n
        CALL DWORD @pTree.compareCB USING WsCompareCB(temp, @n.K, @pTree.collation) TO compare
        IF compare < 0 THEN
            n = @n.L
        ELSEIF compare > 0 THEN
            n = @n.R
        ELSE
            FUNCTION = @n.V
            EXIT LOOP
        END IF
    WEND
    temp = WsFinal(temp)
END FUNCTION

FUNCTION WsLnTreGot(BYVAL pTree AS WsLnTre PTR, BYREF key AS WSTRING) AS LONG
    'True/False if Key exist
    LOCAL compare, temp AS LONG
    LOCAL n AS WsLnTreNode PTR
    ERR = 0
    ExitF(pTree=0 OR @pTree.tag<>WsLnTreTag, LibErrH)
    temp = WsSetNew(key) : IF ERR THEN EXIT FUNCTION
    n = @pTree.root
    WHILE n
        CALL DWORD @pTree.compareCB USING WsCompareCB(temp, @n.K, @pTree.collation) TO compare
        IF compare < 0 THEN
            n = @n.L
        ELSEIF compare > 0 THEN
            n = @n.R
        ELSE
            FUNCTION = n
            EXIT LOOP
        END IF
    WEND
    temp = WsFinal(temp)
END FUNCTION

SUB WsLnTreDel(BYVAL pTree AS WsLnTre PTR, BYREF key AS WSTRING)
    'remove Key and associated Value
    LOCAL pNode AS WsLnTreNode PTR
    ExitS(pTree=0 OR @pTree.tag<>WsLnTreTag, LibErrH)
    pNode = WsLnTreGot(pTree, key)
    IF pNode THEN
        WsLnTreRemoveNode(pTree, pNode)
    END IF
END SUB

FUNCTION WsLnTreFirst(BYVAL pTree AS WsLnTre PTR) AS LONG
    'get handle to first node in tree
    LOCAL n AS WsLnTreNode PTR
    ExitF(pTree=0 OR @pTree.tag<>WsLnTreTag, LibErrH)
    n = @pTree.root
    IF n THEN
        WHILE @n.L
            n = @n.L
        WEND
    END IF
    FUNCTION = n
END FUNCTION

FUNCTION WsLnTreLast(BYVAL pTree AS WsLnTre PTR) AS LONG
    'get handle to last node in tree
    LOCAL n AS WsLnTreNode PTR
    ExitF(pTree=0 OR @pTree.tag<>WsLnTreTag, LibErrH)
    n = @pTree.root
    IF n THEN
        WHILE @n.R
            n = @n.R
        WEND
    END IF
    FUNCTION = n
END FUNCTION

FUNCTION WsLnTreNext(BYVAL pNode AS WsLnTreNode PTR) AS LONG
    'get handle to next node in tree
    LOCAL minR AS WsLnTreNode PTR
    IF pNode THEN
        ExitF(@pNode.tag<>WsLnTreNodeTag, LibErrH)
        minR = WsLnTreMinRight(pNode)
        IF pNode <> minR THEN
            FUNCTION = minR
        ELSE
            FUNCTION = WsLnTreParentGreater(pNode)
        END IF
    END IF
END FUNCTION

FUNCTION WsLnTrePrev(BYVAL pNode AS WsLnTreNode PTR) AS LONG
    'get handle to previous node in tree
    LOCAL maxL AS WsLnTreNode PTR
    IF pNode THEN
        ExitF(@pNode.tag<>WsLnTreNodeTag, LibErrH)
        maxL = WsLnTreMaxLeft(pNode)
        IF pNode <> maxL THEN
            FUNCTION = maxL
        ELSE
            FUNCTION = WsLnTreParentLesser(pNode)
        END IF
    END IF
END FUNCTION

FUNCTION WsLnTreGetKey(BYVAL pNode AS WsLnTreNode PTR) AS WSTRING
    'get node's Key
    ExitF(pNode=0 OR @pNode.tag<>WsLnTreNodeTag, LibErrH)
    FUNCTION = WsGet(@pNode.K)
END FUNCTION

FUNCTION WsLnTreGetVal(BYVAL pNode AS WsLnTreNode PTR) AS LONG
    'get node's Value
    ExitF(pNode=0 OR @pNode.tag<>WsLnTreNodeTag, LibErrH)
    FUNCTION = @pNode.V
END FUNCTION

SUB WsLnTreSetVal(BYVAL pNode AS WsLnTreNode PTR, BYVAL value AS LONG)
    'get node's Value
    ExitS(pNode=0 OR @pNode.tag<>WsLnTreNodeTag, LibErrH)
    @pNode.V = value
END SUB

'++
    '----------------------------------------------------------------------------------------
    '   Clone Container
    '----------------------------------------------------------------------------------------
'--

FUNCTION WsLnTreClone(BYVAL pTree AS WsLnTre PTR) AS LONG
    'create duplicate container
    LOCAL h, clone AS LONG
    ERR = 0
    ExitF(pTree=0 OR @pTree.tag<>WsLnTreTag, LibErrH)
    clone = WsLnTreNew() : IF ERR THEN EXIT FUNCTION
    h = WsLnTreFirst(pTree)
    WHILE h
        WsLnTreSet clone, WsLnTreGetKey(h), WsLnTreGetVal(h)
        h = WsLnTreNext(h)
    WEND
    FUNCTION = clone
END FUNCTION

'++
    '----------------------------------------------------------------------------------------
    '   Store/Restore Container To/From String
    '----------------------------------------------------------------------------------------
'--

FUNCTION WsLnTreStore(BYVAL pTree AS WsLnTre PTR) AS STRING
    'store container to string
    LOCAL h, keys, vals, stor AS LONG
    ERR = 0
    ExitF(pTree=0 OR @pTree.tag<>WsLnTreTag, LibErrH)
    keys = WsLstNew() : IF ERR THEN EXIT FUNCTION
    vals = LnLstNew() : IF ERR THEN EXIT FUNCTION
    stor = SsLstNew() : IF ERR THEN EXIT FUNCTION
    IF @pTree.count THEN
        h = WsLnTreFirst(pTree)
        WHILE h
            WsLstAdd keys, WsLnTreGetKey(h)
            LnLstAdd vals, WsLnTreGetVal(h)
            h = WsLnTreNext(h)
        WEND
        SsLstAdd stor, WsLstStore(keys)
        SsLstAdd stor, LnLstStore(vals)
        FUNCTION = SsLstStore(stor)
    END IF
    keys = WsLstFinal(keys)
    vals = LnLstFinal(vals)
    stor = SsLstFinal(stor)
END FUNCTION

SUB WsLnTreRestore(BYVAL pTree AS WsLnTre PTR, BYVAL s AS STRING)
    'restore container from string
    LOCAL keys, vals, stor AS LONG
    ERR = 0
    ExitS(pTree=0 OR @pTree.tag<>WsLnTreTag, LibErrH)
    WsLnTreClear pTree
    keys = WsLstNew() : IF ERR THEN EXIT SUB
    vals = LnLstNew() : IF ERR THEN EXIT SUB
    stor = SsLstNew() : IF ERR THEN EXIT SUB
    IF LEN(s) THEN
        SsLstRestore stor, s : IF ERR THEN EXIT SUB
        ExitS(SsLstCount(stor)<>2, LibErrU)
        WsLstRestore keys, SsLstPopFirst(stor)
        LnLstRestore vals, SsLstPopFirst(stor)
        ExitS(WsLstCount(keys)<>LnLstCount(vals), LibErrU)
        WHILE WsLstCount(keys)
            WsLnTreSet pTree, WsLstPopFirst(keys), LnLstPopFirst(vals)
        WEND
    END IF
    keys = WsLstFinal(keys)
    vals = LnLstFinal(vals)
    stor = SsLstFinal(stor)
END SUB


'++
    '----------------------------------------------------------------------------------------
    '   Store/Restore Container To/From File
    '----------------------------------------------------------------------------------------
'--

SUB WsLnTreFileStore(BYVAL pTree AS WsLnTre PTR, BYVAL FILE AS STRING)
    'store container to file
    LOCAL s AS STRING
    LOCAL f AS LONG
    ERR = 0
    ExitS(pTree=0 OR @pTree.tag<>WsLnTreTag, LibErrH)
    s = WsLnTreStore(pTree) : IF ERR THEN EXIT SUB
    TRY
        f = FREEFILE
        OPEN FILE FOR BINARY AS f
        SETEOF f
        PUT$ f, s
        CLOSE f
    CATCH
        ExitLogErr(LibErrF)
    FINALLY
        IF f THEN CLOSE f
    END TRY
END SUB

SUB WsLnTreFileRestore(BYVAL pTree AS WsLnTre PTR, BYVAL FILE AS STRING)
    'restore container from file - Modifies Container Data
    LOCAL f AS LONG
    LOCAL s AS STRING
    ERR = 0
    ExitS(pTree=0 OR @pTree.tag<>WsLnTreTag, LibErrH)
    TRY
        f = FREEFILE
        OPEN FILE FOR BINARY AS f
        GET$ f, LOF(f), s
        WsLnTreRestore pTree, s
    CATCH
        ExitLogErr(LibErrF)
    FINALLY
        IF f THEN CLOSE f
    END TRY
END SUB

    '----------------------------------------------------------------------------------------
    '   PRIVATE
    '----------------------------------------------------------------------------------------

'========================================================
' SUB: WsLnTreRemoveNode (Corrected Data-Swapping Approach)
'========================================================
' Note: Use this with the corrected WsLnTreBalanceBranch (Attempt 4)
SUB WsLnTreRemoveNode(BYVAL p AS WsLnTre PTR, BYVAL n AS WsLnTreNode PTR) PRIVATE
    ExitS(n=0, LibErrP) ' Exit if node handle is NULL
    LOCAL nodeToDelete AS WsLnTreNode PTR ' The node whose original position needs deletion after data swap
    LOCAL nP AS WsLnTreNode PTR         ' Parent of nodeToDelete
    LOCAL replacementNode AS WsLnTreNode PTR ' Child node that replaces nodeToDelete (can be NULL)
    LOCAL nodeToBalanceFrom AS WsLnTreNode PTR ' Where to start balancing

    nodeToDelete = n ' Start with the node passed in

    ' --- Step 1: If node has TWO children, find successor, swap data, target successor for deletion ---
    IF @nodeToDelete.L AND @nodeToDelete.R THEN
        ' Node has two children. Find inorder successor (minimum node in right subtree).
        LOCAL successor AS WsLnTreNode PTR
        successor = WsLnTreMinRight(nodeToDelete) ' Find the successor node

        ' Swap Key handles (K) and Values (V) between nodeToDelete and successor
        SWAP @nodeToDelete.K, @successor.K
        SWAP @nodeToDelete.V, @successor.V

        ' Now, the node we *actually* need to remove physically is the successor node
        ' from its original position. It's guaranteed to have 0 or 1 right child.
        nodeToDelete = successor
    END IF

    ' --- Step 2: Now 'nodeToDelete' has 0 or 1 child. Remove it physically. ---

    ' Determine the single child (if any) that will replace the nodeToDelete
    IF @nodeToDelete.L THEN
        replacementNode = @nodeToDelete.L
    ELSE
        replacementNode = @nodeToDelete.R ' Can be NULL if no children
    END IF

    ' Get the parent of the node we are about to physically remove
    nP = @nodeToDelete.P
    nodeToBalanceFrom = nP ' Balance starts from here

    ' --- Link replacement node to parent (nP) ---
    IF nP = %NULL THEN
        ' Deleting the root node
        @p.root = replacementNode ' New root is the replacement (or NULL if tree empty)
        IF replacementNode THEN @replacementNode.P = %NULL ' Update replacement's parent
    ELSE
        ' Deleting a non-root node
        IF @nP.L = nodeToDelete THEN
            @nP.L = replacementNode ' Link parent's left to replacement
        ELSE
            @nP.R = replacementNode ' Link parent's right to replacement
        END IF
        IF replacementNode THEN @replacementNode.P = nP ' Update replacement's parent
    END IF

    ' --- Free the node that was physically removed ---
    nodeToDelete = WsLnTreFreeNode(p, nodeToDelete) ' Frees memory, decrements count

    ' --- Rebalance starting from the parent of the removed node's position ---
    IF nodeToBalanceFrom THEN ' Only balance if there was a parent
        WsLnTreBalanceBranch p, nodeToBalanceFrom
    END IF

END SUB


FUNCTION WsLnTreFreeNode(BYVAL p AS WsLnTre PTR, BYVAL n AS WsLnTreNode PTR) AS LONG
    IF n THEN
        @n.K = WsFinal(@n.K)
        MemFree(n)
        IF @p.count = 0 THEN
            ERR = LibErrU
            FUNCTION = %FALSE
            EXIT FUNCTION
        END IF
        DECR @p.count
        FUNCTION = %TRUE
    END IF
END FUNCTION




FUNCTION WsLnTreAllocNode(BYVAL p AS WsLnTre PTR) PRIVATE AS LONG
    LOCAL n AS WsLnTreNode PTR
    n = MemAlloc(SIZEOF(WsLnTreNode))
    ExitF(n=0, LIbErrM)
    @n.HL = 1
    @n.HR = 1
    @n.tag = WsLnTreNodeTag
    @n.K = WsNew() : IF ERR THEN EXIT FUNCTION
    INCR @p.count
    FUNCTION = n
END FUNCTION


'========================================================
' SUB: WsLnTreBalanceBranch (Attempt 4 - PB Syntax Fixes)
'========================================================
SUB WsLnTreBalanceBranch(BYVAL p AS WsLnTre PTR, BYVAL n AS WsLnTreNode PTR) PRIVATE
    LOCAL rotatedNodeHandle AS LONG       ' Handle of the new root after rotation
    LOCAL nodeToProcessCurrent AS WsLnTreNode PTR ' Node being processed in this iteration
    LOCAL nodeToProcessNext AS WsLnTreNode PTR  ' Node to process in the *next* iteration
    LOCAL tempRotatedNodePtr AS WsLnTreNode PTR ' Temporary pointer for casting handle

    nodeToProcessNext = n ' Start balancing from the specified node

    WHILE nodeToProcessNext ' Loop upwards as long as we have a valid node handle
        nodeToProcessCurrent = nodeToProcessNext ' Assign node for this iteration

        ' --- Store Parent for the NEXT iteration EARLY ---
        ' This is crucial because rotations might change the current node's parent pointer.
        IF @nodeToProcessCurrent.P THEN
            nodeToProcessNext = @nodeToProcessCurrent.P ' Store its parent handle
        ELSE
            nodeToProcessNext = %NULL ' Reached the root's parent (NULL)
        END IF

        ' --- Recalculate heights for the current node ---
        @nodeToProcessCurrent.HL = IIF&(@nodeToProcessCurrent.L, MAX&(@nodeToProcessCurrent.@L.HL, @nodeToProcessCurrent.@L.HR) + 1, 1)
        @nodeToProcessCurrent.HR = IIF&(@nodeToProcessCurrent.R, MAX&(@nodeToProcessCurrent.@R.HL, @nodeToProcessCurrent.@R.HR) + 1, 1)

        ' --- Check for imbalance and perform rotation if needed ---
        IF @nodeToProcessCurrent.HL > @nodeToProcessCurrent.HR + 1 THEN
            ' Rotate Right needed
            rotatedNodeHandle = WsLnTreRotateRight(p, nodeToProcessCurrent)
            ' After rotation, the original 'nodeToProcessCurrent' might have moved.
            ' The 'rotatedNodeHandle' points to the NEW root of this balanced subtree.
            ' The loop should continue from the PARENT of whatever node is now at the top
            ' of the subtree where the rotation occurred.
            IF rotatedNodeHandle <> 0 THEN ' Check if rotation actually returned a valid handle
                 tempRotatedNodePtr = rotatedNodeHandle ' Assign LONG handle to PTR
                 IF @tempRotatedNodePtr.P THEN          ' Does the new root have a parent?
                     nodeToProcessNext = @tempRotatedNodePtr.P ' Continue from new root's parent
                 ELSE
                     nodeToProcessNext = %NULL          ' New root became the tree root
                 END IF
            ELSE
                 ' Rotation function failed or returned NULL unexpectedly
                 nodeToProcessNext = %NULL ' Stop balancing
            END IF
            ' *** NO ITERATE needed here *** - Let WHILE condition check nodeToProcessNext

        ELSEIF @nodeToProcessCurrent.HR > @nodeToProcessCurrent.HL + 1 THEN
            ' Rotate Left needed
            rotatedNodeHandle = WsLnTreRotateLeft(p, nodeToProcessCurrent)
             ' Similar logic as above
            IF rotatedNodeHandle <> 0 THEN
                 tempRotatedNodePtr = rotatedNodeHandle ' Assign LONG handle to PTR
                 IF @tempRotatedNodePtr.P THEN
                     nodeToProcessNext = @tempRotatedNodePtr.P ' Continue from new root's parent
                 ELSE
                     nodeToProcessNext = %NULL
                 END IF
            ELSE
                 nodeToProcessNext = %NULL ' Stop balancing
            END IF
             ' *** NO ITERATE needed here ***

        ELSE
            ' Node is balanced at this level.
            ' The loop will continue with the parent stored in 'nodeToProcessNext'
            ' which was captured at the beginning of this iteration.
            ' *** NO ITERATE needed here ***
        END IF

    WEND ' Loop continues with nodeToProcessNext
END SUB

FUNCTION WsLnTreMaxLeft(BYVAL n AS WsLnTreNode PTR) PRIVATE AS LONG
    IF n THEN
        IF @n.L THEN
            n = @n.L
            WHILE @n.R
                n = @n.R
            WEND
        END IF
    END IF
    FUNCTION = n
END FUNCTION

FUNCTION WsLnTreMinRight(BYVAL n AS WsLnTreNode PTR) PRIVATE AS LONG
    IF n THEN
        IF @n.R THEN
            n = @n.R
            WHILE @n.L
                n = @n.L
            WEND
        END IF
    END IF
    FUNCTION = n
END FUNCTION

FUNCTION WsLnTreParentGreater(BYVAL n AS WsLnTreNode PTR) PRIVATE AS LONG
    IF n THEN
        WHILE @n.P
            IF @n.@P.L = n THEN
                FUNCTION = @n.P
                EXIT FUNCTION
            ELSE
                n = @n.P
            END IF
        WEND
    END IF
END FUNCTION

FUNCTION WsLnTreParentLesser(BYVAL n AS WsLnTreNode PTR) PRIVATE AS LONG
    IF n THEN
        WHILE @n.P
            IF @n.@P.R = n THEN
                FUNCTION = @n.P
                EXIT FUNCTION
            ELSE
                n = @n.P
            END IF
        WEND
    END IF
END FUNCTION
             '========================================================
' FUNCTION: WsLnTreRotateLeft (Corrected Return Value)
'========================================================
FUNCTION WsLnTreRotateLeft(BYVAL p AS WsLnTre PTR, BYVAL n AS WsLnTreNode PTR) PRIVATE AS LONG
    LOCAL nR AS WsLnTreNode PTR     ' Right child of n
    LOCAL nRL AS WsLnTreNode PTR    ' Right child's Left child (for double rotation)
    LOCAL newSubtreeRoot AS LONG  ' Handle to the node that becomes root of this subtree

    nR = @n.R ' Get right child

    ' Check for Right-Left Case (Double Rotation needed)
    IF @nR.HL > @nR.HR THEN
        ' Perform Rotation Right on nR first
        nRL = @nR.L
        @n.R = nRL      ' n's right child becomes nRL
        @nRL.P = n      ' nRL's parent becomes n
        @nR.L = @nRL.R  ' nR's left child becomes nR's old right grandchild
        IF @nR.L THEN @nR.@L.P = nR ' Update parent of that grandchild
        @nRL.R = nR      ' nRL's right child becomes nR
        @nR.P = nRL      ' nR's parent becomes nRL

        ' Recalculate heights for nR after its rotation
        @nR.HL = IIF&(@nR.L, MAX&(@nR.@L.HL, @nR.@L.HR) + 1, 1)
        @nR.HR = IIF&(@nR.R, MAX&(@nR.@R.HL, @nR.@R.HR) + 1, 1)

        ' nR has been updated locally, update pointer for main rotation
        nR = @n.R ' nR now points to nRL (the new right child of n)
    END IF

    ' Perform Rotation Left on n
    newSubtreeRoot = nR  ' nR (or nRL if double) will be the new root

    ' Update tree root if n was the root
    IF @p.root = n THEN @p.root = nR

    ' Re-parent nR
    @nR.P = @n.P ' nR takes n's old parent
    IF @nR.P THEN ' Make old parent point to nR
        IF @nR.@P.L = n THEN @nR.@P.L = nR ELSE @nR.@P.R = nR
    END IF

    ' Adjust child pointers
    @n.R = @nR.L        ' n adopts nR's left child as its right child
    IF @n.R THEN @n.@R.P = n ' Update parent of adopted child

    @nR.L = n           ' n becomes the left child of nR
    @n.P = nR           ' n's parent becomes nR

    ' *** Recalculate heights AFTER structure changes
    ' Height of n (which moved down)
    @n.HL = IIF&(@n.L, MAX&(@n.@L.HL, @n.@L.HR) + 1, 1)
    @n.HR = IIF&(@n.R, MAX&(@n.@R.HL, @n.@R.HR) + 1, 1)
    ' Height of nR (the new root of this subtree)
    @nR.HL = IIF&(@nR.L, MAX&(@nR.@L.HL, @nR.@L.HR) + 1, 1)
    @nR.HR = IIF&(@nR.R, MAX&(@nR.@R.HL, @nR.@R.HR) + 1, 1)


    FUNCTION = newSubtreeRoot ' *** Corrected: Return the NEW root of this subtree ***
END FUNCTION

'========================================================
' FUNCTION: WsLnTreRotateRight (Corrected Return Value)
'========================================================
FUNCTION WsLnTreRotateRight(BYVAL p AS WsLnTre PTR, BYVAL n AS WsLnTreNode PTR) PRIVATE AS LONG
    LOCAL nL AS WsLnTreNode PTR     ' Left child of n
    LOCAL nLR AS WsLnTreNode PTR    ' Left child's Right child (for double rotation)
    LOCAL newSubtreeRoot AS LONG  ' Handle to the node that becomes root of this subtree

    nL = @n.L ' Get left child

    ' Check for Left-Right Case (Double Rotation needed)
    IF @nL.HR > @nL.HL THEN
        ' Perform Rotation Left on nL first
        nLR = @nL.R
        @n.L = nLR       ' n's left child becomes nLR
        @nLR.P = n       ' nLR's parent becomes n
        @nL.R = @nLR.L   ' nL's right child becomes nLR's old left grandchild
        IF @nL.R THEN @nL.@R.P = nL ' Update parent of that grandchild
        @nLR.L = nL       ' nLR's left child becomes nL
        @nL.P = nLR       ' nL's parent becomes nLR

        ' Recalculate heights for nL after its rotation
        @nL.HL = IIF&(@nL.L, MAX&(@nL.@L.HL, @nL.@L.HR) + 1, 1)
        @nL.HR = IIF&(@nL.R, MAX&(@nL.@R.HL, @nL.@R.HR) + 1, 1)

        ' nL has been updated locally, update pointer for main rotation
        nL = @n.L ' nL now points to nLR (the new left child of n)
    END IF

    ' Perform Rotation Right on n
    newSubtreeRoot = nL ' nL (or nLR if double) will be the new root

    ' Update tree root if n was the root
    IF @p.root = n THEN @p.root = nL

    ' Re-parent nL
    @nL.P = @n.P ' nL takes n's old parent
    IF @nL.P THEN ' Make old parent point to nL
        IF @nL.@P.L = n THEN @nL.@P.L = nL ELSE @nL.@P.R = nL
    END IF

     ' Adjust child pointers
    @n.L = @nL.R        ' n adopts nL's right child as its left child
    IF @n.L THEN @n.@L.P = n ' Update parent of adopted child

    @nL.R = n           ' n becomes the right child of nL
    @n.P = nL           ' n's parent becomes nL


    ' *** Recalculate heights AFTER structure changes
     ' Height of n (which moved down)
    @n.HL = IIF&(@n.L, MAX&(@n.@L.HL, @n.@L.HR) + 1, 1)
    @n.HR = IIF&(@n.R, MAX&(@n.@R.HL, @n.@R.HR) + 1, 1)
    ' Height of nL (the new root of this subtree)
    @nL.HL = IIF&(@nL.L, MAX&(@nL.@L.HL, @nL.@L.HR) + 1, 1)
    @nL.HR = IIF&(@nL.R, MAX&(@nL.@R.HL, @nL.@R.HR) + 1, 1)


    FUNCTION = newSubtreeRoot ' *** Corrected: Return the NEW root of this subtree ***
END FUNCTION



To see the original codes fail use this test.
Its very likely that all other Tre-Functions also have the same problem and must get the same fix before using them.

Code Select Expand


#COMPILE EXE
#DIM ALL

#INCLUDE ONCE "..\HLIB3\Tree\WsLnTre.inc"
#INCLUDE "Your Debugger"


' Switches to enable testing different aspects
%DoTreLifeCycleTests = 1
%DoTreSetGetGotTests = 1
%DoTreIterationTests = 1
%DoTreDeleteTests = 1
%DoTreComparisonTests = 1 ' Assumes WsCompare* in WsStr.inc are COMMON
%DoTreCapacityTests = 1
%DoTreCloneTests = 1
%DoTreStoreRestoreTests = 1

' --- Global Test Variables ---
GLOBAL gTreTestCount AS LONG
GLOBAL gTreFailCount AS LONG

' --- Test Reporting Sub ---
' Use the same TestResult SUB as before, just ensure gTreTestCount/gTreFailCount are used.
SUB TestResultTre(BYVAL TestName AS STRING, BYVAL Success AS LONG)
    INCR gTreTestCount
    IF Success = %FALSE THEN
        INCR gTreFailCount
        X_AU TestName & ": *** FAIL ***" ' Use X_AU
    ELSE
        X_AU TestName & ": Pass" ' Use X_AU
    END IF
END SUB

' --- Helper Functions ---

' Creates a simple tree for reuse in tests
FUNCTION CreateSimpleTree(compareMode AS LONG) AS LONG
    LOCAL hTree AS LONG
    LOCAL key AS WSTRING
    LOCAL retVal AS LONG

    retVal = 0 'Default fail

    hTree = WsLnTreNew()
    IF hTree = 0 THEN GOTO CreateSimpleExit
    IF compareMode = 1 THEN WsLnTreComparison hTree, %TRUE, "" ' Set Case-Insensitive

    ' Add some keys - order chosen to likely trigger rotations
    key = "Mango" : WsLnTreSet hTree, key, 10
    key = "Apple" : WsLnTreSet hTree, key, 20
    key = "Orange" : WsLnTreSet hTree, key, 30
    key = "Banana" : WsLnTreSet hTree, key, 40
    key = "Peach" : WsLnTreSet hTree, key, 50
    key = "Grape" : WsLnTreSet hTree, key, 60

    ' Check final count (basic validation)
    IF WsLnTreCount(hTree) <> 6 THEN
         X_AU "CreateSimpleTree: Incorrect count after adds!"
         hTree = WsLnTreFinal(hTree) ' Cleanup on failure
         GOTO CreateSimpleExit
    END IF

    retVal = hTree ' Success

CreateSimpleExit:
    FUNCTION = retVal
END FUNCTION

' Verifies iteration order and values
FUNCTION VerifyTreeOrder(BYVAL hTree AS LONG, expectedKeys() AS WSTRING, expectedVals() AS LONG, BYVAL UCASECheck AS LONG) AS LONG
    LOCAL i AS LONG
    LOCAL hNode AS LONG
    LOCAL nodeKey AS WSTRING
    LOCAL nodeVal AS LONG
    LOCAL result AS LONG
    LOCAL numExpected AS LONG

    result = %TRUE ' Assume success
    numExpected = UBOUND(expectedKeys)
    IF UBOUND(expectedVals) <> numExpected THEN
        X_AU "VerifyTreeOrder: Key/Value array size mismatch!"
        FUNCTION = %FALSE : EXIT FUNCTION
    END IF
    IF WsLnTreCount(hTree) <> numExpected THEN
        X_AU "VerifyTreeOrder: Tree count (" & TRIM$(STR$(WsLnTreCount(hTree))) & ") mismatch expected count(" & STR$(numExpected) & ")"
        result = %FALSE
        ' Continue checks anyway
    END IF

    ' Forward Iteration Check
    i = 0
    hNode = WsLnTreFirst(hTree)
    WHILE hNode
        INCR i
        IF i > numExpected THEN
            X_AU "VerifyTreeOrder: Forward iteration yielded MORE items than expected!"
            result = %FALSE : EXIT LOOP
        END IF
        nodeKey = WsLnTreGetKey(hNode)
        nodeVal = WsLnTreGetVal(hNode)
        IF UCASECheck THEN
            IF UCASE$(nodeKey) <> UCASE$(expectedKeys(i)) OR nodeVal <> expectedVals(i) THEN
                X_AU "VerifyTreeOrder: Mismatch Forward Item " & STR$(i) & " - Got '" & nodeKey & "':" & STR$(nodeVal) & ", Expected(UCASE) '" & expectedKeys(i) & "':" & STR$(expectedVals(i))
                result = %FALSE
            END IF
        ELSE
             IF nodeKey <> expectedKeys(i) OR nodeVal <> expectedVals(i) THEN
                X_AU "VerifyTreeOrder: Mismatch Forward Item " & STR$(i) & " - Got '" & nodeKey & "':" & STR$(nodeVal) & ", Expected '" & expectedKeys(i) & "':" & STR$(expectedVals(i))
                result = %FALSE
            END IF
        END IF
        hNode = WsLnTreNext(hNode)
    WEND
    IF i <> numExpected AND result <> %FALSE THEN
       X_AU "VerifyTreeOrder: Forward iteration yielded FEWER items than expected (" & STR$(i) & "/" & STR$(numExpected) & ")"
       result = %FALSE
    END IF


    ' Backward Iteration Check (if forward was okay)
    IF result = %TRUE THEN
        i = numExpected + 1
        hNode = WsLnTreLast(hTree)
        WHILE hNode
            DECR i
            IF i < 1 THEN
                X_AU "VerifyTreeOrder: Backward iteration yielded MORE items than expected!"
                result = %FALSE : EXIT LOOP
            END IF
            nodeKey = WsLnTreGetKey(hNode)
            nodeVal = WsLnTreGetVal(hNode)
            IF UCASECheck THEN
                IF UCASE$(nodeKey) <> UCASE$(expectedKeys(i)) OR nodeVal <> expectedVals(i) THEN
                    X_AU "VerifyTreeOrder: Mismatch Backward Item " & STR$(i) & " - Got '" & nodeKey & "':" & STR$(nodeVal) & ", Expected(UCASE) '" & expectedKeys(i) & "':" & STR$(expectedVals(i))
                    result = %FALSE
                END IF
            ELSE
                 IF nodeKey <> expectedKeys(i) OR nodeVal <> expectedVals(i) THEN
                    X_AU "VerifyTreeOrder: Mismatch Backward Item " & STR$(i) & " - Got '" & nodeKey & "':" & STR$(nodeVal) & ", Expected '" & expectedKeys(i) & "':" & STR$(expectedVals(i))
                    result = %FALSE
                END IF
            END IF

            hNode = WsLnTrePrev(hNode)
        WEND
         IF i <> 1 AND result <> %FALSE THEN
           X_AU "VerifyTreeOrder: Backward iteration yielded FEWER items than expected (" & STR$(numExpected-i+1) & "/" & STR$(numExpected) & ")"
           result = %FALSE
        END IF
    END IF

    FUNCTION = result
END FUNCTION

' --- Test Subroutines ---

SUB TestTreLifecycle()
    LOCAL h1 AS LONG
    LOCAL isValid AS LONG
    LOCAL COUNT AS LONG

    X_AU "-- Tree Lifecycle Tests --"
    gTreTestCount = 0 : gTreFailCount = 0

    ' Test New/Validate/Final
    h1 = WsLnTreNew()
    TestResultTre("TreLifecycle: WsLnTreNew", IIF(h1 <> 0, %TRUE, %FALSE))
    isValid = WsLnTreValidate(h1)
    TestResultTre("TreLifecycle: WsLnTreValidate (Valid)", IIF(isValid <> 0, %TRUE, %FALSE))
    COUNT = WsLnTreCount(h1)
    TestResultTre("TreLifecycle: WsLnTreCount (New)", IIF(COUNT = 0, %TRUE, %FALSE))
    h1 = WsLnTreFinal(h1)
    TestResultTre("TreLifecycle: WsLnTreFinal", IIF(h1 = 0, %TRUE, %FALSE))
    isValid = WsLnTreValidate(h1) ' h1 is 0
    TestResultTre("TreLifecycle: WsLnTreValidate (Final)", IIF(isValid = 0, %TRUE, %FALSE))
    COUNT = WsLnTreCount(h1) ' Count on NULL handle
    TestResultTre("TreLifecycle: WsLnTreCount (Final)", IIF(COUNT = 0, %TRUE, %FALSE))

    X_AU "Tree Lifecycle Tests Complete: " & TRIM$(FORMAT$(gTreTestCount-gTreFailCount)) & "/" & TRIM$(FORMAT$(gTreTestCount)) & " Passed."
    X_AU ""
END SUB

SUB TestTreSetGetGot()
    LOCAL hTree AS LONG
    LOCAL key AS WSTRING
    LOCAL L02 AS LONG
    LOCAL hNodeCheck AS LONG
    LOCAL expectVal AS LONG

    X_AU "-- Tree Set/Get/Got Tests --"
    gTreTestCount = 0 : gTreFailCount = 0

    hTree = WsLnTreNew()
    TestResultTre("SetGetGot: New", IIF(hTree <> 0, %TRUE, %FALSE))
    IF hTree = 0 THEN EXIT SUB

    ' Add first item
    key = "First" : WsLnTreSet hTree, key, 100
    TestResultTre("SetGetGot: First Add Count", IIF(WsLnTreCount(hTree) = 1, %TRUE, %FALSE))
    L02 = WsLnTreGet(hTree, key)
    TestResultTre("SetGetGot: First Get Value", IIF(L02 = 100, %TRUE, %FALSE))
    hNodeCheck = WsLnTreGot(hTree, key)
    TestResultTre("SetGetGot: First Got Handle", IIF(hNodeCheck <> 0, %TRUE, %FALSE))

    ' Add second item
    key = "Second" : WsLnTreSet hTree, key, 200
    TestResultTre("SetGetGot: Second Add Count", IIF(WsLnTreCount(hTree) = 2, %TRUE, %FALSE))
    L02 = WsLnTreGet(hTree, key)
    TestResultTre("SetGetGot: Second Get Value", IIF(L02 = 200, %TRUE, %FALSE))
    hNodeCheck = WsLnTreGot(hTree, key)
    TestResultTre("SetGetGot: Second Got Handle", IIF(hNodeCheck <> 0, %TRUE, %FALSE))

    ' Get first item again
    key = "First" : L02 = WsLnTreGet(hTree, key)
    TestResultTre("SetGetGot: First Get Again Value", IIF(L02 = 100, %TRUE, %FALSE))

    ' Replace existing item
    key = "First" : WsLnTreSet hTree, key, 150 ' Replace value
    TestResultTre("SetGetGot: Replace Count", IIF(WsLnTreCount(hTree) = 2, %TRUE, %FALSE))
    L02 = WsLnTreGet(hTree, key)
    TestResultTre("SetGetGot: Replace Get Value", IIF(L02 = 150, %TRUE, %FALSE))

    ' Try replace with DontReplace = TRUE
    key = "First" : expectVal = 150 : WsLnTreSet hTree, key, 999, %TRUE ' DontReplace
    TestResultTre("SetGetGot: DontReplace Count", IIF(WsLnTreCount(hTree) = 2, %TRUE, %FALSE))
    L02 = WsLnTreGet(hTree, key)
    TestResultTre("SetGetGot: DontReplace Get Value", IIF(L02 = expectVal, %TRUE, %FALSE))

    ' Get non-existent key
    key = "Missing"
    L02 = WsLnTreGet(hTree, key)
    TestResultTre("SetGetGot: Get Missing Value", IIF(L02 = 0, %TRUE, %FALSE)) ' Expect 0
    hNodeCheck = WsLnTreGot(hTree, key)
    TestResultTre("SetGetGot: Got Missing Handle", IIF(hNodeCheck = 0, %TRUE, %FALSE)) ' Expect 0

    hTree = WsLnTreFinal(hTree)
    TestResultTre("SetGetGot: Final", IIF(hTree = 0, %TRUE, %FALSE))
    X_AU "Tree Set/Get/Got Tests Complete: " & TRIM$(FORMAT$(gTreTestCount-gTreFailCount)) & "/" & TRIM$(FORMAT$(gTreTestCount)) & " Passed."
    X_AU ""
END SUB

SUB TestTreIteration()
    LOCAL hTree AS LONG
    LOCAL hNode AS LONG
    LOCAL key AS WSTRING
    LOCAL L02 AS LONG
    DIM expectedKeys(1 TO 6) AS WSTRING
    DIM expectedVals(1 TO 6) AS LONG

    X_AU "-- Tree Iteration Tests --"
    gTreTestCount = 0 : gTreFailCount = 0

    ' Test Empty Tree
    hTree = WsLnTreNew()
    TestResultTre("Iterate: New Empty", IIF(hTree <> 0, %TRUE, %FALSE))
    IF hTree = 0 THEN EXIT SUB
    hNode = WsLnTreFirst(hTree)
    TestResultTre("Iterate: First (Empty)", IIF(hNode=0, %TRUE, %FALSE))
    hNode = WsLnTreLast(hTree)
    TestResultTre("Iterate: Last (Empty)", IIF(hNode=0, %TRUE, %FALSE))
    WsLnTreClear hTree ' Test Clear on empty
    TestResultTre("Iterate: Clear (Empty)", IIF(WsLnTreCount(hTree)=0, %TRUE, %FALSE))
    hTree = WsLnTreFinal(hTree)

    ' Test Single Item Tree
    hTree = WsLnTreNew()
    TestResultTre("Iterate: New Single", IIF(hTree <> 0, %TRUE, %FALSE))
    IF hTree = 0 THEN EXIT SUB
    key = "Only" : WsLnTreSet hTree, key, 5
    hNode = WsLnTreFirst(hTree)
    TestResultTre("Iterate: First (Single)", IIF(hNode<>0, %TRUE, %FALSE))
    IF hNode <> 0 THEN
      TestResultTre("Iterate: First Key (Single)", IIF(WsLnTreGetKey(hNode)="Only", %TRUE, %FALSE))
      TestResultTre("Iterate: First Value (Single)", IIF(WsLnTreGetVal(hNode)=5, %TRUE, %FALSE))
      TestResultTre("Iterate: Next (Single)", IIF(WsLnTreNext(hNode)=0, %TRUE, %FALSE))
    END IF
    hNode = WsLnTreLast(hTree)
    TestResultTre("Iterate: Last (Single)", IIF(hNode<>0, %TRUE, %FALSE))
     IF hNode <> 0 THEN
       TestResultTre("Iterate: Prev (Single)", IIF(WsLnTrePrev(hNode)=0, %TRUE, %FALSE))
     END IF
    hTree = WsLnTreFinal(hTree)

    ' Test Multi-Item Tree (Case-Sensitive Default)
    hTree = CreateSimpleTree(0) ' Use helper, case-sensitive
    TestResultTre("Iterate: Create Multi", IIF(hTree <> 0, %TRUE, %FALSE))
    IF hTree = 0 THEN EXIT SUB
    ' Expected order (Alphabetical)
    expectedKeys(1) = "Apple"   : expectedVals(1) = 20
    expectedKeys(2) = "Banana"  : expectedVals(2) = 40
    expectedKeys(3) = "Grape"   : expectedVals(3) = 60
    expectedKeys(4) = "Mango"   : expectedVals(4) = 10
    expectedKeys(5) = "Orange"  : expectedVals(5) = 30
    expectedKeys(6) = "Peach"   : expectedVals(6) = 50
    TestResultTre("Iterate: Verify Order Multi (Case-Sensitive)", VerifyTreeOrder(hTree, expectedKeys(), expectedVals(), %FALSE))
    hTree = WsLnTreFinal(hTree)

    X_AU "Tree Iteration Tests Complete: " & TRIM$(FORMAT$(gTreTestCount-gTreFailCount)) & "/" & TRIM$(FORMAT$(gTreTestCount)) & " Passed."
    X_AU ""
END SUB


SUB TestTreDelete()
     LOCAL hTree AS LONG
     LOCAL key AS WSTRING
     LOCAL COUNT AS LONG
     LOCAL hNodeCheck AS LONG
     DIM expectedKeys() AS WSTRING
     DIM expectedVals() AS LONG

     X_AU "-- Tree Deletion Tests --"
     gTreTestCount = 0 : gTreFailCount = 0

     ' Create simple tree
     hTree = CreateSimpleTree(0) ' Case-sensitive
     TestResultTre("Delete: Create Tree", IIF(hTree <> 0, %TRUE, %FALSE))
     IF hTree = 0 THEN EXIT SUB

     ' Delete non-existent key
     key = "Watermelon" : WsLnTreDel hTree, key
     COUNT = WsLnTreCount(hTree)
     TestResultTre("Delete: Delete Non-existent Count", IIF(COUNT = 6, %TRUE, %FALSE))

     ' Delete leaf node ("Apple")
     key = "Apple" : WsLnTreDel hTree, key
     TestResultTre("Delete: Delete Leaf Count", IIF(WsLnTreCount(hTree) = 5, %TRUE, %FALSE))
     hNodeCheck = WsLnTreGot(hTree, key)
     TestResultTre("Delete: Delete Leaf Got", IIF(hNodeCheck = 0, %TRUE, %FALSE))
     REDIM expectedKeys(1 TO 5) : REDIM expectedVals(1 TO 5)
     expectedKeys(1) = "Banana"  : expectedVals(1) = 40
     expectedKeys(2) = "Grape"   : expectedVals(2) = 60
     expectedKeys(3) = "Mango"   : expectedVals(3) = 10
     expectedKeys(4) = "Orange"  : expectedVals(4) = 30
     expectedKeys(5) = "Peach"   : expectedVals(5) = 50
     TestResultTre("Delete: Verify Order After Leaf Delete", VerifyTreeOrder(hTree, expectedKeys(), expectedVals(), %FALSE))

     ' Delete node with one child (e.g., delete "Peach" - requires adding another element first maybe?)
     ' Let's delete "Orange" which likely has one child ("Peach"?) after rotations
     key = "Orange" : WsLnTreDel hTree, key
     TestResultTre("Delete: Delete Node w/ Child Count", IIF(WsLnTreCount(hTree) = 4, %TRUE, %FALSE))
     hNodeCheck = WsLnTreGot(hTree, key)
     TestResultTre("Delete: Delete Node w/ Child Got", IIF(hNodeCheck = 0, %TRUE, %FALSE))
     REDIM expectedKeys(1 TO 4) : REDIM expectedVals(1 TO 4)
     expectedKeys(1) = "Banana"  : expectedVals(1) = 40
     expectedKeys(2) = "Grape"   : expectedVals(2) = 60
     expectedKeys(3) = "Mango"   : expectedVals(3) = 10
     expectedKeys(4) = "Peach"   : expectedVals(4) = 50
     TestResultTre("Delete: Verify Order After One Child Delete", VerifyTreeOrder(hTree, expectedKeys(), expectedVals(), %FALSE))

      ' Delete node with two children (e.g., delete "Mango" if root)
     key = "Mango" : WsLnTreDel hTree, key
     TestResultTre("Delete: Delete Root/Node w/ 2 Children Count", IIF(WsLnTreCount(hTree) = 3, %TRUE, %FALSE))
     hNodeCheck = WsLnTreGot(hTree, key)
     TestResultTre("Delete: Delete Root/Node w/ 2 Children Got", IIF(hNodeCheck = 0, %TRUE, %FALSE))
     REDIM expectedKeys(1 TO 3) : REDIM expectedVals(1 TO 3)
     expectedKeys(1) = "Banana"  : expectedVals(1) = 40 ' Order might depend on rotation logic
     expectedKeys(2) = "Grape"   : expectedVals(2) = 60
     expectedKeys(3) = "Peach"   : expectedVals(3) = 50
     TestResultTre("Delete: Verify Order After Two Child Delete", VerifyTreeOrder(hTree, expectedKeys(), expectedVals(), %FALSE))


     ' Delete remaining
     key = "Grape" : WsLnTreDel hTree, key
     key = "Peach" : WsLnTreDel hTree, key
     key = "Banana" : WsLnTreDel hTree, key
     TestResultTre("Delete: Delete All Remaining", IIF(WsLnTreCount(hTree) = 0, %TRUE, %FALSE))

     hTree = WsLnTreFinal(hTree)
     TestResultTre("Delete: Final", IIF(hTree = 0, %TRUE, %FALSE))
     X_AU "Tree Deletion Tests Complete: " & TRIM$(FORMAT$(gTreTestCount-gTreFailCount)) & "/" & TRIM$(FORMAT$(gTreTestCount)) & " Passed."
     X_AU ""
END SUB

SUB TestTreComparison()
     LOCAL hTree AS LONG
     LOCAL key1 AS WSTRING
     LOCAL key2 AS WSTRING
     LOCAL key3 AS WSTRING
     LOCAL hNodeCheck AS LONG

     X_AU "-- Tree Comparison Tests --"
     gTreTestCount = 0 : gTreFailCount = 0

     hTree = WsLnTreNew()
     TestResultTre("Compare: New", IIF(hTree <> 0, %TRUE, %FALSE))
     IF hTree=0 THEN EXIT SUB

     ' Default is Case Sensitive (WsCompare)
     key1 = "KeY"  : WsLnTreSet hTree, key1, 1
     key2 = "key"  : WsLnTreSet hTree, key2, 2
     key3 = "KEY"  : WsLnTreSet hTree, key3, 3
     TestResultTre("Compare: Case-Sensitive Add Count", IIF(WsLnTreCount(hTree) = 3, %TRUE, %FALSE))
     TestResultTre("Compare: Case-Sensitive Get 'KeY'", IIF(WsLnTreGet(hTree, key1)=1, %TRUE, %FALSE))
     TestResultTre("Compare: Case-Sensitive Get 'key'", IIF(WsLnTreGet(hTree, key2)=2, %TRUE, %FALSE))
     TestResultTre("Compare: Case-Sensitive Get 'KEY'", IIF(WsLnTreGet(hTree, key3)=3, %TRUE, %FALSE))

     ' Change to Case Insensitive
     WsLnTreComparison hTree, %TRUE, "" ' Set UCase comparison
     TestResultTre("Compare: Set Case-Insensitive", %TRUE) ' Assumes no error

     ' Try adding again - should replace/fail based on DontReplace (default is replace)
     key1 = "kEy" : WsLnTreSet hTree, key1, 4
     TestResultTre("Compare: Case-Insensitive Replace Count", IIF(WsLnTreCount(hTree) = 3, %TRUE, %FALSE)) ' Count shouldn't change
     ' Which one did it replace? Depends on tree structure/ comparison result of "kEy" vs existing. Let's check Got
     key1="KeY": hNodeCheck = WsLnTreGot(hTree, key1)
     TestResultTre("Compare: Case-Insensitive Got 'KeY'", IIF(hNodeCheck <> 0, %TRUE, %FALSE)) 'Should find *an* entry
     IF hNodeCheck <> 0 THEN TestResultTre("Compare: Case-Insensitive Check Final Value", IIF(WsLnTreGetVal(hNodeCheck)=4, %TRUE, %FALSE))

     hTree = WsLnTreFinal(hTree)
     TestResultTre("Compare: Final", IIF(hTree = 0, %TRUE, %FALSE))
     X_AU "Tree Comparison Tests Complete: " & TRIM$(FORMAT$(gTreTestCount-gTreFailCount)) & "/" & TRIM$(FORMAT$(gTreTestCount)) & " Passed."
     X_AU ""
END SUB

SUB TestTreCapacity()
    LOCAL hTree AS LONG
    LOCAL i AS LONG
    LOCAL keyBase AS WSTRING
    LOCAL key AS WSTRING
    LOCAL L02 AS LONG
    LOCAL hNode AS LONG
    LOCAL numItems AS LONG : numItems = 10000 ' Number of items for stress test
    DIM keysToDel() AS WSTRING

    X_AU "-- Tree Capacity Tests --"
    gTreTestCount = 0 : gTreFailCount = 0

    ' --- Test 1: Add Many Items ---
    X_AU "Capacity: Adding " & TRIM$(STR$(numItems)) & " items..."
    hTree = WsLnTreNew()
    TestResultTre("Capacity: AddMany - New", IIF(hTree <> 0, %TRUE, %FALSE))
    IF hTree = 0 THEN GOTO CapacityExit_Tre

    keyBase = "Key_"
    FOR i = 1 TO numItems
        key = keyBase & FORMAT$(i, "00000") ' Create unique keys
        WsLnTreSet hTree, key, i
        IF (i MOD 1000) = 0 AND WsLnTreCount(hTree) <> i THEN
             TestResultTre("Capacity: AddMany - Count mismatch at " & STR$(i), %FALSE)
              GOTO CapacityCleanup_Tre ' Stop test if count wrong
        END IF
    NEXT i
    TestResultTre("Capacity: AddMany - Final Count", IIF(WsLnTreCount(hTree) = numItems, %TRUE, %FALSE))

    ' --- Test 2: Get Many Items ---
    X_AU "Capacity: Getting " & TRIM$(STR$(numItems)) & " items..."
    FOR i = 1 TO numItems
        key = keyBase & FORMAT$(i, "00000")
        L02 = WsLnTreGet(hTree,key)
        IF L02 <> i THEN
             TestResultTre("Capacity: GetMany - Value mismatch for key " & key, %FALSE)
             ' Don't exit, allows seeing multiple errors
        END IF
    NEXT i
    TestResultTre("Capacity: GetMany - Finished Gets (Check log for fails)", %TRUE) ' Assume loop ok if no hard exit

    ' --- Test 3: Iterate Large Tree (Check First/Last/Count) ---
     X_AU "Capacity: Iterating " & TRIM$(STR$(numItems)) & " items..."
     LOCAL firstKey AS WSTRING, lastKey AS WSTRING, firstVal AS LONG, lastVal AS LONG, iterCount AS LONG
     hNode = WsLnTreFirst(hTree)
     IF hNode THEN firstKey = WsLnTreGetKey(hNode) : firstVal = WsLnTreGetVal(hNode) ELSE firstKey="" : firstVal = -1
     hNode = WsLnTreLast(hTree)
     IF hNode THEN lastKey = WsLnTreGetKey(hNode) : lastVal = WsLnTreGetVal(hNode) ELSE lastKey="" : lastVal = -1
     ' Expected keys depend on comparison - assumes standard string compare for Key_00001 vs Key_10000
     TestResultTre("Capacity: Iterate - First Key Check", IIF(firstKey = "Key_00001", %TRUE, %FALSE))
     TestResultTre("Capacity: Iterate - Last Key Check", IIF(lastKey = "Key_10000", %TRUE, %FALSE))
     iterCount = 0 : hNode = WsLnTreFirst(hTree)
     WHILE hNode
        INCR iterCount
        hNode = WsLnTreNext(hNode)
     WEND
     TestResultTre("Capacity: Iterate - Iteration Count", IIF(iterCount = numItems, %TRUE, %FALSE))


    ' --- Test 4: Delete Many Items ---
    X_AU "Capacity: Deleting ~half (" & TRIM$(STR$(numItems \ 2)) & ") items..."
    REDIM keysToDel(1 TO numItems \ 2)
    FOR i = 1 TO numItems STEP 2 ' Delete odd keys
        key = keyBase & FORMAT$(i, "00000")
        WsLnTreDel hTree, key
        IF (i MOD 1001)=0 AND WsLnTreGot(hTree,key)<>0 THEN ' Check occasionally
             TestResultTre("Capacity: DeleteMany - Failed delete for key " & key, %FALSE)
        END IF
    NEXT i
    L02 = numItems - (numItems \ 2) ' Expected remaining count
    TestResultTre("Capacity: DeleteMany - Final Count", IIF(WsLnTreCount(hTree) = L02, %TRUE, %FALSE))
    ' Verify a deleted key is gone and an existing key remains
    key = "Key_00001" : hNode = WsLnTreGot(hTree, key)
    TestResultTre("Capacity: DeleteMany - Check Deleted Key Gone", IIF(hNode = 0, %TRUE, %FALSE))
    key = "Key_00002" : hNode = WsLnTreGot(hTree, key)
    TestResultTre("Capacity: DeleteMany - Check Remaining Key Exists", IIF(hNode <> 0, %TRUE, %FALSE))

    ' --- Test 5: Clear Large Tree ---
    X_AU "Capacity: Clearing remaining items..."
    WsLnTreClear hTree
    TestResultTre("Capacity: ClearLarge Count", IIF(WsLnTreCount(hTree) = 0, %TRUE, %FALSE))
    hNode = WsLnTreFirst(hTree)
    TestResultTre("Capacity: ClearLarge First", IIF(hNode = 0, %TRUE, %FALSE))


CapacityCleanup_Tre:
     IF hTree <> 0 THEN hTree = WsLnTreFinal(hTree)
     TestResultTre("Capacity: Final Cleanup", IIF(hTree = 0, %TRUE, %FALSE))

CapacityExit_Tre:
    X_AU "Tree Capacity Tests Complete: " & TRIM$(FORMAT$(gTreTestCount-gTreFailCount)) & "/" & TRIM$(FORMAT$(gTreTestCount)) & " Passed."
    X_AU ""
END SUB

SUB TestTreClone()
    LOCAL hOrig AS LONG
    LOCAL hClone AS LONG
    LOCAL key AS WSTRING
    LOCAL VALO AS LONG, valC AS LONG
    LOCAL countO AS LONG, countC AS LONG

    X_AU "-- Tree Clone Tests --"
    gTreTestCount = 0 : gTreFailCount = 0

    hOrig = CreateSimpleTree(0) ' Case-sensitive
    TestResultTre("Clone: Create Original", IIF(hOrig <> 0, %TRUE, %FALSE))
    IF hOrig = 0 THEN EXIT SUB

    hClone = WsLnTreClone(hOrig)
    TestResultTre("Clone: WsLnTreClone called", IIF(hClone <> 0, %TRUE, %FALSE))
    IF hClone = 0 THEN hOrig = WsLnTreFinal(hOrig) : EXIT SUB

    ' Check counts
    countO = WsLnTreCount(hOrig)
    countC = WsLnTreCount(hClone)
    TestResultTre("Clone: Initial Counts Match", IIF(countO=countC AND countO=6, %TRUE, %FALSE))

    ' Check value retrieval matches
    key = "Mango"
    valO = WsLnTreGet(hOrig, key)
    valC = WsLnTreGet(hClone, key)
    TestResultTre("Clone: Initial Get Match", IIF(valO=valC AND valO=10, %TRUE, %FALSE))

    ' Modify original, check clone unchanged
    key = "Mango" : WsLnTreSet hOrig, key, 111
    valO = WsLnTreGet(hOrig, key)
    valC = WsLnTreGet(hClone, key) ' Get from clone *after* modifying original
    TestResultTre("Clone: Modify Original - Check Original", IIF(valO=111, %TRUE, %FALSE))
    TestResultTre("Clone: Modify Original - Check Clone Unchanged", IIF(valC=10, %TRUE, %FALSE))

    ' Modify clone, check original unchanged
    key = "Apple" : WsLnTreSet hClone, key, 222
    valO = WsLnTreGet(hOrig, key) ' Get from original *after* modifying clone
    valC = WsLnTreGet(hClone, key)
    TestResultTre("Clone: Modify Clone - Check Clone", IIF(valC=222, %TRUE, %FALSE))
    TestResultTre("Clone: Modify Clone - Check Original Unchanged", IIF(valO=20, %TRUE, %FALSE))

    ' Add to original only
    key = "Kiwi" : WsLnTreSet hOrig, key, 70
    TestResultTre("Clone: Add Original - Count Orig", IIF(WsLnTreCount(hOrig)=7, %TRUE, %FALSE))
    TestResultTre("Clone: Add Original - Count Clone", IIF(WsLnTreCount(hClone)=6, %TRUE, %FALSE))


CloneCleanup:
    hOrig = WsLnTreFinal(hOrig)
    hClone = WsLnTreFinal(hClone)
    TestResultTre("Clone: Cleanup Final", IIF(hOrig = 0 AND hClone = 0, %TRUE, %FALSE))
    X_AU "Tree Clone Tests Complete: " & TRIM$(FORMAT$(gTreTestCount-gTreFailCount)) & "/" & TRIM$(FORMAT$(gTreTestCount)) & " Passed."
    X_AU ""
END SUB

'########################################################################
' SUB: TestTreStoreRestore
'------------------------------------------------------------------------
' Purpose: Tests WsLnTreStore and WsLnTreRestore functions.
'########################################################################
SUB TestTreStoreRestore()
     LOCAL hOrig AS LONG
     LOCAL hRestore AS LONG
     LOCAL sStore AS STRING
     DIM expectedKeys(1 TO 6) AS WSTRING
     DIM expectedVals(1 TO 6) AS LONG

     X_AU "-- Tree Store/Restore Tests --"
     gTreTestCount = 0 : gTreFailCount = 0

     hOrig = CreateSimpleTree(0) ' Case-sensitive
     TestResultTre("StoreRestore: Create Original", IIF(hOrig <> 0, %TRUE, %FALSE))
     IF hOrig = 0 THEN EXIT SUB

     ' Store
     ERR = 0 ' Optional: Clear ERR before calling function that might set it
     sStore = WsLnTreStore(hOrig)
     TestResultTre("StoreRestore: Store executed (Len=" & STR$(LEN(sStore)) & ")", IIF(LEN(sStore)>0 AND ERR = 0, %TRUE, %FALSE)) ' Check ERR also

     ' Create new, restore into it
     hRestore = WsLnTreNew()
     TestResultTre("StoreRestore: New Restore Target", IIF(hRestore <> 0, %TRUE, %FALSE))
     IF hRestore = 0 THEN
         hOrig = WsLnTreFinal(hOrig)
         EXIT SUB
     END IF

     ERR = 0 ' Clear ERR before restore
     WsLnTreRestore hRestore, sStore
     ' *** CORRECTED LINE: Check ERR, not W_JSON_GetLastError ***
     TestResultTre("StoreRestore: Restore executed", IIF(ERR = 0, %TRUE, %FALSE)) ' Check HLib Error via ERR

     ' Verify restored tree (only if restore reported no error)
     IF ERR = 0 THEN
         TestResultTre("StoreRestore: Restored Count", IIF(WsLnTreCount(hRestore) = 6, %TRUE, %FALSE))
         expectedKeys(1) = "Apple"   : expectedVals(1) = 20
         expectedKeys(2) = "Banana"  : expectedVals(2) = 40
         expectedKeys(3) = "Grape"   : expectedVals(3) = 60
         expectedKeys(4) = "Mango"   : expectedVals(4) = 10
         expectedKeys(5) = "Orange"  : expectedVals(5) = 30
         expectedKeys(6) = "Peach"   : expectedVals(6) = 50
         TestResultTre("StoreRestore: Verify Restored Order", VerifyTreeOrder(hRestore, expectedKeys(), expectedVals(), %FALSE))
     ELSE
         X_AU "StoreRestore: Skipping verification due to restore error (ERR=" & STR$(ERR) & ")"
         INCR gTreFailCount ' Count verification as failed if restore failed
         INCR gTreTestCount ' Account for the skipped verification test
     END IF


     ' Restore into original after clearing
     WsLnTreClear hOrig
     TestResultTre("StoreRestore: Clear Original Count", IIF(WsLnTreCount(hOrig)=0, %TRUE, %FALSE))

     ERR = 0 ' Clear ERR before restore
     WsLnTreRestore hOrig, sStore
     ' *** CORRECTED LINE: Check ERR, not W_JSON_GetLastError ***
     TestResultTre("StoreRestore: Restore into Original executed", IIF(ERR = 0, %TRUE, %FALSE))

     IF ERR = 0 THEN
         TestResultTre("StoreRestore: Restore into Original Count", IIF(WsLnTreCount(hOrig) = 6, %TRUE, %FALSE))
         TestResultTre("StoreRestore: Verify Restore into Original Order", VerifyTreeOrder(hOrig, expectedKeys(), expectedVals(), %FALSE))
     ELSE
         X_AU "StoreRestore: Skipping verification due to restore error (ERR=" & STR$(ERR) & ")"
         INCR gTreFailCount ' Count verification as failed if restore failed
         gTreTestCount+=2 ' Account for the two skipped verification tests
     END IF

StoreRestoreCleanup_TSR: ' Renamed Label
    hOrig = WsLnTreFinal(hOrig)
    hRestore = WsLnTreFinal(hRestore)
    TestResultTre("StoreRestore: Cleanup Final", IIF(hOrig = 0 AND hRestore = 0, %TRUE, %FALSE))
    X_AU "Tree Store/Restore Tests Complete: " & TRIM$(FORMAT$(gTreTestCount-gTreFailCount)) & "/" & TRIM$(FORMAT$(gTreTestCount)) & " Passed."
    X_AU ""
END SUB

' --- Main Program ---
FUNCTION PBMAIN()

    X_AU "Starting WsLnTre Container Test Suite..." ' Use X_AU
    X_AU "=====================================" ' Use X_AU

    IF %DoTreLifeCycleTests = 1 THEN TestTreLifecycle()
    IF %DoTreSetGetGotTests = 1 THEN TestTreSetGetGot()
    IF %DoTreIterationTests = 1 THEN TestTreIteration()
    IF %DoTreDeleteTests = 1 THEN TestTreDelete()
    IF %DoTreComparisonTests = 1 THEN TestTreComparison()
    IF %DoTreCapacityTests = 1 THEN TestTreCapacity()
    IF %DoTreCloneTests = 1 THEN TestTreClone()
    IF %DoTreStoreRestoreTests = 1 THEN TestTreStoreRestore()

    X_AU "=====================================" ' Use X_AU
    X_AU "Test Suite Finished." ' Use X_AU
     ?"!"
END FUNCTION