# Commands covered:  (test)mutex
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2025 Ashok P. Nadkarni
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

source [file join [file dirname [info script]] tcltests.tcl]

::tcltest::loadTestedCommands
package require -exact tcl::test [info patchlevel]

testConstraint testmutex [expr {[info commands testmutex] ne {}}]

namespace eval testmutex {
    namespace import ::tcltest::test

    proc testlock {id nthreads recursion iters yield} {
        test $id "mutex lock $nthreads/$recursion/$iters/$yield" \
            -constraints testmutex \
            -body "testmutex lock $nthreads $recursion $iters $yield" \
            -result [expr {$nthreads*$iters}]
    }
    #                   threads recursions iterations yield
    testlock mutex-lock-1   2     1          1000000    0
    testlock mutex-lock-2   2     1          1000000    1
    testlock mutex-lock-3  10     1           200000    0
    testlock mutex-lock-4  10     1           200000    1
    testlock mutex-lock-5   4     5           400000    0
    testlock mutex-lock-6   4     5           400000    1

    proc fairness {totalOps perThreadOps} {
        set errors {}
        set threadTotal [tcl::mathop::+ {*}$perThreadOps]
        if {$threadTotal ne $totalOps} {
            append errors "Thread total $threadTotal != expected $totalOps\n"
        }
        # Each thread should get at least half of fair share
        set fairShare [expr {$totalOps / [llength $perThreadOps]}]
        foreach share $perThreadOps {
            if {$fairShare > 2*$share} {
                append errors "Thread share $share < 0.5 fair share $fairShare"
            }
        }
        return $errors
    }
    proc testcondition {id nthreads recursion iters yield} {
        set totalOps [expr {$nthreads*$iters}]
        test $id "mutex condition $nthreads/$recursion/$iters/$yield" \
            -constraints testmutex \
            -body {
                lassign \
                    [testmutex condition $nthreads $recursion $iters $yield] \
                    enqTotal enqPerThread enqTimeouts \
                    deqTotal deqPerThread deqTimeouts
                list \
                    $enqTotal [fairness $totalOps $enqPerThread] $enqTimeouts \
                    $deqTotal [fairness $totalOps $deqPerThread] $deqTimeouts
            } -result [list $totalOps {} 0 $totalOps {} 0]
    }
    testcondition mutex-condition-1   2     1          100000    0
    testcondition mutex-condition-2   2     1          100000    1
    testcondition mutex-condition-3  10     1           20000    0
    testcondition mutex-condition-4  10     1           20000    1
    testcondition mutex-condition-5   4     5           40000    0
    testcondition mutex-condition-6   4     5           40000    1

}

# cleanup
::tcltest::cleanupTests
return