0025344: Draw variables do not follow the scope of TCL level

Use NCollection_Map instead of instantiation of TCollection_Map

Test-cases for issue #25344

Correct error in test script: the shape variable assigned by the command 'restore' must not be referred by '$'.

diff --git a/src/Draw/Draw_VariableCommands.cxx b/src/Draw/Draw_VariableCommands.cxx
index be7f061d01206f52e771d0e37bbd109083b7dd07..2f93b05cc30ca2a1d153e19ba72a06c10cd34fd6 100644 (file)
--- a/src/Draw/Draw_VariableCommands.cxx
+++ b/src/Draw/Draw_VariableCommands.cxx
@@ -29,7 +29,7 @@
 #include <Draw_SequenceOfDrawable3D.hxx>
 #include <Draw_ProgressIndicator.hxx>
 
-#include <NCollection_DataMap.hxx>
+#include <NCollection_Map.hxx>
 
 #include <ios>
 
@@ -55,7 +55,7 @@ extern Draw_Interpretor theCommands;
 // The Integer Value is the content of the TCl variable 
 //===============================================
 
-static NCollection_DataMap<TCollection_AsciiString,Handle(Draw_Drawable3D)> theVariables;
+static NCollection_Map<Handle(Draw_Drawable3D)> theVariables;
 
 //=======================================================================
 //function : FindVariable
