Commit | Line | Data |
---|---|---|
fa920fb1 | 1 | # File : begin |
2 | if { [array get Draw_Groups "TOPOLOGY Check commands"] == "" } { | |
3 | pload TOPTEST | |
4 | pload VISUALIZATION | |
5 | # set env(CSF_DrawPluginQADefaults) $env(CASROOT)/src/DrawResources/. | |
6 | # pload QAcommands | |
7 | # pload -DrawPluginQA QAcommands | |
8 | } | |
9 | ||
10 | # to prevent loops limit to 16 minutes | |
11 | cpulimit 1000 | |
12 | ||
13 | #set script_dir [file dirname [info script]]/script | |
14 | # if { [info exist WorkDirectory] == 0 } { | |
15 | # set WorkDirectory "/tmp" | |
16 | # if { [array get env TEMP] != "" } { | |
17 | # set WorkDirectory "$env(TEMP)" | |
18 | # } | |
19 | # } | |
20 | ||
21 | if { [info exists imagedir] == 0 } { | |
22 | set imagedir . | |
23 | } | |
24 | if { [info exists test_image] == 0 } { | |
25 | set test_image photo | |
26 | } | |
27 | ||
c2f5c748 | 28 | # Procedure to check equality of two reals with tolerance (relative and absolute) |
29 | proc checkreal {name value expected tol_abs tol_rel} { | |
30 | if { abs ($value - $expected) > $tol_abs + $tol_rel * abs ($expected) } { | |
31 | puts "Error: $name = $value is not equal to expected $expected" | |
32 | } else { | |
33 | puts "Check of $name OK: value = $value, expected = $expected" | |
34 | } | |
35 | return | |
36 | } | |
37 | ||
deb26df7 RL |
38 | # Procedure to check if sequence of values in listval follows linear trend |
39 | # adding the same delta on each step. | |
40 | # | |
41 | # The function does statistical estimation of the mean variation of the | |
42 | # values of the sequence, and dispersion, and returns true only if both | |
43 | # dispersion and deviation of the mean from expected delta are within | |
44 | # specified tolerance. | |
45 | # | |
46 | # If mean variation differs from expected delta on more than two dispersions, | |
47 | # the check fails and procedure raises error with specified message. | |
48 | # | |
49 | # Otherwise the procedure returns false meaning that more iterations are needed. | |
50 | # Note that false is returned in any case if length of listval is less than 3. | |
51 | # | |
52 | # See example of use to check memory leaks in bugs/caf/bug23489 | |
53 | # | |
54 | proc checktrend {listval delta tolerance message} { | |
55 | set nbval [llength $listval] | |
56 | if { $nbval < 3} { | |
57 | return 0 | |
58 | } | |
fa920fb1 | 59 | |
deb26df7 RL |
60 | # calculate mean value |
61 | set mean 0. | |
62 | set prev [lindex $listval 0] | |
63 | foreach val [lrange $listval 1 end] { | |
64 | set mean [expr $mean + ($val - $prev)] | |
65 | set prev $val | |
66 | } | |
67 | set mean [expr $mean / $nbval] | |
fa920fb1 | 68 | |
deb26df7 RL |
69 | # calculate dispersion |
70 | set sigma 0. | |
71 | set prev [lindex $listval 0] | |
72 | foreach val [lrange $listval 1 end] { | |
73 | set d [expr ($val - $prev) - $mean] | |
74 | set sigma [expr $sigma + $d * $d] | |
75 | set prev $val | |
76 | } | |
77 | set sigma [expr sqrt ($sigma / ($nbval - 1))] | |
fa920fb1 | 78 | |
deb26df7 RL |
79 | puts "Checking trend: nb = $nbval, mean delta = $mean, sigma = $sigma" |
80 | ||
81 | # check if deviation is definitely too big | |
82 | if { abs ($mean - $delta) > 2. * $sigma } { | |
83 | puts "Checking trend failed: mean delta per step = $mean, sigma = $sigma, expected delta = $delta" | |
84 | error $message | |
85 | } | |
86 | ||
87 | # check if deviation is clearly within a range | |
88 | return [expr abs ($mean - $delta) <= $sigma && $sigma <= $tolerance] | |
89 | } |