Tcl Source Code

OriginalBugID: 6109 Bug
Version: 8.4a1
SubmitDate: '2000-08-09'
LastModified: '2000-10-25'
Severity: MED
Status: UnAssn
Submitter: techsupp
OS: All
FixedDate: '2000-10-25'
ClosedDate: '2000-10-25'


Name:

Don Porter


ReproducibleScript:

namespace eval test_ns_1 {

        variable v 42

    }

    namespace eval test_ns_2 {

        proc namespace args {}

    }

    namespace eval test_ns_2 [namespace eval test_ns_1 {

        namespace code {set v}

    }]


ObservedBehavior:

The example script returns the empty string.  It should

 return 42, according to the documentation of [namespace code]:


     namespace code script

          Captures the current namespace context for later execu-

          tion  of the script script.  It returns a new script in

          which script has been wrapped in a namespace code  com-

          mand.   The  new  script  has two important properties.

          First, it can be evaluated in any  namespace  and  will

          cause  script  to be evaluated in the current namespace

          (the one where the namespace code command was invoked).


Note the guarantee is for "any namespace".  This guarantee

includes those namespaces which have been silly enough to

redefine the [namespace] command.


DesiredBehavior:

[namespace code] should behave as documented.


Patch:

Index: generic/tclNamesp.c

===================================================================

RCS file: /cvsroot/tcl/generic/tclNamesp.c,v

retrieving revision 1.18

diff -c -r1.18 tclNamesp.c

*** tclNamesp.c 2000/05/11 00:17:29     1.18

--- tclNamesp.c 2000/08/09 17:06:42

***************

*** 2639,2648 ****

   *    Here "arg" can be a list. "namespace code arg" produces a result

   *    equivalent to that produced by the command

   *

!  *        list namespace inscope [namespace current] $arg

   *

   *    However, if "arg" is itself a scoped value starting with

!  *    "namespace inscope", then the result is just "arg".

   *

   * Results:

   *    Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.

--- 2639,2648 ----

   *    Here "arg" can be a list. "namespace code arg" produces a result

   *    equivalent to that produced by the command

   *

!  *        list ::namespace inscope [namespace current] $arg

   *

   *    However, if "arg" is itself a scoped value starting with

!  *    "::namespace inscope", then the result is just "arg".

   *

   * Results:

   *    Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.

***************

*** 2676,2681 ****

--- 2676,2685 ----

       */


      arg = Tcl_GetStringFromObj(objv[2], &length);

+     while (*arg == ':') {

+       arg++;

+       length--;

+     }

      if ((*arg == 'n') && (length > 17)

            && (strncmp(arg, "namespace", 9) == 0)) {

        for (p = (arg + 9);  (*p == ' ');  p++) {

***************

*** 2698,2704 ****


      listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);

      Tcl_ListObjAppendElement(interp, listPtr,

!             Tcl_NewStringObj("namespace", -1));

      Tcl_ListObjAppendElement(interp, listPtr,

            Tcl_NewStringObj("inscope", -1));


--- 2702,2708 ----


      listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);

      Tcl_ListObjAppendElement(interp, listPtr,

!             Tcl_NewStringObj("::namespace", -1));

      Tcl_ListObjAppendElement(interp, listPtr,

            Tcl_NewStringObj("inscope", -1));


Index: library/init.tcl

===================================================================

RCS file: /cvsroot/tcl/library/init.tcl,v

retrieving revision 1.41

diff -c -r1.41 init.tcl

*** init.tcl    2000/05/18 21:37:19     1.41

--- init.tcl    2000/08/09 17:12:54

***************

*** 163,169 ****

      # then concatenate its arguments onto the end and evaluate it.


      set cmd [lindex $args 0]

