set test_image photo
}
+# Procedure to check if sequence of values in listval follows linear trend
+# adding the same delta on each step.
+#
+# The function does statistical estimation of the mean variation of the
+# values of the sequence, and dispersion, and returns true only if both
+# dispersion and deviation of the mean from expected delta are within
+# specified tolerance.
+#
+# If mean variation differs from expected delta on more than two dispersions,
+# the check fails and procedure raises error with specified message.
+#
+# Otherwise the procedure returns false meaning that more iterations are needed.
+# Note that false is returned in any case if length of listval is less than 3.
+#
+# See example of use to check memory leaks in bugs/caf/bug23489
+#
+proc checktrend {listval delta tolerance message} {
+ set nbval [llength $listval]
+ if { $nbval < 3} {
+ return 0
+ }
+ # calculate mean value
+ set mean 0.
+ set prev [lindex $listval 0]
+ foreach val [lrange $listval 1 end] {
+ set mean [expr $mean + ($val - $prev)]
+ set prev $val
+ }
+ set mean [expr $mean / $nbval]
+ # calculate dispersion
+ set sigma 0.
+ set prev [lindex $listval 0]
+ foreach val [lrange $listval 1 end] {
+ set d [expr ($val - $prev) - $mean]
+ set sigma [expr $sigma + $d * $d]
+ set prev $val
+ }
+ set sigma [expr sqrt ($sigma / ($nbval - 1))]
+ puts "Checking trend: nb = $nbval, mean delta = $mean, sigma = $sigma"
+
+ # check if deviation is definitely too big
+ if { abs ($mean - $delta) > 2. * $sigma } {
+ puts "Checking trend failed: mean delta per step = $mean, sigma = $sigma, expected delta = $delta"
+ error $message
+ }
+
+ # check if deviation is clearly within a range
+ return [expr abs ($mean - $delta) <= $sigma && $sigma <= $tolerance]
+}
--- /dev/null
+# Test for #23489: memory leak in TNaming_NamedShape destructor
+
+pload OCAF
+
+set listmem {}
+for {set i 1} {$i < 10} {incr i} {
+ # load big shape
+ restore [locate_data_file bug23489_Bottom.brep] a
+
+ # add shape to new OCAF document
+ NewDocument D MDTV-Standard
+
+ # add shape to document
+ SetShape D 0:1 a
+
+ # Note: if ForgetAll or Undo is called here, memory is correctly freed!
+ # ForgetAll D 0:1
+
+ # close document
+ Close D
+ unset D
+
+ # unload shape (replace by small one)
+ vertex a 0 0 0
+
+ # check memory usage (with tolerance equal to half page size)
+ lappend listmem [expr [meminfo w] / 1024]
+ if { [checktrend $listmem 0 256 "Memory leak detected"] } {
+ puts "No memory leak, $i iterations"
+ break
+ }
+}