From 191082ac712e8c73a00be98e6b64730838ce1305 Mon Sep 17 00:00:00 2001
From: msv <msv@opencascade.com>
Date: Thu, 23 Oct 2014 14:30:28 +0400
Subject: [PATCH] 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 '$'.
---
 src/Draw/Draw_VariableCommands.cxx     | 69 +++++++++++++++-----------
 src/DrawResources/StandardCommands.tcl |  8 +--
 tests/bugs/demo/bug25344_1             | 22 ++++++++
 tests/bugs/demo/bug25344_2             | 27 ++++++++++
 tests/bugs/demo/bug25344_3             | 32 ++++++++++++
 tests/bugs/demo/bug25344_4             | 28 +++++++++++
 tests/bugs/fclasses/bug24863_2         |  5 +-
 tests/bugs/fclasses/bug24863_3         |  5 +-
 tests/caf/nam/A5                       | 11 ++--
 tests/geometry/begin                   | 12 +++--
 tests/mesh/end                         |  3 +-
 tests/offset/end                       |  2 +-
 tests/xml/begin                        |  2 +-
 13 files changed, 177 insertions(+), 49 deletions(-)
 create mode 100644 tests/bugs/demo/bug25344_1
 create mode 100644 tests/bugs/demo/bug25344_2
 create mode 100644 tests/bugs/demo/bug25344_3
 create mode 100644 tests/bugs/demo/bug25344_4

diff --git a/src/Draw/Draw_VariableCommands.cxx b/src/Draw/Draw_VariableCommands.cxx
index be7f061d01..2f93b05cc3 100644
--- 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 a56b9d3e9a..737cdc3cb5 100644
--- 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
index 0000000000..18962c48b5
--- /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
index 0000000000..e820a9e111
--- /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
index 0000000000..967d3e2d43
--- /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
index 0000000000..a3c9f3f82c
--- /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 fd1784324f..5c55d934c7 100644
--- 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 890338f5b5..27a2739afb 100644
--- 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 1496c35bf3..b758609081 100644
--- 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 8bf5f4596e..b161e346c3 100755
--- 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 ecd803637a..5640b83cee 100644
--- 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 0d3158b030..92c39be9b0 100644
--- 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 8308f7e191..f5cc9f73cc 100755
--- 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