开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
while.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：14k
源码类别：

通讯编程

开发平台：

Visual C++

while.test：源码内容
  1. # Commands covered:  while
  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) 1996 Sun Microsystems, Inc.
  8. # Copyright (c) 1998-1999 by Scriptics Corporation.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. # RCS: @(#) $Id: while.test,v 1.8 2001/12/04 15:36:29 dkf Exp $
  15. if {[lsearch [namespace children] ::tcltest] == -1} {
  16.     package require tcltest
  17.     namespace import -force ::tcltest::*
  18. }
  20. # Basic "while" operation.
  22. catch {unset i}
  23. catch {unset a}
  25. test while-1.1 {TclCompileWhileCmd: missing test expression} {
  26.     catch {while } msg
  27.     set msg
  28. } {wrong # args: should be "while test command"}
  29. test while-1.2 {TclCompileWhileCmd: error in test expression} {
  30.     set i 0
  31.     catch {while {$i<} break} msg
  32.     set errorInfo
  33. } {syntax error in expression "$i<": premature end of expression
  34.     ("while" test expression)
  35.     while compiling
  36. "while {$i<} break"}
  37. test while-1.3 {TclCompileWhileCmd: error in test expression} {
  38.     set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
  39.     list $err $msg
  40. } {1 {can't use non-numeric string as operand of "+"}}
  41. test while-1.4 {TclCompileWhileCmd: multiline test expr} {
  42.     set value 1
  43.     while {($tcl_platform(platform) != "foobar1") && 
  44.     ($tcl_platform(platform) != "foobar2")} {
  45.         incr value
  46.         break
  47.     }
  48.     set value
  49. } {2}
  50. test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} {
  51.     set value 1
  52.     while {"true"} {
  53. incr value;
  54. if {$value > 5} {
  55.     break;
  56. }
  57.     }
  58.     set value
  59. } 6
  60. test while-1.6 {TclCompileWhileCmd: test expr is enclosed in quotes} {
  61.     set i 0
  62.     while "$i > 5" {}
  63. } {}
  64. test while-1.7 {TclCompileWhileCmd: missing command body} {
  65.     set i 0
  66.     catch {while {$i < 5} } msg
  67.     set msg
  68. } {wrong # args: should be "while test command"}
  69. test while-1.8 {TclCompileWhileCmd: error compiling command body} {
  70.     set i 0
  71.     catch {while {$i < 5} {set}} msg
  72.     set errorInfo
  73. } {wrong # args: should be "set varName ?newValue?"
  74.     while compiling
  75. "set"
  76.     ("while" body line 1)
  77.     while compiling
  78. "while {$i < 5} {set}"}
  79. test while-1.9 {TclCompileWhileCmd: simple command body} {
  80.     set a {}
  81.     set i 1
  82.     while {$i<6} {
  83. if $i==4 break
  84. set a [concat $a $i]
  85.         incr i
  86.     }
  87.     set a
  88. } {1 2 3}
  89. test while-1.10 {TclCompileWhileCmd: command body in quotes} {
  90.     set a {}
  91.     set i 1
  92.     while {$i<6} "append a x; incr i"
  93.     set a
  94. } {xxxxx}
  95. test while-1.11 {TclCompileWhileCmd: computed command body} {
  96.     catch {unset x1}
  97.     catch {unset bb}
  98.     catch {unset x2}
  99.     set x1 {append a x1; }
  100.     set bb {break}
  101.     set x2 {; append a x2; incr i}
  102.     set a {}
  103.     set i 1
  104.     while {$i<6} $x1$bb$x2
  105.     set a
  106. } {x1}
  107. test while-1.12 {TclCompileWhileCmd: long command body} {
  108.     set a {}
  109.     set i 1
  110.     while {$i<6} {
  111. if $i==4 break
  112. if $i>5 continue
  113. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  114.     catch {set a $a} msg
  115.     catch {incr i 5} msg
  116.     catch {incr i -5} msg
  117. }
  118. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  119.     catch {set a $a} msg
  120.     catch {incr i 5} msg
  121.     catch {incr i -5} msg
  122. }
  123. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  124.     catch {set a $a} msg
  125.     catch {incr i 5} msg
  126.     catch {incr i -5} msg
  127. }
  128. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  129.     catch {set a $a} msg
  130.     catch {incr i 5} msg
  131.     catch {incr i -5} msg
  132. }
  133. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  134.     catch {set a $a} msg
  135.     catch {incr i 5} msg
  136.     catch {incr i -5} msg
  137. }
  138. set a [concat $a $i]
  139.         incr i
  140.     }
  141.     set a
  142. } {1 2 3}
  143. test while-1.13 {TclCompileWhileCmd: while command result} {
  144.     set i 0
  145.     set a [while {$i < 5} {incr i}]
  146.     set a
  147. } {}
  148. test while-1.14 {TclCompileWhileCmd: while command result} {
  149.     set i 0
  150.     set a [while {$i < 5} {if $i==3 break; incr i}]
  151.     set a
  152. } {}
  154. # Check "while" and "continue".
  156. test while-2.1 {continue tests} {
  157.     set a {}
  158.     set i 1
  159.     while {$i <= 4} {
  160.         incr i
  161. if {$i == 3} continue
  162. set a [concat $a $i]
  163.     }
  164.     set a
  165. } {2 4 5}
  166. test while-2.2 {continue tests} {
  167.     set a {}
  168.     set i 1
  169.     while {$i <= 4} {
  170.         incr i
  171. if {$i != 2} continue
  172. set a [concat $a $i]
  173.     }
  174.     set a
  175. } {2}
  176. test while-2.3 {continue tests, nested loops} {
  177.     set msg {}
  178.     set i 1
  179.     while {$i <= 4} {
  180.         incr i
  181.         set a 1
  182. while {$a <= 2} {
  183.             incr a
  184.             if {$i>=3 && $a>=3} continue
  185.             set msg [concat $msg "$i.$a"]
  186.         }
  187.     }
  188.     set msg
  189. } {2.2 2.3 3.2 4.2 5.2}
  190. test while-2.4 {continue tests, long command body} {
  191.     set a {}
  192.     set i 1
  193.     while {$i<6} {
  194. if $i==2 {incr i; continue}
  195. if $i==4 break
  196. if $i>5 continue
  197. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  198.     catch {set a $a} msg
  199.     catch {incr i 5} msg
  200.     catch {incr i -5} msg
  201. }
  202. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  203.     catch {set a $a} msg
  204.     catch {incr i 5} msg
  205.     catch {incr i -5} msg
  206. }
  207. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  208.     catch {set a $a} msg
  209.     catch {incr i 5} msg
  210.     catch {incr i -5} msg
  211. }
  212. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  213.     catch {set a $a} msg
  214.     catch {incr i 5} msg
  215.     catch {incr i -5} msg
  216. }
  217. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  218.     catch {set a $a} msg
  219.     catch {incr i 5} msg
  220.     catch {incr i -5} msg
  221. }
  222. set a [concat $a $i]
  223.         incr i
  224.     }
  225.     set a
  226. } {1 3}
  228. # Check "while" and "break".
  230. test while-3.1 {break tests} {
  231.     set a {}
  232.     set i 1
  233.     while {$i <= 4} {
  234. if {$i == 3} break
  235. set a [concat $a $i]
  236.         incr i
  237.     }
  238.     set a
  239. } {1 2}
  240. test while-3.2 {break tests, nested loops} {
  241.     set msg {}
  242.     set i 1
  243.     while {$i <= 4} {
  244.         set a 1
  245. while {$a <= 2} {
  246.             if {$i>=2 && $a>=2} break
  247.             set msg [concat $msg "$i.$a"]
  248.             incr a
  249.         }
  250.         incr i
  251.     }
  252.     set msg
  253. } {1.1 1.2 2.1 3.1 4.1}
  254. test while-3.3 {break tests, long command body} {
  255.     set a {}
  256.     set i 1
  257.     while {$i<6} {
  258. if $i==2 {incr i; continue}
  259. if $i==5 break
  260. if $i>5 continue
  261. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  262.     catch {set a $a} msg
  263.     catch {incr i 5} msg
  264.     catch {incr i -5} msg
  265. }
  266. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  267.     catch {set a $a} msg
  268.     catch {incr i 5} msg
  269.     catch {incr i -5} msg
  270. }
  271. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  272.     catch {set a $a} msg
  273.     catch {incr i 5} msg
  274.     catch {incr i -5} msg
  275. }
  276. if $i==4 break
  277. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  278.     catch {set a $a} msg
  279.     catch {incr i 5} msg
  280.     catch {incr i -5} msg
  281. }
  282. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  283.     catch {set a $a} msg
  284.     catch {incr i 5} msg
  285.     catch {incr i -5} msg
  286. }
  287. set a [concat $a $i]
  288.         incr i
  289.     }
  290.     set a
  291. } {1 3}
  293. # Check "while" with computed command names.
  295. test while-4.1 {while and computed command names} {
  296.     set i 0
  297.     set z while
  298.     $z {$i < 10} {
  299.         incr i
  300.     }
  301.     set i
  302. } 10
  303. test while-4.2 {while (not compiled): missing test expression} {
  304.     set z while
  305.     catch {$z } msg
  306.     set msg
  307. } {wrong # args: should be "while test command"}
  308. test while-4.3 {while (not compiled): error in test expression} {
  309.     set i 0
  310.     set z while
  311.     catch {$z {$i<} {set x 1}} msg
  312.     set errorInfo
  313. } {syntax error in expression "$i<": premature end of expression
  314.     while executing
  315. "$z {$i<} {set x 1}"}
  316. test while-4.4 {while (not compiled): error in test expression} {
  317.     set z while
  318.     set err [catch {$z {"a"+"b"} {error "loop aborted"}} msg]
  319.     list $err $msg
  320. } {1 {can't use non-numeric string as operand of "+"}}
  321. test while-4.5 {while (not compiled): multiline test expr} {
  322.     set value 1
  323.     set z while
  324.     $z {($tcl_platform(platform) != "foobar1") && 
  325.     ($tcl_platform(platform) != "foobar2")} {
  326.         incr value
  327.         break
  328.     }
  329.     set value
  330. } {2}
  331. test while-4.6 {while (not compiled): non-numeric boolean test expr} {
  332.     set value 1
  333.     set z while
  334.     $z {"true"} {
  335. incr value;
  336. if {$value > 5} {
  337.     break;
  338. }
  339.     }
  340.     set value
  341. } 6
  342. test while-4.7 {while (not compiled): test expr is enclosed in quotes} {
  343.     set i 0
  344.     set z while
  345.     $z "$i > 5" {}
  346. } {}
  347. test while-4.8 {while (not compiled): missing command body} {
  348.     set i 0
  349.     set z while
  350.     catch {$z {$i < 5} } msg
  351.     set msg
  352. } {wrong # args: should be "while test command"}
  353. test while-4.9 {while (not compiled): error compiling command body} {
  354.     set i 0
  355.     set z while
  356.     catch {$z {$i < 5} {set}} msg
  357.     set errorInfo
  358. } {wrong # args: should be "set varName ?newValue?"
  359.     while compiling
  360. "set"
  361.     ("while" body line 1)
  362.     invoked from within
  363. "$z {$i < 5} {set}"}
  364. test while-4.10 {while (not compiled): simple command body} {
  365.     set a {}
  366.     set i 1
  367.     set z while
  368.     $z {$i<6} {
  369. if $i==4 break
  370. set a [concat $a $i]
  371.         incr i
  372.     }
  373.     set a
  374. } {1 2 3}
  375. test while-4.11 {while (not compiled): command body in quotes} {
  376.     set a {}
  377.     set i 1
  378.     set z while
  379.     $z {$i<6} "append a x; incr i"
  380.     set a
  381. } {xxxxx}
  382. test while-4.12 {while (not compiled): computed command body} {
  383.     set z while
  384.     catch {unset x1}
  385.     catch {unset bb}
  386.     catch {unset x2}
  387.     set x1 {append a x1; }
  388.     set bb {break}
  389.     set x2 {; append a x2; incr i}
  390.     set a {}
  391.     set i 1
  392.     $z {$i<6} $x1$bb$x2
  393.     set a
  394. } {x1}
  395. test while-4.13 {while (not compiled): long command body} {
  396.     set a {}
  397.     set z while
  398.     set i 1
  399.     $z {$i<6} {
  400. if $i==4 break
  401. if $i>5 continue
  402. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  403.     catch {set a $a} msg
  404.     catch {incr i 5} msg
  405.     catch {incr i -5} msg
  406. }
  407. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  408.     catch {set a $a} msg
  409.     catch {incr i 5} msg
  410.     catch {incr i -5} msg
  411. }
  412. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  413.     catch {set a $a} msg
  414.     catch {incr i 5} msg
  415.     catch {incr i -5} msg
  416. }
  417. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  418.     catch {set a $a} msg
  419.     catch {incr i 5} msg
  420.     catch {incr i -5} msg
  421. }
  422. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  423.     catch {set a $a} msg
  424.     catch {incr i 5} msg
  425.     catch {incr i -5} msg
  426. }
  427. set a [concat $a $i]
  428.         incr i
  429.     }
  430.     set a
  431. } {1 2 3}
  432. test while-4.14 {while (not compiled): while command result} {
  433.     set i 0
  434.     set z while
  435.     set a [$z {$i < 5} {incr i}]
  436.     set a
  437. } {}
  438. test while-4.15 {while (not compiled): while command result} {
  439.     set i 0
  440.     set z while
  441.     set a [$z {$i < 5} {if $i==3 break; incr i}]
  442.     set a
  443. } {}
  445. # Check "break" with computed command names.
  447. test while-5.1 {break and computed command names} {
  448.     set i 0
  449.     set z break
  450.     while 1 {
  451.         if {$i > 10} $z
  452.         incr i
  453.     }
  454.     set i
  455. } 11
  456. test while-5.2 {break tests with computed command names} {
  457.     set a {}
  458.     set i 1
  459.     set z break
  460.     while {$i <= 4} {
  461. if {$i == 3} $z
  462. set a [concat $a $i]
  463.         incr i
  464.     }
  465.     set a
  466. } {1 2}
  467. test while-5.3 {break tests, nested loops with computed command names} {
  468.     set msg {}
  469.     set i 1
  470.     set z break
  471.     while {$i <= 4} {
  472.         set a 1
  473. while {$a <= 2} {
  474.             if {$i>=2 && $a>=2} $z
  475.             set msg [concat $msg "$i.$a"]
  476.             incr a
  477.         }
  478.         incr i
  479.     }
  480.     set msg
  481. } {1.1 1.2 2.1 3.1 4.1}
  482. test while-5.4 {break tests, long command body with computed command names} {
  483.     set a {}
  484.     set i 1
  485.     set z break
  486.     while {$i<6} {
  487. if $i==2 {incr i; continue}
  488. if $i==5 $z
  489. if $i>5 continue
  490. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  491.     catch {set a $a} msg
  492.     catch {incr i 5} msg
  493.     catch {incr i -5} msg
  494. }
  495. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  496.     catch {set a $a} msg
  497.     catch {incr i 5} msg
  498.     catch {incr i -5} msg
  499. }
  500. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  501.     catch {set a $a} msg
  502.     catch {incr i 5} msg
  503.     catch {incr i -5} msg
  504. }
  505. if $i==4 $z
  506. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  507.     catch {set a $a} msg
  508.     catch {incr i 5} msg
  509.     catch {incr i -5} msg
  510. }
  511. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  512.     catch {set a $a} msg
  513.     catch {incr i 5} msg
  514.     catch {incr i -5} msg
  515. }
  516. set a [concat $a $i]
  517.         incr i
  518.     }
  519.     set a
  520. } {1 3}
  522. # Check "continue" with computed command names.
  524. test while-6.1 {continue and computed command names} {
  525.     set i 0
  526.     set z continue
  527.     while 1 {
  528.         incr i
  529.         if {$i < 10} $z
  530.         break
  531.     }
  532.     set i
  533. } 10
  534. test while-6.2 {continue tests} {
  535.     set a {}
  536.     set i 1
  537.     set z continue
  538.     while {$i <= 4} {
  539.         incr i
  540. if {$i == 3} $z
  541. set a [concat $a $i]
  542.     }
  543.     set a
  544. } {2 4 5}
  545. test while-6.3 {continue tests with computed command names} {
  546.     set a {}
  547.     set i 1
  548.     set z continue
  549.     while {$i <= 4} {
  550.         incr i
  551. if {$i != 2} $z
  552. set a [concat $a $i]
  553.     }
  554.     set a
  555. } {2}
  556. test while-6.4 {continue tests, nested loops with computed command names} {
  557.     set msg {}
  558.     set i 1
  559.     set z continue
  560.     while {$i <= 4} {
  561.         incr i
  562.         set a 1
  563. while {$a <= 2} {
  564.             incr a
  565.             if {$i>=3 && $a>=3} $z
  566.             set msg [concat $msg "$i.$a"]
  567.         }
  568.     }
  569.     set msg
  570. } {2.2 2.3 3.2 4.2 5.2}
  571. test while-6.5 {continue tests, long command body with computed command names} {
  572.     set a {}
  573.     set i 1
  574.     set z continue
  575.     while {$i<6} {
  576. if $i==2 {incr i; continue}
  577. if $i==4 break
  578. if $i>5 $z
  579. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  580.     catch {set a $a} msg
  581.     catch {incr i 5} msg
  582.     catch {incr i -5} msg
  583. }
  584. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  585.     catch {set a $a} msg
  586.     catch {incr i 5} msg
  587.     catch {incr i -5} msg
  588. }
  589. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  590.     catch {set a $a} msg
  591.     catch {incr i 5} msg
  592.     catch {incr i -5} msg
  593. }
  594. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  595.     catch {set a $a} msg
  596.     catch {incr i 5} msg
  597.     catch {incr i -5} msg
  598. }
  599. if {$i>6 && $tcl_platform(machine)=="xxx"} {
  600.     catch {set a $a} msg
  601.     catch {incr i 5} msg
  602.     catch {incr i -5} msg
  603. }
  604. set a [concat $a $i]
  605.         incr i
  606.     }
  607.     set a
  608. } {1 3}
  610. # Test for incorrect "double evaluation" semantics
  612. test while-7.1 {delayed substitution of body} {
  613.     set i 0
  614.     while {[incr i] < 10} "
  615.        set result $i
  616.     "
  617.     proc p {} {
  618. set i 0
  619. while {[incr i] < 10} "
  620.     set result $i
  621. "
  622. set result
  623.     }
  624.     append result [p]
  625. } {00}
  627. # cleanup
  628. ::tcltest::cleanupTests
  629. return