@@ -305,9 +305,9 @@ static Standard_Integer erase(Draw_Interpretor& di, Standard_Integer n, const ch
     
     // sauvegarde des proteges visibles
     Draw_SequenceOfDrawable3D prot;
-    NCollection_DataMap<TCollection_AsciiString,Handle(Draw_Drawable3D)>::Iterator aMapIt (theVariables);
+    NCollection_Map<Handle(Draw_Drawable3D)>::Iterator aMapIt (theVariables);
     for (; aMapIt.More(); aMapIt.Next()) {
-      const Handle(Draw_Drawable3D)& D = aMapIt.Value();
+      const Handle(Draw_Drawable3D)& D = aMapIt.Key();
       if (!D.IsNull()) {
        if (D->Protected() && D->Visible())
          prot.Append(D);
@@ -719,30 +719,32 @@ void Draw::Set(const Standard_CString name,
 }
 
 // MKV 29.03.05
-static char* tracevar(ClientData, Tcl_Interp*,const char* name,const char*, Standard_Integer)
+static char* tracevar(ClientData CD, Tcl_Interp*,const char* name,const char*, int)
 {
   // protect if the map was destroyed before the interpretor
   if (theVariables.IsEmpty()) return NULL;
-  // MKV 29.03.05
-  Handle(Draw_Drawable3D)& D = theVariables(name);
+
+  // MSV 9.10.14 CR25344
+  Handle(Draw_Drawable3D) D(reinterpret_cast<Draw_Drawable3D*>(CD));
   if (D.IsNull()) {
-    theVariables.UnBind(name);
+    Tcl_UntraceVar(theCommands.Interp(),name,TCL_TRACE_UNSETS | TCL_TRACE_WRITES,
+                   tracevar,CD);
     return NULL;
   }
   if (D->Protected()) {
     D->Name(Tcl_SetVar(theCommands.Interp(),name,name,0));
     return (char*) "variable is protected";
   } else {
-    Tcl_UntraceVar(theCommands.Interp(),name,TCL_TRACE_UNSETS | TCL_TRACE_WRITES,tracevar,NULL);
     if (D->Visible()) {
       dout.RemoveDrawable(D);
       if (D->Is3D()) 
-       repaint3d = Standard_True;
+          repaint3d = Standard_True;
       else
-       repaint2d = Standard_True;
+          repaint2d = Standard_True;
     }
-    D.Nullify();
-    theVariables.UnBind(name);
+    Tcl_UntraceVar(theCommands.Interp(),name,TCL_TRACE_UNSETS | TCL_TRACE_WRITES,
+                   tracevar,CD);
+    theVariables.Remove(D);
     return NULL;
   }
 }
@@ -752,8 +754,8 @@ static char* tracevar(ClientData, Tcl_Interp*,const char* name,const char*, Stan
 //purpose  : 
 //=======================================================================
 void Draw::Set(const Standard_CString name, 
-              const Handle(Draw_Drawable3D)& D,
-              const Standard_Boolean displ)
+               const Handle(Draw_Drawable3D)& D,
+               const Standard_Boolean displ)
 {
   if ((name[0] == '.') && (name[1] == '\0')) {
     if (!D.IsNull()) {
@@ -762,27 +764,34 @@ void Draw::Set(const Standard_CString name,
     }
   }
   else {
-    if (theVariables.IsBound(name)) {
-      if (theVariables(name)->Protected()) {
+    // Check if the variable with the same name exists
+    ClientData aCD =
+      Tcl_VarTraceInfo(theCommands.Interp(),name,TCL_TRACE_UNSETS | TCL_TRACE_WRITES,
+                       tracevar, NULL);
+    Handle(Draw_Drawable3D) anOldD(reinterpret_cast<Draw_Drawable3D*>(aCD));
+    if (!anOldD.IsNull()) {
+      if (theVariables.Contains(anOldD) && anOldD->Protected()) {
         cout << "variable is protected" << endl;
         return;
       }
+      anOldD.Nullify();
     }
+
+    Tcl_UnsetVar(theCommands.Interp(),name,0);
+
     if (!D.IsNull()) {
-      Tcl_UnsetVar(theCommands.Interp(),name,0);
-      theVariables.Bind(name,D);
-      // MKV 29.03.05
+      theVariables.Add(D);
       D->Name(Tcl_SetVar(theCommands.Interp(),name,name,0));
+    
       // set the trace function
-      Tcl_TraceVar(theCommands.Interp(),name,TCL_TRACE_UNSETS | TCL_TRACE_WRITES,tracevar,NULL);
+      Tcl_TraceVar(theCommands.Interp(),name,TCL_TRACE_UNSETS | TCL_TRACE_WRITES,
+                   tracevar,reinterpret_cast<ClientData>(D.operator->()));
       if (displ) {
-       if (!D->Visible())
-         dout << D;
+        if (!D->Visible())
+          dout << D;
       }
       else if (D->Visible())
-       dout.RemoveDrawable(D);
-    } else {
-      Tcl_UnsetVar(theCommands.Interp(),name,0);
+        dout.RemoveDrawable(D);
     }
   }
 }
@@ -827,8 +836,12 @@ Handle(Draw_Drawable3D) Draw::Get(Standard_CString& name,
     }
   }
   else {
-    // MKV 29.03.05
-    theVariables.Find(name,D);
+    ClientData aCD =
+      Tcl_VarTraceInfo(theCommands.Interp(),name,TCL_TRACE_UNSETS | TCL_TRACE_WRITES,
+                       tracevar, NULL);
+    D = reinterpret_cast<Draw_Drawable3D*>(aCD);
+    if (!theVariables.Contains(D))
+      D.Nullify();
 #if 0
     if (D.IsNull() && complain)
       cout <<name<<" does not exist"<<endl;

diff --git a/src/DrawResources/StandardCommands.tcl b/src/DrawResources/StandardCommands.tcl
index a56b9d3e9ab080e5d1771b905af277f1faba3d61..737cdc3cb5ceb69db356a22debbe9208388574b1 100644 (file)
--- a/src/DrawResources/StandardCommands.tcl
+++ b/src/DrawResources/StandardCommands.tcl
@@ -275,9 +275,10 @@ help datadir {datadir [directory]} "DRAW Variables management"
 
 proc save {name {file ""}} {
     if {$file == ""} {set file $name}
-    if {![isdraw $name]} {error "save : $name is not a Draw variable"}
+    upvar $name n
+    if {![isdraw n]} {error "save : $name is not a Draw variable"}
     global Draw_DataDir
-    bsave $name [file join $Draw_DataDir $file]
+    bsave n [file join $Draw_DataDir $file]
     return [file join $Draw_DataDir $file]
 }
 
@@ -289,7 +290,8 @@ proc restore {file {name ""}} {
         set name [file rootname [file tail $file]]
     }
     global Draw_DataDir
-    uplevel #0 "brestore [file join $Draw_DataDir $file ] $name"
+    upvar $name n
+    brestore [file join $Draw_DataDir $file ] n
     return $name
 }
 

diff --git a/tests/bugs/demo/bug25344_1 b/tests/bugs/demo/bug25344_1
new file mode 100644 (file)
index 0000000..18962c4
--- /dev/null
+++ b/tests/bugs/demo/bug25344_1
@@ -0,0 +1,22 @@
+puts "========"
+puts "OCC25344"
+puts "========"
+puts ""
+#######################################################
+# Draw variables do not follow the scope of TCL level
+#######################################################
+
+proc setproc {} {
+  dset local_var 1.1
+  puts "in setproc scope: local_var=[dval local_var]"
+}
+
+setproc
+puts "in global scope: local_var=[dval local_var]"
+
+if {[dval local_var] != 0} {
+  puts "ERROR: local_var is set, but must not"
+  if {[lsearch [directory] local_var] == -1} {
+    puts "ERROR: as it is absent among TCL variables"
+  }
+}

diff --git a/tests/bugs/demo/bug25344_2 b/tests/bugs/demo/bug25344_2
new file mode 100644 (file)
index 0000000..e820a9e
--- /dev/null
+++ b/tests/bugs/demo/bug25344_2
@@ -0,0 +1,27 @@
+puts "========"
+puts "OCC25344"
+puts "========"
+puts ""
+#######################################################
+# Draw variables do not follow the scope of TCL level
+#######################################################
+
+proc setproc {var val} {
+  upvar $var local_var
+  dset local_var $val
+}
+
+setproc a 1.1
+
+puts "dval a = [dval a]"
+puts "dval local_var = [dval local_var]"
+
+if {[dval a] == 0} {
+  puts "ERROR: value is not set"
+}
+if {[dval local_var] == -1} {
+  puts "ERROR: local_var is set, but must not"
+  if {[lsearch [directory] local_var] == -1} {
+    puts "ERROR: as it is absent among TCL variables"
+  }
+}

diff --git a/tests/bugs/demo/bug25344_3 b/tests/bugs/demo/bug25344_3
new file mode 100644 (file)
index 0000000..967d3e2
--- /dev/null
+++ b/tests/bugs/demo/bug25344_3
@@ -0,0 +1,32 @@
+puts "========"
+puts "OCC25344"
+puts "========"
+puts ""
+#######################################################
+# Draw variables do not follow the scope of TCL level
+#######################################################
+
+proc boxproc {shape} {
+  upvar $shape local_shape
+  box local_shape 1 1 1
+}
+
+boxproc mybox
+
+if {[dtyp mybox] == ""} {
+  puts "ERROR: box mybox is not created"
+} else {
+  puts "SUCCESS: mybox is created"
+  if {[lsearch [directory] mybox] == -1} {
+    puts "ERRROR: but it is absent among TCL variables"
+  } else {
+    puts "SUCCESS: and it is present among TCL variables"
+  }
+}
+
+if {[dtyp local_shape] != ""} {
+  puts "Box local_shape is created"
+  if {[lsearch [directory] local_shape] == -1} {
+    puts "ERROR: but it is absent among TCL variables"
+  }
+}

diff --git a/tests/bugs/demo/bug25344_4 b/tests/bugs/demo/bug25344_4
new file mode 100644 (file)
index 0000000..a3c9f3f
--- /dev/null
+++ b/tests/bugs/demo/bug25344_4
@@ -0,0 +1,28 @@
+puts "========"
+puts "OCC25344"
+puts "========"
+puts ""
+#######################################################
+# Draw variables do not follow the scope of TCL level
+#######################################################
+
+box a 1 1 1
+
+set filename "box file.brep"
+
+if [catch {save a $filename}] {
+  puts "ERROR: save failure"
+} else {
+  if ![file exists $filename] {
+    puts "ERROR: file \"$filename\" is not created"
+  } else {
+    if [catch {restore $filename b}] {
+      puts "ERROR: restore of file \"$filename\" is failure"
+    } else {
+      if {[dtyp a] != [dtyp b]} {
+        puts "ERROR: types of shape and its restored copy do not equal"
+      }
+    }
+    file delete $filename
+  }
+}

diff --git a/tests/bugs/fclasses/bug24863_2 b/tests/bugs/fclasses/bug24863_2
index fd1784324f80056e7493f03093f94bf8798f9e94..5c55d934c778216793ae73a9e1cf856195a5a34a 100644 (file)
--- a/tests/bugs/fclasses/bug24863_2
+++ b/tests/bugs/fclasses/bug24863_2
@@ -12,7 +12,6 @@ if {$is_ok != $check_ok} {
     puts "Error : results of command \"whatis\" are different"
 }
 
-set check_puts [puts $b]
-if {$check_puts != ""} {
-    puts "Error : result of command \"puts\" is wrong"
+if {$b != "b"} {
+    puts "Error : tcl variable doesn't point to same-named draw variable"
 }
\ No newline at end of file

diff --git a/tests/bugs/fclasses/bug24863_3 b/tests/bugs/fclasses/bug24863_3
index 890338f5b5777d1994e46c3567d5db3c459f9a88..27a2739afb4d83b9025d89acf12a52742b466994 100644 (file)
--- a/tests/bugs/fclasses/bug24863_3
+++ b/tests/bugs/fclasses/bug24863_3
@@ -8,9 +8,8 @@ if {![catch {set b aaaaa}]} {
      puts "Error : variable was changed"
 }
 
-set check_puts [puts $b]
-if {$check_puts != ""} {
-    puts "Error : result of command \"puts\" is wrong"
+if {$b != "b"} {
+    puts "Error : tcl variable doesn't point to same-named draw variable"
 }
 
 set check_ok [whatis b]

diff --git a/tests/caf/nam/A5 b/tests/caf/nam/A5
index 1496c35bf39ff8eae180bb5afe8f6e8c56282aed..b7586090812487523c0eb6c3becce4cf05453f13 100644 (file)
--- a/tests/caf/nam/A5
+++ b/tests/caf/nam/A5
@@ -1,19 +1,20 @@
 #################### select shape and check selection procedure ####################
 proc Select {lab shape context} {
   global D IsDone TestError
+  upvar 1 $shape myshape $context mycontext
   set res ""
   if {[string compare $context ""] == 0} {
-    if {[catch {set res [SelectShape D $lab $shape]}]} {
+    if {[catch {set res [SelectShape D $lab myshape]}]} {
        set IsDone 0
-       set TestError "$TestError # SelectShape bad result for args: $lab shape"
+       set TestError "$TestError # SelectShape bad result for args: $lab myshape"
     }
   } else {
-    if {[catch {set res [SelectShape D $lab $shape $context]}]} {
+    if {[catch {set res [SelectShape D $lab myshape mycontext]}]} {
        set IsDone 0
-       set TestError "$TestError # SelectShape bad result for args: $lab shape"
+       set TestError "$TestError # SelectShape bad result for args: $lab myshape"
     }
   }
-  return [CenterOfShape $shape]
+  return [CenterOfShape myshape]
 }
 
 if {[catch {set TestLab}] == 1} {

diff --git a/tests/geometry/begin b/tests/geometry/begin
index 8bf5f4596e00abe45dacbeb3aa33fc3568be6b11..b161e346c3a993d67d6797de4b88ff21f791c0c0 100755 (executable)
--- a/tests/geometry/begin
+++ b/tests/geometry/begin
@@ -21,11 +21,12 @@ if { [info exists test_image ] == 0 } {
 proc val2d { c u1 u2 n } {
 
   dset du ($u2-$u1)/$n
+  upvar $c cc
 
   set i 1
                        
   for {dset u $u1} { [dval u] <= $u2} {dset u ($u1+$i*[dval du])} {
-    2dcvalue $c u x y dx dy d2x d2y  ;
+    2dcvalue cc u x y dx dy d2x d2y  ;
     global p_$i d1_$i d2_$i 
     point p_$i  x y;
     puts "u   = [dval u]"
@@ -46,11 +47,12 @@ proc val2d { c u1 u2 n } {
 proc val3d { c u1 u2 n } {
 
   dset du ($u2-$u1)/$n
+  upvar $c cc
   
   set i 1
                
   for {dset u $u1} { [dval u] <= $u2} {dset u (u+[dval du])} {
-    cvalue $c u x y z dx dy dz d2x d2y d2z ;
+    cvalue cc u x y z dx dy dz d2x d2y d2z ; 
     point p_$i  x y z;
     puts "u   = [dval u]"
     puts "p_$i  [dval x  ] [dval y  ] [dval z]";
@@ -73,8 +75,10 @@ proc compare {r1 r2 tol} {
 } 
 
 proc comparepnt2d {p1 p2 tol} {
-       coord $p1 x1 y1
-       coord $p2 x2 y2
+       upvar $p1 pp1
+       upvar $p2 pp2
+       coord pp1 x1 y1
+       coord pp2 x2 y2
        compare [dval x1] [dval x2] $tol
        compare [dval y1] [dval y2] $tol
 }

diff --git a/tests/mesh/end b/tests/mesh/end
index ecd803637a98886a8efefe17172596ed010cc2bb..5640b83cee1086c257a39bd7ceeb1ce67bf39656 100644 (file)
--- a/tests/mesh/end
+++ b/tests/mesh/end
@@ -138,7 +138,8 @@ puts " "
 
 # Check if area of triangles is valid
 proc CheckTriArea {shape {eps 0}} {
-  set area [triarea $shape $eps]
+  upvar #0 $shape a
+  set area [triarea a $eps]
   set t_area [lindex $area 0]
   set g_area [expr abs([lindex $area 1])]
   puts "area by triangles: $t_area"

diff --git a/tests/offset/end b/tests/offset/end
index 0d3158b0308ae0c656b6251291114893557ec73d..92c39be9b00b07670b66b49b7c51306bf428692a 100644 (file)
--- a/tests/offset/end
+++ b/tests/offset/end
@@ -115,7 +115,7 @@ if { [isdraw result] && $mist == 0} {
        }
        #check for bsection
        if { [info exists GlobFaces] && [llength $GlobFaces] == 0 } {
-           puts [ bsection re $result $s ]
+           puts [ bsection re result s ]
            if { [ isdraw re ] } {
                regexp {Mass +: +([-0-9.+eE]+)} [lprops $re] full remass 
                if { $remass != 0 } {

diff --git a/tests/xml/begin b/tests/xml/begin
index 8308f7e1911003bf247c0bc1543cbaeee5c3c9eb..f5cc9f73cc988b02bb30409443ee2f38076258d8 100755 (executable)
--- a/tests/xml/begin
+++ b/tests/xml/begin
@@ -43,7 +43,7 @@ proc SaveToFile { aD aFile } {
     upvar $aD D 
     global FileSuffix ValidatorCheck
     catch {[file delete ${aFile}]}
-    SaveAs $D $aFile
+    SaveAs D $aFile
     if { [file exists $aFile] } {
        if { $FileSuffix == "xml" && $ValidatorCheck} {
            ValidateXml $aFile