1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: memp002.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7 8# TEST memp002 9# TEST Tests multiple processes accessing and modifying the same files. 10proc memp002 { } { 11 # 12 # Multiple processes not supported by private memory so don't 13 # run memp002_body with -private. 14 # 15 memp002_body "" 16 memp002_body "-system_mem -shm_key 1" 17} 18 19proc memp002_body { flags } { 20 source ./include.tcl 21 22 puts "Memp002: {$flags} Multiprocess mpool tester" 23 24 set procs 4 25 set psizes "512 1024 2048 4096 8192" 26 set iterations 500 27 set npages 100 28 29 # Check if this combination of flags is supported by this arch. 30 if { [mem_chk $flags] == 1 } { 31 return 32 } 33 34 set iter [expr $iterations / $procs] 35 36 # Clean up old stuff and create new. 37 env_cleanup $testdir 38 39 for { set i 0 } { $i < [llength $psizes] } { incr i } { 40 fileremove -f $testdir/file$i 41 } 42 set e [eval {berkdb_env -create -lock -home $testdir} $flags] 43 error_check_good dbenv [is_valid_env $e] TRUE 44 45 set pidlist {} 46 for { set i 0 } { $i < $procs } {incr i} { 47 48 puts "$tclsh_path\ 49 $test_path/mpoolscript.tcl $testdir $i $procs \ 50 $iter $psizes $npages 3 $flags > \ 51 $testdir/memp002.$i.out &" 52 set p [exec $tclsh_path $test_path/wrap.tcl \ 53 mpoolscript.tcl $testdir/memp002.$i.out $testdir $i $procs \ 54 $iter $psizes $npages 3 $flags &] 55 lappend pidlist $p 56 } 57 puts "Memp002: $procs independent processes now running" 58 watch_procs $pidlist 59 60 reset_env $e 61} 62