!     if {[regexp "^namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {

          set arglist [lrange $args 1 end]

        set ret [catch {uplevel $cmd $arglist} result]

          if {$ret == 0} {

--- 163,169 ----

      # then concatenate its arguments onto the end and evaluate it.


      set cmd [lindex $args 0]

!     if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {

          set arglist [lrange $args 1 end]

        set ret [catch {uplevel $cmd $arglist} result]

          if {$ret == 0} {

Index: tests/namespace-old.test

===================================================================

RCS file: /cvsroot/tcl/tests/namespace-old.test,v

retrieving revision 1.5

diff -c -r1.5 namespace-old.test

*** namespace-old.test  2000/04/10 17:19:02     1.5

--- namespace-old.test  2000/08/09 17:06:43

***************

*** 804,820 ****

      namespace eval test_ns_inscope {

          namespace code {"1 2 3" "4 5" 6}

      }

! } {namespace inscope ::test_ns_inscope {"1 2 3" "4 5" 6}}


  test namespace-old-10.5 {with one arg, first "scope" sticks} {

      set sval [namespace eval test_ns_inscope {namespace code {one two}}]

      namespace code $sval

! } {namespace inscope ::test_ns_inscope {one two}}


  test namespace-old-10.6 {with many args, each "scope" adds new args} {

      set sval [namespace eval test_ns_inscope {namespace code {one two}}]

      namespace code "$sval three"

! } {namespace inscope ::test_ns_inscope {one two} three}


  test namespace-old-10.7 {scoped commands work with eval} {

      set cref [namespace eval test_ns_inscope {namespace code show}]

--- 804,820 ----

      namespace eval test_ns_inscope {

          namespace code {"1 2 3" "4 5" 6}

      }

! } {::namespace inscope ::test_ns_inscope {"1 2 3" "4 5" 6}}


  test namespace-old-10.5 {with one arg, first "scope" sticks} {

      set sval [namespace eval test_ns_inscope {namespace code {one two}}]

      namespace code $sval

! } {::namespace inscope ::test_ns_inscope {one two}}


  test namespace-old-10.6 {with many args, each "scope" adds new args} {

      set sval [namespace eval test_ns_inscope {namespace code {one two}}]

      namespace code "$sval three"

! } {::namespace inscope ::test_ns_inscope {one two} three}


  test namespace-old-10.7 {scoped commands work with eval} {

      set cref [namespace eval test_ns_inscope {namespace code show}]

Index: tests/namespace.test

===================================================================

RCS file: /cvsroot/tcl/tests/namespace.test,v

retrieving revision 1.13

diff -c -r1.13 namespace.test

*** namespace.test      2000/05/11 00:17:29     1.13

--- namespace.test      2000/08/09 17:06:44

***************

*** 694,705 ****

  } {namespace     inscope     ::test_ns_1 cmd}

  test namespace-22.4 {NamespaceCodeCmd, in :: namespace} {

      namespace code unknown

! } {namespace inscope :: unknown}

  test namespace-22.5 {NamespaceCodeCmd, in other namespace} {

      namespace eval test_ns_1 {

          namespace code cmd

      }

! } {namespace inscope ::test_ns_1 cmd}


  test namespace-23.1 {NamespaceCurrentCmd, bad args} {

      catch {eval namespace delete [namespace children :: test_ns_*]}

--- 694,716 ----

  } {namespace     inscope     ::test_ns_1 cmd}

  test namespace-22.4 {NamespaceCodeCmd, in :: namespace} {

      namespace code unknown

! } {::namespace inscope :: unknown}

  test namespace-22.5 {NamespaceCodeCmd, in other namespace} {

      namespace eval test_ns_1 {

          namespace code cmd

      }

! } {::namespace inscope ::test_ns_1 cmd}

! test namespace-22.5 {NamespaceCodeCmd, in other namespace} {

!     namespace eval test_ns_1 {

!       variable v 42

!     }

!     namespace eval test_ns_2 {

!       proc namespace args {}

!     }

!     namespace eval test_ns_2 [namespace eval test_ns_1 {

!       namespace code {set v}

!     }]

! } {42}


  test namespace-23.1 {NamespaceCurrentCmd, bad args} {

      catch {eval namespace delete [namespace children :: test_ns_*]}


PatchFiles:

generic/tclNamesp.c

    library/init.tcl

    tests/namespace-old.test

    tests/namespace.test

File Added - 5101: patch

Logged In: YES 
user_id=148712

Patch #403530

Registered patch as # 103530