Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/execute.test@260cb5ec6c19

     1 # This file contains tests for the tclExecute.c source file. Tests appear

     2 # in the same order as the C code that they test. The set of tests is

     3 # currently incomplete since it currently includes only new tests for

     4 # code changed for the addition of Tcl namespaces. Other execution-

     5 # related tests appear in several other test files including

     6 # namespace.test, basic.test, eval.test, for.test, etc.

7 #

     8 # Sourcing this file into Tcl runs the tests and generates output for

     9 # errors. No output means no errors were found.

    10 #

    11 # Copyright (c) 1997 Sun Microsystems, Inc.

    12 # Copyright (c) 1998-1999 by Scriptics Corporation.

    13 #

    14 # See the file "license.terms" for information on usage and redistribution

    15 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.

    16 #

    17 # RCS: @(#) $Id: execute.test,v 1.13.2.2 2004/10/28 00:01:07 dgp Exp $

    19 if {[lsearch [namespace children] ::tcltest] == -1} {

    20     package require tcltest 2

    21     namespace import -force ::tcltest::*

    22 }

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

    25 catch {rename foo ""}

    26 catch {unset x}

    27 catch {unset y}

    28 catch {unset msg}

    30 ::tcltest::testConstraint testobj \

    31 	[expr {[info commands testobj] != {} \

    32 	&& [info commands testdoubleobj] != {} \

    33 	&& [info commands teststringobj] != {} \

    34 	&& [info commands testobj] != {}}]

    36 ::tcltest::testConstraint longIs32bit \

    37 	[expr {int(0x80000000) < 0}]

    39 # Tests for the omnibus TclExecuteByteCode function:

    41 # INST_DONE not tested

    42 # INST_PUSH1 not tested

    43 # INST_PUSH4 not tested

    44 # INST_POP not tested

    45 # INST_DUP not tested

    46 # INST_CONCAT1 not tested

    47 # INST_INVOKE_STK4 not tested

    48 # INST_INVOKE_STK1 not tested

    49 # INST_EVAL_STK not tested

    50 # INST_EXPR_STK not tested

    52 # INST_LOAD_SCALAR1

    54 test execute-1.1 {TclExecuteByteCode, INST_LOAD_SCALAR1, small opnd} {

    55     proc foo {} {

    56 	set x 1

    57 	return $x

    58     }

    59     foo

    60 } 1

    61 test execute-1.2 {TclExecuteByteCode, INST_LOAD_SCALAR1, large opnd} {

    62     # Bug: 2243

    63     set body {}

    64     for {set i 0} {$i < 129} {incr i} {

    65 	append body "set x$i x\n"

    66     }

    67     append body {

    68 	set y 1

    69 	return $y

    70     }

    72     proc foo {} $body

    73     foo

    74 } 1

    75 test execute-1.3 {TclExecuteByteCode, INST_LOAD_SCALAR1, error} {

    76     proc foo {} {

    77 	set x 1

    78 	unset x

    79 	return $x

    80     }

    81     list [catch {foo} msg] $msg

    82 } {1 {can't read "x": no such variable}}

    85 # INST_LOAD_SCALAR4

    87 test execute-2.1 {TclExecuteByteCode, INST_LOAD_SCALAR4, simple case} {

    88     set body {}

    89     for {set i 0} {$i < 256} {incr i} {

    90 	append body "set x$i x\n"

    91     }

    92     append body {

    93 	set y 1

    94 	return $y

    95     }

    97     proc foo {} $body

    98     foo

    99 } 1

   100 test execute-2.2 {TclExecuteByteCode, INST_LOAD_SCALAR4, error} {

   101     set body {}

   102     for {set i 0} {$i < 256} {incr i} {

   103 	append body "set x$i x\n"

   104     }

   105     append body {

   106 	set y 1

   107 	unset y

   108 	return $y

   109     }

   111     proc foo {} $body

   112     list [catch {foo} msg] $msg

   113 } {1 {can't read "y": no such variable}}

   116 # INST_LOAD_SCALAR_STK not tested

   117 # INST_LOAD_ARRAY4 not tested

   118 # INST_LOAD_ARRAY1 not tested

   119 # INST_LOAD_ARRAY_STK not tested

   120 # INST_LOAD_STK not tested

   121 # INST_STORE_SCALAR4 not tested

   122 # INST_STORE_SCALAR1 not tested

   123 # INST_STORE_SCALAR_STK not tested

   124 # INST_STORE_ARRAY4 not tested

   125 # INST_STORE_ARRAY1 not tested

   126 # INST_STORE_ARRAY_STK not tested

   127 # INST_STORE_STK not tested

   128 # INST_INCR_SCALAR1 not tested

   129 # INST_INCR_SCALAR_STK not tested

   130 # INST_INCR_STK not tested

   131 # INST_INCR_ARRAY1 not tested

   132 # INST_INCR_ARRAY_STK not tested

   133 # INST_INCR_SCALAR1_IMM not tested

   134 # INST_INCR_SCALAR_STK_IMM not tested

   135 # INST_INCR_STK_IMM not tested

   136 # INST_INCR_ARRAY1_IMM not tested

   137 # INST_INCR_ARRAY_STK_IMM not tested

   138 # INST_JUMP1 not tested

   139 # INST_JUMP4 not tested

   140 # INST_JUMP_TRUE4 not tested

   141 # INST_JUMP_TRUE1 not tested

   142 # INST_JUMP_FALSE4 not tested

   143 # INST_JUMP_FALSE1 not tested

   144 # INST_LOR not tested

   145 # INST_LAND not tested

   146 # INST_EQ not tested

   147 # INST_NEQ not tested

   148 # INST_LT not tested

   149 # INST_GT not tested

   150 # INST_LE not tested

   151 # INST_GE not tested

   152 # INST_MOD not tested

   153 # INST_LSHIFT not tested

   154 # INST_RSHIFT not tested

   155 # INST_BITOR not tested

   156 # INST_BITXOR not tested

   157 # INST_BITAND not tested

   159 # INST_ADD is partially tested:

   160 test execute-3.1 {TclExecuteByteCode, INST_ADD, op1 is int} {testobj} {

   161     set x [testintobj set 0 1]

   162     expr {$x + 1}

   163 } 2

   164 test execute-3.2 {TclExecuteByteCode, INST_ADD, op1 is double} {testobj} {

   165     set x [testdoubleobj set 0 1]

   166     expr {$x + 1}

   167 } 2.0

   168 test execute-3.3 {TclExecuteByteCode, INST_ADD, op1 is double with string} {testobj} {

   169     set x [testintobj set 0 1]

   170     testobj convert 0 double

   171     expr {$x + 1}

   172 } 2

   173 test execute-3.4 {TclExecuteByteCode, INST_ADD, op1 is string int} {testobj} {

   174     set x [teststringobj set 0 1]

   175     expr {$x + 1}

   176 } 2

   177 test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} {

   178     set x [teststringobj set 0 1.0]

   179     expr {$x + 1}

   180 } 2.0

   181 test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} {

   182     set x [teststringobj set 0 foo]

   183     list [catch {expr {$x + 1}} msg] $msg

   184 } {1 {can't use non-numeric string as operand of "+"}}

   185 test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} {

   186     set x [testintobj set 0 1]

   187     expr {1 + $x}

   188 } 2

   189 test execute-3.8 {TclExecuteByteCode, INST_ADD, op2 is double} {testobj} {

   190     set x [testdoubleobj set 0 1]

   191     expr {1 + $x}

   192 } 2.0

   193 test execute-3.9 {TclExecuteByteCode, INST_ADD, op2 is double with string} {testobj} {

   194     set x [testintobj set 0 1]

   195     testobj convert 0 double

   196     expr {1 + $x}

   197 } 2

   198 test execute-3.10 {TclExecuteByteCode, INST_ADD, op2 is string int} {testobj} {

   199     set x [teststringobj set 0 1]

   200     expr {1 + $x}

   201 } 2

   202 test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} {

   203     set x [teststringobj set 0 1.0]

   204     expr {1 + $x}

   205 } 2.0

   206 test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} {

   207     set x [teststringobj set 0 foo]

   208     list [catch {expr {1 + $x}} msg] $msg

   209 } {1 {can't use non-numeric string as operand of "+"}}

   211 # INST_SUB is partially tested:

   212 test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} {

   213     set x [testintobj set 0 1]

   214     expr {$x - 1}

   215 } 0

   216 test execute-3.14 {TclExecuteByteCode, INST_SUB, op1 is double} {testobj} {

   217     set x [testdoubleobj set 0 1]

   218     expr {$x - 1}

   219 } 0.0

   220 test execute-3.15 {TclExecuteByteCode, INST_SUB, op1 is double with string} {testobj} {

   221     set x [testintobj set 0 1]

   222     testobj convert 0 double

   223     expr {$x - 1}

   224 } 0

   225 test execute-3.16 {TclExecuteByteCode, INST_SUB, op1 is string int} {testobj} {

   226     set x [teststringobj set 0 1]

   227     expr {$x - 1}

   228 } 0

   229 test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} {

   230     set x [teststringobj set 0 1.0]

   231     expr {$x - 1}

   232 } 0.0

   233 test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} {

   234     set x [teststringobj set 0 foo]

   235     list [catch {expr {$x - 1}} msg] $msg

   236 } {1 {can't use non-numeric string as operand of "-"}}

   237 test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} {

   238     set x [testintobj set 0 1]

   239     expr {1 - $x}

   240 } 0

   241 test execute-3.20 {TclExecuteByteCode, INST_SUB, op2 is double} {testobj} {

   242     set x [testdoubleobj set 0 1]

   243     expr {1 - $x}

   244 } 0.0

   245 test execute-3.21 {TclExecuteByteCode, INST_SUB, op2 is double with string} {testobj} {

   246     set x [testintobj set 0 1]

   247     testobj convert 0 double

   248     expr {1 - $x}

   249 } 0

   250 test execute-3.22 {TclExecuteByteCode, INST_SUB, op2 is string int} {testobj} {

   251     set x [teststringobj set 0 1]

   252     expr {1 - $x}

   253 } 0

   254 test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} {

   255     set x [teststringobj set 0 1.0]

   256     expr {1 - $x}

   257 } 0.0

   258 test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} {

   259     set x [teststringobj set 0 foo]

   260     list [catch {expr {1 - $x}} msg] $msg

   261 } {1 {can't use non-numeric string as operand of "-"}}

   263 # INST_MULT is partially tested:

   264 test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} {

   265     set x [testintobj set 1 1]

   266     expr {$x * 1}

   267 } 1

   268 test execute-3.26 {TclExecuteByteCode, INST_MULT, op1 is double} {testobj} {

   269     set x [testdoubleobj set 1 2.0]

   270     expr {$x * 1}

   271 } 2.0

   272 test execute-3.27 {TclExecuteByteCode, INST_MULT, op1 is double with string} {testobj} {

   273     set x [testintobj set 1 2]

   274     testobj convert 1 double

   275     expr {$x * 1}

   276 } 2

   277 test execute-3.28 {TclExecuteByteCode, INST_MULT, op1 is string int} {testobj} {

   278     set x [teststringobj set 1 1]

   279     expr {$x * 1}

   280 } 1

   281 test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj} {

   282     set x [teststringobj set 1 1.0]

   283     expr {$x * 1}

   284 } 1.0

   285 test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} {

   286     set x [teststringobj set 1 foo]

   287     list [catch {expr {$x * 1}} msg] $msg

   288 } {1 {can't use non-numeric string as operand of "*"}}

   289 test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} {

   290     set x [testintobj set 1 1]

   291     expr {1 * $x}

   292 } 1

   293 test execute-3.32 {TclExecuteByteCode, INST_MULT, op2 is double} {testobj} {

   294     set x [testdoubleobj set 1 2.0]

   295     expr {1 * $x}

   296 } 2.0

   297 test execute-3.33 {TclExecuteByteCode, INST_MULT, op2 is double with string} {testobj} {

   298     set x [testintobj set 1 2]

   299     testobj convert 1 double

   300     expr {1 * $x}

   301 } 2

   302 test execute-3.34 {TclExecuteByteCode, INST_MULT, op2 is string int} {testobj} {

   303     set x [teststringobj set 1 1]

   304     expr {1 * $x}

   305 } 1

   306 test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj} {

   307     set x [teststringobj set 1 1.0]

   308     expr {1 * $x}

   309 } 1.0

   310 test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} {

   311     set x [teststringobj set 1 foo]

   312     list [catch {expr {1 * $x}} msg] $msg

   313 } {1 {can't use non-numeric string as operand of "*"}}

   315 # INST_DIV is partially tested:

   316 test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} {

   317     set x [testintobj set 1 1]

   318     expr {$x / 1}

   319 } 1

   320 test execute-3.38 {TclExecuteByteCode, INST_DIV, op1 is double} {testobj} {

   321     set x [testdoubleobj set 1 2.0]

   322     expr {$x / 1}

   323 } 2.0

   324 test execute-3.39 {TclExecuteByteCode, INST_DIV, op1 is double with string} {testobj} {

   325     set x [testintobj set 1 2]

   326     testobj convert 1 double

   327     expr {$x / 1}

   328 } 2

   329 test execute-3.40 {TclExecuteByteCode, INST_DIV, op1 is string int} {testobj} {

   330     set x [teststringobj set 1 1]

   331     expr {$x / 1}

   332 } 1

   333 test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} {

   334     set x [teststringobj set 1 1.0]

   335     expr {$x / 1}

   336 } 1.0

   337 test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} {

   338     set x [teststringobj set 1 foo]

   339     list [catch {expr {$x / 1}} msg] $msg

   340 } {1 {can't use non-numeric string as operand of "/"}}

   341 test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} {

   342     set x [testintobj set 1 1]

   343     expr {2 / $x}

   344 } 2

   345 test execute-3.44 {TclExecuteByteCode, INST_DIV, op2 is double} {testobj} {

   346     set x [testdoubleobj set 1 1.0]

   347     expr {2 / $x}

   348 } 2.0

   349 test execute-3.45 {TclExecuteByteCode, INST_DIV, op2 is double with string} {testobj} {

   350     set x [testintobj set 1 1]

   351     testobj convert 1 double

   352     expr {2 / $x}

   353 } 2

   354 test execute-3.46 {TclExecuteByteCode, INST_DIV, op2 is string int} {testobj} {

   355     set x [teststringobj set 1 1]

   356     expr {2 / $x}

   357 } 2

   358 test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} {

   359     set x [teststringobj set 1 1.0]

   360     expr {2 / $x}

   361 } 2.0

   362 test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} {

   363     set x [teststringobj set 1 foo]

   364     list [catch {expr {1 / $x}} msg] $msg

   365 } {1 {can't use non-numeric string as operand of "/"}}

   367 # INST_UPLUS is partially tested:

   368 test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} {

   369     set x [testintobj set 1 1]

   370     expr {+ $x}

   371 } 1

   372 test execute-3.50 {TclExecuteByteCode, INST_UPLUS, op is double} {testobj} {

   373     set x [testdoubleobj set 1 1.0]

   374     expr {+ $x}

   375 } 1.0

   376 test execute-3.51 {TclExecuteByteCode, INST_UPLUS, op is double with string} {testobj} {

   377     set x [testintobj set 1 1]

   378     testobj convert 1 double

   379     expr {+ $x}

   380 } 1

   381 test execute-3.52 {TclExecuteByteCode, INST_UPLUS, op is string int} {testobj} {

   382     set x [teststringobj set 1 1]

   383     expr {+ $x}

   384 } 1

   385 test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj} {

   386     set x [teststringobj set 1 1.0]

   387     expr {+ $x}

   388 } 1.0

   389 test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} {

   390     set x [teststringobj set 1 foo]

   391     list [catch {expr {+ $x}} msg] $msg

   392 } {1 {can't use non-numeric string as operand of "+"}}

   394 # INST_UMINUS is partially tested:

   395 test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} {

   396     set x [testintobj set 1 1]

   397     expr {- $x}

   398 } -1

   399 test execute-3.56 {TclExecuteByteCode, INST_UMINUS, op is double} {testobj} {

   400     set x [testdoubleobj set 1 1.0]

   401     expr {- $x}

   402 } -1.0

   403 test execute-3.57 {TclExecuteByteCode, INST_UMINUS, op is double with string} {testobj} {

   404     set x [testintobj set 1 1]

   405     testobj convert 1 double

   406     expr {- $x}

   407 } -1

   408 test execute-3.58 {TclExecuteByteCode, INST_UMINUS, op is string int} {testobj} {

   409     set x [teststringobj set 1 1]

   410     expr {- $x}

   411 } -1

   412 test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testobj} {

   413     set x [teststringobj set 1 1.0]

   414     expr {- $x}

   415 } -1.0

   416 test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} {

   417     set x [teststringobj set 1 foo]

   418     list [catch {expr {- $x}} msg] $msg

   419 } {1 {can't use non-numeric string as operand of "-"}}

   421 # INST_LNOT is partially tested:

   422 test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {

   423     set x [testintobj set 1 2]

   424     expr {! $x}

   425 } 0

   426 test execute-3.62 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {

   427     set x [testintobj set 1 0]

   428     expr {! $x}

   429 } 1

   430 test execute-3.63 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {

   431     set x [testdoubleobj set 1 1.0]

   432     expr {! $x}

   433 } 0

   434 test execute-3.64 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {

   435     set x [testdoubleobj set 1 0.0]

   436     expr {! $x}

   437 } 1

   438 test execute-3.65 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} {

   439     set x [testintobj set 1 1]

   440     testobj convert 1 double

   441     expr {! $x}

   442 } 0

   443 test execute-3.66 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} {

   444     set x [testintobj set 1 0]

   445     testobj convert 1 double

   446     expr {! $x}

   447 } 1

   448 test execute-3.67 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {

   449     set x [teststringobj set 1 1]

   450     expr {! $x}

   451 } 0

   452 test execute-3.68 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {

   453     set x [teststringobj set 1 0]

   454     expr {! $x}

   455 } 1

   456 test execute-3.69 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {

   457     set x [teststringobj set 1 1.0]

   458     expr {! $x}

   459 } 0

   460 test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {

   461     set x [teststringobj set 1 0.0]

   462     expr {! $x}

   463 } 1

   464 test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} {

   465     set x [teststringobj set 1 foo]

   466     list [catch {expr {! $x}} msg] $msg

   467 } {1 {can't use non-numeric string as operand of "!"}}

   469 # INST_BITNOT not tested

   470 # INST_CALL_BUILTIN_FUNC1 not tested

   471 # INST_CALL_FUNC1 not tested

   473 # INST_TRY_CVT_TO_NUMERIC is partially tested:

   474 test execute-3.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} {

   475     set x [testintobj set 1 1]

   476     expr {$x}

   477 } 1

   478 test execute-3.73 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double} {testobj} {

   479     set x [testdoubleobj set 1 1.0]

   480     expr {$x}

   481 } 1.0

   482 test execute-3.74 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double with string} {testobj} {

   483     set x [testintobj set 1 1]

   484     testobj convert 1 double

   485     expr {$x}

   486 } 1

   487 test execute-3.75 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string int} {testobj} {

   488     set x [teststringobj set 1 1]

   489     expr {$x}

   490 } 1

   491 test execute-3.76 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string double} {testobj} {

   492     set x [teststringobj set 1 1.0]

   493     expr {$x}

   494 } 1.0

   495 test execute-3.77 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is non-numeric} {testobj} {

   496     set x [teststringobj set 1 foo]

   497     expr {$x}

   498 } foo

   500 # INST_BREAK not tested

   501 # INST_CONTINUE not tested

   502 # INST_FOREACH_START4 not tested

   503 # INST_FOREACH_STEP4 not tested

   504 # INST_BEGIN_CATCH4 not tested

   505 # INST_END_CATCH not tested

   506 # INST_PUSH_RESULT not tested

   507 # INST_PUSH_RETURN_CODE not tested

   509 test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {

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

   511     catch {unset x}

   512     catch {unset y}

   513     namespace eval test_ns_1 {

   514         namespace export cmd1

   515         proc cmd1 {args} {return "cmd1: $args"}

   516         proc cmd2 {args} {return "cmd2: $args"}

   517     }

   518     namespace eval test_ns_1::test_ns_2 {

   519         namespace import ::test_ns_1::*

   520     }

   521     set x "test_ns_1::"

   522     set y "test_ns_2::"

   523     list [namespace which -command ${x}${y}cmd1] \

   524          [catch {namespace which -command ${x}${y}cmd2} msg] $msg \

   525          [catch {namespace which -command ${x}${y}:cmd2} msg] $msg

   526 } {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}}

   527 test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} {

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

   529     catch {rename foo ""}

   530     catch {unset l}

   531     proc foo {} {

   532         return "global foo"

   533     }

   534     namespace eval test_ns_1 {

   535         proc whichFoo {} {

   536             return [namespace which -command foo]

   537         }

   538     }

   539     set l ""

   540     lappend l [test_ns_1::whichFoo]

   541     namespace eval test_ns_1 {

   542         proc foo {} {

   543             return "namespace foo"

   544         }

   545     }

   546     lappend l [test_ns_1::whichFoo]

   547     set l

   548 } {::foo ::test_ns_1::foo}

   549 test execute-4.3 {Tcl_GetCommandFromObj, command never found} {

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

   551     catch {rename foo ""}

   552     namespace eval test_ns_1 {

   553         proc foo {} {

   554             return "namespace foo"

   555         }

   556     }

   557     namespace eval test_ns_1 {

   558         proc foo {} {

   559             return "namespace foo"

   560         }

   561     }

   562     list [namespace eval test_ns_1 {namespace which -command foo}] \

   563          [rename test_ns_1::foo ""] \

   564          [catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg

   565 } {::test_ns_1::foo {} 0 {}}

   567 test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} {

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

   569     catch {unset l}

   570     proc {} {} {return {}}

   571     {}

   572     set l {}

   573     lindex {} 0

   574     {}

   575 } {}

   577 test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {

   578     proc {} {} {}

   579     proc { } {} {}

   580     proc p {} {

   581         set x {}

   582         $x

   583         append x { }

   584         $x

   585     }

   586     p

   587 } {}

   589 test execute-6.2 {Evaluate an expression in a variable; compile the first time, do not the second} {

   590     set w {3*5}

   591     proc a {obj} {expr $obj}

   592     set res "[a $w]:[a $w]"

   593 } {15:15}

   595 test execute-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {

   596     set x 0x100000000

   597     expr {$x && 1}

   598 } 1

   599 test execute-7.1 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {

   600     expr {0x100000000 && 1}

   601 } 1

   602 test execute-7.2 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {

   603     expr {1 && 0x100000000}

   604 } 1

   605 test execute-7.3 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {

   606     expr {wide(0x100000000) && 1}

   607 } 1

   608 test execute-7.4 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {

   609     expr {1 && wide(0x100000000)}

   610 } 1

   611 test execute-7.5 {Wide int handling in INST_EQ} {longIs32bit} {

   612     expr {4 == (wide(1)+wide(3))}

   613 } 1

   614 test execute-7.6 {Wide int handling in INST_EQ and [incr]} {longIs32bit} {

   615     set x 399999999999

   616     expr {400000000000 == [incr x]}

   617 } 1

   618 # wide ints have more bits of precision than doubles, but we convert anyway

   619 test execute-7.7 {Wide int handling in INST_EQ and [incr]} {longIs32bit} {

   620     set x [expr {wide(1)<<62}]

   621     set y [expr {$x+1}]

   622     expr {double($x) == double($y)}

   623 } 1

   624 test execute-7.8 {Wide int conversions can change sign} {longIs32bit} {

   625     set x 0x80000000

   626     expr {int($x) < wide($x)}

   627 } 1

   628 test execute-7.9 {Wide int handling in INST_MOD} {longIs32bit} {

   629     expr {(wide(1)<<60) % ((wide(47)<<45)-1)}

   630 } 316659348800185

   631 test execute-7.10 {Wide int handling in INST_MOD} {longIs32bit} {

   632     expr {((wide(1)<<60)-1) % 0x400000000}

   633 } 17179869183

   634 test execute-7.11 {Wide int handling in INST_LSHIFT} {longIs32bit} {

   635     expr wide(42)<<30

   636 } 45097156608

   637 test execute-7.12 {Wide int handling in INST_LSHIFT} {longIs32bit} {

   638     expr 12345678901<<3

   639 } 98765431208

   640 test execute-7.13 {Wide int handling in INST_RSHIFT} {longIs32bit} {

   641     expr 0x543210febcda9876>>7

   642 } 47397893236700464

   643 test execute-7.14 {Wide int handling in INST_RSHIFT} {longIs32bit} {

   644     expr 0x9876543210febcda>>7

   645 } -58286587177206407

   646 test execute-7.15 {Wide int handling in INST_BITOR} {longIs32bit} {

   647     expr 0x9876543210febcda | 0x543210febcda9876

   648 } -2560765885044310786

   649 test execute-7.16 {Wide int handling in INST_BITXOR} {longIs32bit} {

   650     expr 0x9876543210febcda ^ 0x543210febcda9876

   651 } -3727778945703861076

   652 test execute-7.17 {Wide int handling in INST_BITAND} {longIs32bit} {

   653     expr 0x9876543210febcda & 0x543210febcda9876

   654 } 1167013060659550290

   655 test execute-7.18 {Wide int handling in INST_ADD} {longIs32bit} {

   656     expr wide(0x7fffffff)+wide(0x7fffffff)

   657 } 4294967294

   658 test execute-7.19 {Wide int handling in INST_ADD} {longIs32bit} {

   659     expr 0x7fffffff+wide(0x7fffffff)

   660 } 4294967294

   661 test execute-7.20 {Wide int handling in INST_ADD} {longIs32bit} {

   662     expr wide(0x7fffffff)+0x7fffffff

   663 } 4294967294

   664 test execute-7.21 {Wide int handling in INST_ADD} {longIs32bit} {

   665     expr double(0x7fffffff)+wide(0x7fffffff)

   666 } 4294967294.0

   667 test execute-7.22 {Wide int handling in INST_ADD} {longIs32bit} {

   668     expr wide(0x7fffffff)+double(0x7fffffff)

   669 } 4294967294.0

   670 test execute-7.23 {Wide int handling in INST_SUB} {longIs32bit} {

   671     expr 0x123456789a-0x20406080a

   672 } 69530054800

   673 test execute-7.24 {Wide int handling in INST_MULT} {longIs32bit} {

   674     expr 0x123456789a*193

   675 } 15090186251290

   676 test execute-7.25 {Wide int handling in INST_DIV} {longIs32bit} {

   677     expr 0x123456789a/193

   678 } 405116546

   679 test execute-7.26 {Wide int handling in INST_UPLUS} {longIs32bit} {

   680     set x 0x123456871234568

   681     expr {+ $x}

   682 } 81985533099853160

   683 test execute-7.27 {Wide int handling in INST_UMINUS} {longIs32bit} {

   684     set x 0x123456871234568

   685     expr {- $x}

   686 } -81985533099853160

   687 test execute-7.28 {Wide int handling in INST_LNOT} {longIs32bit} {

   688     set x 0x123456871234568

   689     expr {! $x}

   690 } 0

   691 test execute-7.29 {Wide int handling in INST_BITNOT} {longIs32bit} {

   692     set x 0x123456871234568

   693     expr {~ $x}

   694 } -81985533099853161

   695 test execute-7.30 {Wide int handling in function call} {longIs32bit} {

   696     set x 0x12345687123456

   697     incr x

   698     expr {log($x) == log(double($x))}

   699 } 1

   700 test execute-7.31 {Wide int handling in abs()} {longIs32bit} {

   701     set x 0xa23456871234568

   702     incr x

   703     set y 0x123456871234568

   704     concat [expr {abs($x)}] [expr {abs($y)}]

   705 } {730503879441204585 81985533099853160}

   706 test execute-7.32 {Wide int handling} {longIs32bit} {

   707     expr {1024 * 1024 * 1024 * 1024}

   708 } 0

   709 test execute-7.33 {Wide int handling} {longIs32bit} {

   710     expr {0x1 * 1024 * 1024 * 1024 * 1024}

   711 } 0

   712 test execute-7.34 {Wide int handling} {longIs32bit} {

   713     expr {wide(0x1) * 1024 * 1024 * 1024 * 1024}

   714 } 1099511627776

   716 test execute-8.1 {Stack protection} -setup {

   717     # If [Bug #804681] has not been properly

   718     # taken care of, this should segfault

   719     proc whatever args {llength $args}

   720     trace add variable ::errorInfo {write unset} whatever

   721 } -body {

   722     expr {1+9/0}

   723 } -cleanup {

   724     trace remove variable ::errorInfo {write unset} whatever

   725     rename whatever {}

   726 } -returnCodes error -match glob -result *

   728 # cleanup

   729 if {[info commands testobj] != {}} {

   730    testobj freeallvars

   731 }

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

   733 catch {rename foo ""}

   734 catch {rename p ""}

   735 catch {rename {} ""}

   736 catch {rename { } ""}

   737 catch {unset x}

   738 catch {unset y}

   739 catch {unset msg}

   740 ::tcltest::cleanupTests

   741 return

author	sl
	Tue, 10 Jun 2014 14:32:02 +0200
changeset 1	260cb5ec6c19
permissions	-rw-r--r--