tcl/tests/mutex.test

# 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

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 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 $enqTimeouts $deqTotal $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