tests/applyns.test

   1 # Commands covered:  apply
   2 #
   3 # This file contains a collection of tests for one or more of the Tcl
   4 # built-in commands.  Sourcing this file into Tcl runs the tests and
   5 # generates output for errors.  No output means no errors were found.
   6 #
   7 # Copyright (c) 1991-1993 The Regents of the University of California.
   8 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
   9 # Copyright (c) 1998-1999 by Scriptics Corporation.
  10 # Copyright (c) 2005-2006 Miguel Sofer
  11 #
  12 # See the file "license.terms" for information on usage and redistribution
  13 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14
  15 source [file dirname [info script]]/testing.tcl
  16
  17 needs cmd apply
  18 needs cmd namespace
  19
  20 # Tests for runtime errors in the lambda expression
  21
  22 # Note: Jim doesn't have the concept of non-existent namespaces
  23
  24 test apply-3.1 {non-existing namespace} -constraints tcl -body {
  25     apply [list x {set x 1} ::NONEXIST::FOR::SURE] x
  26 } -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
  27 test apply-3.2 {non-existing namespace} -constraints tcl -body {
  28     namespace eval ::NONEXIST::FOR::SURE {}
  29     set lambda [list x {set x 1} ::NONEXIST::FOR::SURE]
  30     apply $lambda x
  31     namespace delete ::NONEXIST
  32     apply $lambda x
  33 } -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
  34 test apply-3.3 {non-existing namespace} -constraints tcl -body {
  35     apply [list x {set x 1} NONEXIST::FOR::SURE] x
  36 } -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
  37 test apply-3.4 {non-existing namespace} -constraints tcl -body {
  38     namespace eval ::NONEXIST::FOR::SURE {}
  39     set lambda [list x {set x 1} NONEXIST::FOR::SURE]
  40     apply $lambda x
  41     namespace delete ::NONEXIST
  42     apply $lambda x
  43 } -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
  44
  45 # Tests for correct namespace scope
  46
  47 namespace eval ::testApply {
  48     proc testApply args {return testApply}
  49 }
  50
  51 test apply-7.1 {namespace access} {
  52     set ::testApply::x 0
  53     set body {set x 1; set x}
  54     list [apply [list args $body ::testApply]] $::testApply::x
  55 } {1 0}
  56 test apply-7.2 {namespace access} {
  57     set ::testApply::x 0
  58     set body {variable x; set x}
  59     list [apply [list args $body ::testApply]] $::testApply::x
  60 } {0 0}
  61 test apply-7.3 {namespace access} {
  62     set ::testApply::x 0
  63     set body {variable x; set x 1}
  64     list [apply [list args $body ::testApply]] $::testApply::x
  65 } {1 1}
  66 test apply-7.4 {namespace access} {
  67     set ::testApply::x 0
  68     set body {testApply}
  69     apply [list args $body ::testApply]
  70 } testApply
  71 test apply-7.5 {namespace access} {
  72     set ::testApply::x 0
  73     set body {set x 1; set x}
  74     list [apply [list args $body testApply]] $::testApply::x
  75 } {1 0}
  76 test apply-7.6 {namespace access} {
  77     set ::testApply::x 0
  78     set body {variable x; set x}
  79     list [apply [list args $body testApply]] $::testApply::x
  80 } {0 0}
  81 test apply-7.7 {namespace access} {
  82     set ::testApply::x 0
  83     set body {variable x; set x 1}
  84     list [apply [list args $body testApply]] $::testApply::x
  85 } {1 1}
  86 test apply-7.8 {namespace access} {
  87     set ::testApply::x 0
  88     set body {testApply}
  89     apply [list args $body testApply]
  90 } testApply
  91
  92 # apply ignore the current namespace and runs at global scope
  93 # or the provided namespace (relative to global)
  94 test apply-8.1 {namespace current within apply} {
  95     namespace eval testApply {}
  96     namespace eval testApply2 {
  97         apply {a { return [namespace current]-$a } testApply} 5
  98     }
  99 } {::testApply-5}
 100
 101 test apply-8.2 {namespace current within apply} {
 102     namespace eval testApply2 {
 103         apply {a { return [namespace current]-$a }} 5
 104     }
 105 } {::-5}
 106
 107 namespace delete testApply
 108 namespace delete testApply2
 109
 110 testreport
 111
 112 # Local Variables:
 113 # mode: tcl
 114 # fill-column: 78
 115 # End: