|
1 # |
|
2 # Testing scripts etc used for running in the simulator |
|
3 # |
|
4 |
|
5 source "$base_test_dir/../test-utils/import.tcl" |
|
6 set import::path [list \ |
|
7 $base_test_dir/../test-utils \ |
|
8 $base_test_dir/../oasys/tclcmd \ |
|
9 $base_test_dir/test-utils \ |
|
10 $base_test_dir/test/nets \ |
|
11 ] |
|
12 |
|
13 import "tcl-utils.tcl" |
|
14 import "dtn-test-lib.tcl" |
|
15 |
|
16 # Override the tell_dtnd proc |
|
17 namespace eval dtn { |
|
18 proc tell_dtnd { id args } { |
|
19 if {$id == "*"} { |
|
20 foreach node [sim nodes] { |
|
21 tell_dtnd $node $args |
|
22 } |
|
23 return |
|
24 } |
|
25 if {[llength $args] == 1} { |
|
26 set cmd [lindex $args 0] |
|
27 } else { |
|
28 set cmd $args |
|
29 } |
|
30 eval [concat $id $cmd] |
|
31 } |
|
32 } |
|
33 |
|
34 # Override the net::nodelist proc |
|
35 namespace eval net { |
|
36 proc nodelist {} { |
|
37 return [sim nodes] |
|
38 } |
|
39 } |
|
40 |
|
41 proc parse_opts {{defaults ""}} { |
|
42 global opt opts |
|
43 |
|
44 if {! [info exists opt(verbose)]} { |
|
45 set opt(verbose) false |
|
46 } |
|
47 |
|
48 if {! [info exists opt(runtill)]} { |
|
49 set opt(runtill) [expr 365 * 24 * 60 * 60]; # 1 year |
|
50 } |
|
51 |
|
52 foreach {var val} $defaults { |
|
53 set opt($var) $val |
|
54 } |
|
55 |
|
56 foreach o $opts { |
|
57 set L [split $o =] |
|
58 set var [lindex $L 0] |
|
59 set val 1 |
|
60 if {[llength $L] == 2} { |
|
61 set val [lindex $L 1] |
|
62 } |
|
63 |
|
64 set opt($var) $val |
|
65 } |
|
66 |
|
67 sim set runtill $opt(runtill) |
|
68 } |
|
69 |
|
70 proc dputs {args} { |
|
71 global opt |
|
72 if {$opt(verbose)} { |
|
73 eval puts $args |
|
74 } |
|
75 } |
|
76 |
|
77 proc enable_progress_counter {} { |
|
78 global opt |
|
79 |
|
80 puts -nonewline stderr " 0% done" |
|
81 for {set i 0} {$i < 100} {incr i 5} { |
|
82 sim at [expr $opt(runtill) * $i / 100.0] \ |
|
83 puts -nonewline stderr [format "\b\b\b\b\b\b\b\b%2d%% done" $i] |
|
84 } |
|
85 } |