File: mut001.tcl

package info (click to toggle)
db5.3 5.3.28%2Bdfsg2-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 158,500 kB
  • sloc: ansic: 448,411; java: 111,824; tcl: 80,544; sh: 44,264; cs: 33,697; cpp: 21,604; perl: 14,557; xml: 10,799; makefile: 4,077; javascript: 1,998; yacc: 1,003; awk: 965; sql: 801; erlang: 342; python: 216; php: 24; asm: 14
file content (111 lines) | stat: -rw-r--r-- 3,821 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
# See the file LICENSE for redistribution information.
#
# Copyright (c) 2009, 2013 Oracle and/or its affiliates.  All rights reserved.
#
# $Id$
#
#
# TEST	mut001
# TEST	Exercise the mutex API.
# TEST
# TEST	Allocate, lock, unlock, and free a bunch of mutexes. 
# TEST	Set basic configuration options and check mutex_stat and 
# TEST	the mutex getters for the correct values. 

proc mut001 { } {
	source ./include.tcl
	env_cleanup $testdir

	puts "Mut001: Basic mutex interface testing."

	# Open an env.
	set env [berkdb_env -create -home $testdir -private -mutex_set_incr 100]
	
	# Allocate, lock, unlock, and free a bunch of mutexes.
	set nmutexes 100
	puts "\tMut001.a: Allocate a bunch of mutexes."
	for { set i 0 } { $i < $nmutexes } { incr i } {
		set mutexid($i) [$env mutex]
	}
	puts "\tMut001.b: Lock the mutexes."
	for { set i 0 } { $i < $nmutexes } { incr i } { 
		error_check_good mutex_lock [$env mutex_lock $mutexid($i)] 0
	}
	puts "\tMut001.c: Unlock the mutexes."
	for { set i 0 } { $i < $nmutexes } { incr i } { 
		error_check_good mutex_unlock [$env mutex_unlock $mutexid($i)] 0
	}
	puts "\tMut001.d: Free the mutexes."
	for { set i 0 } { $i < $nmutexes } { incr i } { 
		error_check_good mutex_free [$env mutex_free $mutexid($i)] 0
	}

	# Clean up the env.  We'll need new envs to test the configuration
	# options, because they cannot be set after the env is open.
	error_check_good env_close [$env close] 0	
	env_cleanup $testdir

	puts "\tMut001.e: Set the mutex alignment."
	set mutex_align 8
	set env [berkdb_env -create -home $testdir -mutex_set_align $mutex_align]

	set stat_align [stat_field $env mutex_stat "Mutex align"]
	set get_align [$env mutex_get_align]
	error_check_good stat_align $stat_align $mutex_align
	error_check_good get_align $get_align $mutex_align

	# Find the number of mutexes allocated by default.  We'll need
	# this later, when we try the "mutex_set_increment" option.
	set default_count [stat_field $env mutex_stat "Mutex count"]

	error_check_good env_close [$env close] 0	
	env_cleanup $testdir

	puts "\tMut001.f: Set the maximum number of mutexes."
	set mutex_count 2000
	set env [berkdb_env -create -home $testdir -mutex_set_max $mutex_count]

	set stat_count [stat_field $env mutex_stat "Mutex max"]
	set get_count [$env mutex_get_max]
	error_check_good stat_count $stat_count $mutex_count
	error_check_good get_count $get_count $mutex_count

	error_check_good env_close [$env close] 0	
	env_cleanup $testdir

	puts "\tMut001.g: Raise the maximum number of mutexes."
	set mutex_incr 500
	set mutex_count [expr $default_count + $mutex_incr]

	set env [berkdb_env -create -home $testdir \
	    -mutex_set_max $default_count -mutex_set_incr $mutex_incr]

	set stat_count [stat_field $env mutex_stat "Mutex max"]
	error_check_good stat_increment $stat_count $mutex_count 
	set get_count [$env mutex_get_max]
	error_check_good get_increment $get_count $mutex_count

	error_check_good env_close [$env close] 0	
	env_cleanup $testdir

	puts "\tMut001.h: Set and reset the number of TAS mutex spins."
	set mutex_tas_spins 50

	set env [berkdb_env -create -home $testdir -mutex_set_tas_spins $mutex_tas_spins] 
	set stat_spins [stat_field $env mutex_stat "Mutex TAS spins"]
	error_check_good stat_spins $stat_spins $mutex_tas_spins
	set get_spins [$env mutex_get_tas_spins]
	error_check_good get_spins $get_spins $mutex_tas_spins
	
	# TAS spins can be reset any time. 
	set mutex_tas_spins 1
	error_check_good reset_spins [$env mutex_set_tas_spins $mutex_tas_spins] 0
	set stat_spins [stat_field $env mutex_stat "Mutex TAS spins"]
	error_check_good stat_spins_reset $stat_spins $mutex_tas_spins
	set get_spins [$env mutex_get_tas_spins]
	error_check_good get_spins_reset $get_spins $mutex_tas_spins
	
	error_check_good env_close [$env close] 0	
	env_cleanup $testdir
}