fa920fb1 |
1 | # File : begin |
5ae01c85 |
2 | |
fa920fb1 |
3 | if { [array get Draw_Groups "TOPOLOGY Check commands"] == "" } { |
4 | pload TOPTEST |
5 | pload VISUALIZATION |
fa920fb1 |
6 | } |
7 | |
8 | # to prevent loops limit to 16 minutes |
9 | cpulimit 1000 |
10 | |
7856b126 |
11 | set rel_tol 0 |
12 | set max_rel_tol_diff 0 |
13 | |
9753e6de |
14 | # On Windows with VC, in typical configuration gl2ps is built with Release |
15 | # mode only which will fail in Debug mode; add TODO for that case in order |
16 | # to handle it once for all tests that can use vexport command |
17 | if { [regexp {Debug mode} [dversion]] } { |
18 | puts "TODO ?#23540 windows: Error: export of image.*failed" |
19 | puts "TODO ?#23540 windows: Error: The file has been exported.*different size \[(\]0 " |
20 | } |
fa920fb1 |
21 | |
22 | if { [info exists imagedir] == 0 } { |
23 | set imagedir . |
24 | } |
25 | if { [info exists test_image] == 0 } { |
26 | set test_image photo |
27 | } |
28 | |
91322f44 |
29 | # Procedure to check equality of two reals with tolerance (relative and absolute) |
30 | help checkarea {shape area_expected tol_abs tol_rel} |
31 | proc checkarea {shape area_expected tol_abs tol_rel} { |
32 | # compute area with half of the relative tolerance |
33 | # to be used in comparison; 0.001 is added to avoid zero value |
34 | set prop [uplevel sprops $shape [expr 0.5 * abs($tol_rel) + 0.001]] |
35 | |
36 | # get te value |
37 | if { ! [regexp {Mass\s*:\s*([0-9.e+-]+)} $prop res area] } { |
38 | puts "Error: cannot get area of the shape $shape" |
39 | return |
40 | } |
f1aa2b62 |
41 | |
91322f44 |
42 | # compare with expected value |
43 | checkreal "area of $shape" $area $area_expected $tol_abs $tol_rel |
44 | } |
f1aa2b62 |
45 | |
74f764ba |
46 | # Check if area of triangles is valid |
47 | proc CheckTriArea {shape {eps 0}} { |
48 | upvar #0 $shape result |
49 | set area [triarea result $eps] |
50 | set t_area [lindex $area 0] |
51 | set g_area [expr abs([lindex $area 1])] |
52 | puts "area by triangles: $t_area" |
53 | puts "area by geometry: $g_area" |
54 | expr ($t_area - $g_area) / $g_area * 100 |
55 | } |
02effd35 |
56 | |
74da0216 |
57 | # Check expected time |
58 | proc checktime {value expected tol_rel message} { |
59 | set t1 [expr ${value} - ${expected}] |
60 | set t2 [expr ${expected} * abs (${tol_rel})] |
61 | |
62 | if { abs (${t1}) <= ${t2} } { |
63 | puts "OK. ${message}, ${value} seconds, is equal to expected time - ${expected} seconds" |
64 | } elseif {${t1} > ${t2}} { |
65 | puts "Error. ${message}, ${value} seconds, is more than expected time - ${expected} seconds" |
66 | } else { |
67 | puts "Improvement. ${message}, ${value} seconds, is less than expected time - ${expected} seconds" |
68 | } |
69 | } |